Hallo,
wir haben in mehreren Adressdatenbanken Agent, welche via ODBC Connection, Daten mit einer Relationalen Datenbanken abgleichen.
Ein Select liefert Werte zurück, welche wiederum auf die entsprechende Adresse in der LotusNotes Datenbank geschrieben werden.
Bei der letzten Serverwartung habe ich festgestellt, dass im Administrator-Profile Verzeichnis (Dokumente und Einstellungen\Administrator\Lokale Einstellungen\Temp) mehr als 5.000 .tmp Dateien liegen.
Ich konnte die Dateien erst löschen nachdem ich den DominoServer gestoppt habe. Heute waren schon wieder 1846 .tmp Dateien in diesem Ordner. Jedes mal wenn ein Agent am Server startet werden diese LEM3A98.tmp Dateien erstellt. In der .tmp Datei steht jeweils immer nur eine Zeile (Kundennummer, und das Product) das ist das was der Select auf die relationale Datenbank zurückgibt. Die Werte hinter LEMxxxx.tmp sind nicht fortlaufend.
Wir haben in den Adressdatenbanken Agenten die vom Systemhaus erstellt wurden, diese Agenten die, die selbe ODBC Verbindung verwenden erstellen zur Laufzeit keine .tmp Dateien.
Kennt jemand dieses Problem? Da ich den SourceCode der Agent welche vom Systemhaus erstellt wurden nicht einsehen kann weis ich nicht ob ich zusätzliche Einstellungen od. Cache Parameter beim Verbindungsaufbau im SourceCode mitgeben muss.
'OrganizeTechLetterCampaigns:
Option Public
Option Explicit
Uselsx "*LSXODBC"
Sub Initialize
Dim session As New NotesSession
Dim adrDB As NotesDatabase
Dim adrDoc As NotesDocument
Dim adrCol As NotesDocumentCollection
Dim con As New ODBCConnection
con.ConnectTo("FINReseller")
If Not con.IsConnected Then
Print "Could not open ODBC Connection!."
Exit Sub
End If
Print "OrganzieTechLetterCampaigs: Connected."
Set adrDb = Session.CurrentDatabase
Set adrcol = adrDb.AllDocuments
'Set adrCol = adrDB.UnprocessedDocuments
Set adrDoc = adrCol.GetFirstDocument
While Not (adrDoc Is Nothing)
If (adrDoc.Form(0) = "Address") And (adrDoc.AdrCustomerNo(0) <> "") Then
'Print "Customer: " & adrDoc.AdrCustomerNo(0)
Dim techletterArr$()
Redim techletterArr$(0)
techletterArr$(0) = ""
Call getTypoGroup(con, adrDoc,techletterArr$)
Call organizeCampaigns(adrDoc, techletterArr$)
End If
Set adrDoc = adrCol.GetNextDocument(adrDoc)
Wend
con.Disconnect
Print "OrganzieTechLetterCampaigs: Disconnected."
End Sub
Sub getTypoGroup(con As ODBCConnection, adrDoc As NotesDocument, arrTypoGroup$())
Dim adrID As String
Dim qry As New ODBCQuery
Dim result As New ODBCResultSet
Set qry.Connection=con
Set result.Query=qry
Dim strDate As String
strDate = "{d'" & Format(Date,"YYYY-MM-DD")&"'}"
qry.SQL = "SELECT DISTINCT Verkaufspositionen.WebGroup AS typogroup " & _
"FROM Vertragskopf, Vertragszeile, Verkaufspositionen " & _
"WHERE Vertragskopf.Vertragsnr = Vertragszeile.Vertragsnr AND Vertragszeile.Verkaufsposition = Verkaufspositionen.Suchbegriff " &_
"AND (Vertragskopf.gekundigt_zum = {d'1753-01-01'} OR Vertragskopf.gekundigt_zum >" & strDate & ") " & _
"AND (Vertragszeile.gekundigt_zum = {d'1753-01-01'} OR Vertragszeile.gekundigt_zum >" & strDate & ") " & _
"AND Verkaufspositionen.WebGroup <> '' AND Vertragskopf.Debitornr = '" & adrDoc.AdrCustomerNo(0) & "' AND Vertragskopf.Kommission = '' " & _
"GROUP BY Vertragskopf.Debitornr, Vertragskopf.Kommission, Verkaufspositionen.WebGroup Order By 1"
result.Execute
If result.IsResultSetAvailable Then
Dim resultString As String
Dim i As Integer
resultString = ""
Do
result.NextRow
resultString = result.GetValue("typogroup")
If resultString <> "" Then
Dim tmpArr$(1 To 2)
Call returnTechLetterName(resultString, tmpArr$, adrDoc.AdrCountry(0))
For i = 1 To 2
If tmpArr$(i) <> "" Then
Redim Preserve arrTypoGroup$(Ubound(arrTypoGroup$)+1)
arrTypoGroup$(Ubound(arrTypoGroup$)) = tmpArr$(i)
End If
Next
End If
Loop Until result.IsEndOfData
End If
End Sub
Sub returnTechLetterName (typoGroup As String, returnArray() As String, country As String )
Select Case typoGroup
' german TypoGroups
Case "AEPDE" : returnArray(1) = "Techletter German AE"
Case "ADE" : returnArray(1) = "Techletter German A"
Case "ABDE" : returnArray(1) = "Techletter German AB"
Case "APDE" : returnArray(1) = "Techletter German AP"
Case "SDE" : returnArray(1) = "Techletter German S"
Case "SFDE" : returnArray(1) = "Techletter German SF & SF E"
returnArray(2) = "Techletter German SF"
Case "SFDE" : returnArray(1) = "Techletter German SF"
Case "SODE" : returnArray(1) = "Techletter German SO"
Case "SIDE" : returnArray(1) = "Techletter German SI"
Case "SPDE" : returnArray(1) = "Techletter German SP"
' english TypoGroups
Case "AEEN" : returnArray(1) = "Techletter English AE"
Case "AEN" : returnArray(1) = "Techletter English A"
Case "ABEN" :
If (country = "Germany") Or (country = "Austria") Or (country = "Switzerland" ) Then
returnArray(1) = "Techletter German AB"
Else
returnArray(1) = "Techletter English AB"
End If
Case "APEN" : returnArray(1) = "Techletter English AP"
Case "SEN" : returnArray(1) = "Techletter English S"
Case "SFEN" : returnArray(1) = "Techletter English SF & SF E"
returnArray(2) = "Techletter English SF I"
Case "SFCEN" : returnArray(1) = "Techletter English SF C"
Case "SOEN" : returnArray(1) = "Techletter English SO"
Case "SIEN" : returnArray(1) = "Techletter English SI"
Case "SPEN" : returnArray(1) = "Techletter English SP"
Case Else
returnArray(1) = ""
returnArray(2) = ""
End Select
End Sub
Sub organizeCampaigns(adrDoc As NotesDocument, techletterArr$())
Dim contact As NotesDocument
Dim contactCollection As NotesDocumentCollection
Dim i As Integer
Set contactCollection = adrDoc.Responses
Set contact = contactCollection.GetFirstDocument
While Not (contact Is Nothing)
If contact.AdrWebCertificate(0) = "delivered" Then
' add campaigns
For i=0 To Ubound(techletterArr$)
Call addCampaign(contact,techletterArr$(i))
Next
End If
' Call removeCampaign(contact, techletterArr$)
Set contact = contactCollection.GetNextDocument(contact)
Wend
End Sub
Sub addCampaign(doc As NotesDocument, campaignTitle As String)
Dim campaignFound As Boolean
campaignFound = False
If campaignTitle = "" Then
Exit Sub
End If
Forall x In doc.AdrCampaign
If Left(x,Len(campaignTitle)) = campaignTitle Then
campaignFound = True
End If
End Forall
If campaignFound = False Then
Call doc.GetFirstItem("AdrCampaign").AppendToTextList(campaignTitle)
Call doc.Save(True,False,False)
End If
End Sub
Sub removeCampaign(doc As NotesDocument, techletterArr$())
Dim startTechletterText As String
Dim i As Integer
Dim j As Integer
Dim campaignStillActive As Boolean
Dim isModified As Boolean
isModified = False
startTechletterText = "Techletter "
For j=Lbound(doc.AdrCampaign) To Ubound(doc.AdrCampaign)
campaignStillActive = False
If Left(doc.AdrCampaign(j),Len(startTechletterText)) = startTechletterText Then
For i=1 To Ubound(techletterArr$)
If doc.AdrCampaign(j) = techletterArr$(i) Then
campaignStillActive = True
End If
Next
If campaignStillActive = False Then
doc.AdrCampaign = Replace(doc.AdrCampaign, doc.AdrCampaign(j), "")
isModified = True
End If
End If
Next
If isModified Then
doc.AdrCampaign = Fulltrim(doc.AdrCampaign)
Call doc.Save(True, False, False)
End If
End Sub
Für jede Unterstützung dankbar !
Gruß
Chris