Domino 9 und frühere Versionen > ND7: Entwicklung

Datenbankzugriff funktioniert nicht

(1/3) > >>

HarryB:
Hallo zusammen,

ich habe ein seltsames Problem.

Hintergrund:
Für das User-Accounting wollen wir regelmäßig die Größen der Maildatenbanken ermitteln. Zuständig dafür ist ein Script.

Problem:
Das Script ist unterzeichnet mit einer Server ID. Der Server ist Mitglied der 'LocalDomainServers' Gruppe. Die 'LocalDomainServers' haben Managerzugriff auf alle Maildatenbanken. Dennoch lassen sich die Datenbank nicht per NotesSession.GetDatabase öffnen. Es werden zwar die Objekte erstellt, aber die Datanbank ist geschlossen (IsOpen ist False). Explizites Öffnen der Datenbanken via NotesDatabase.Open("", "") bringt keine Abhilfe.

Wenn NotesDatabase.Size, wie es in der Doku steht, auch dann auslesbar wäre, wenn die Datenbank geschlossen ist, wäre das ja auch alles kein Problem.

Hat jemand eine Idee, was da falsch laufen könnte?

Viele Grüße
Harry

PS: Natürlich noch mein Script


--- Code: ---Sub Initialize

Dim ses As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument

Dim profile As notesDocument

Dim dirServer As String
Dim dirPath As String
Dim dd As NotesDatabase
Dim lookupView As NotesView
Dim userDoc As NotesDocument
Dim userMailDb As NotesDatabase

Dim shortName As String
Dim firstName As String
Dim lastName As String
Dim ZMAID As String
Dim userName As String
Dim mailFile As String
Dim mailServer As String

Dim oUserName As NotesName
Dim abbName As String
Dim cnName As String

Dim spaceBefore As Long
Dim dateBefore As Variant
Dim chargeBefore As Double

Dim mailFileSize As Long
Dim mfsMB As Long
Dim charge As Double

Dim agentLog As NotesLog

On Error Resume Next

Set db = ses.CurrentDatabase
Set view = db.GetView( "(Alle aktiven)" )

Set agentLog = New NotesLog("User-Account: Update all active user")
Call agentLog.OpenNotesLog(db.Server, "Agentlog.nsf")

Set profile = db.GetProfileDocument( "($Profile)" )
dirServer = profile.GetItemValue("Server_Directory")(0)
dirPath = profile.GetItemValue("Path_Directory")(0)

If Not (dirServer = "") Then

Set dd = ses.GetDatabase(dirServer, dirPath)
Set lookupView = dd.GetView("($VIMPeople)")

If dd Is Nothing Then

Msgbox "Kann Directory nicht öffnen: " + dirServer
Exit Sub

End If

If lookupView Is Nothing Then

Msgbox "Kann View nicht lesen: ($VIMPeople)"
Exit Sub

End If

Set doc = view.GetFirstDocument

While Not (doc Is Nothing)

Set oUserName = New NotesName(doc.GetItemValue("UserName")(0))
userName = oUserName.Abbreviated

spaceBefore = doc.GetItemValue("Speicherplatz")(0)
dateBefore = doc.GetItemValue("Datum")(0)
chargeBefore = doc.GetItemValue("PreisSpeicher")(0)

Call doc.ReplaceItemValue("SpeicherplatzVormonat", spaceBefore)
Call doc.ReplaceItemValue("DatumVormonat", dateBefore)
Call doc.ReplaceItemValue("PreisSpeicher_1",chargeBefore)

Set userDoc = lookupView.GetDocumentByKey(userName, True)

If Not (userDoc Is Nothing) Then

shortName = userDoc.GetItemValue("Shortname")(0)
firstname = userDoc.GetItemValue("FirstName")(0)
lastname = userDoc.GetItemValue("Lastname")(0)
ZMAID = userDoc.GetItemValue("Employeeid")(0)
mailFile = userDoc.GetItemValue("MailFile")(0)
mailServer = userDoc.GetItemValue("MailServer")(0)

If Not ((mailFile = "") Or (mailServer = "")) Then

mailFile = ReplaceSubstring(mailFile, "\", "/")

Call doc.ReplaceItemValue("shortname",shortName)
Call doc.ReplaceItemValue("Firstname", firstname)
Call doc.ReplaceItemValue("Lastname", lastName)
Call doc.ReplaceItemValue("ZMAID", ZMAID)

If Not (mailFile = "") Then
Call doc.ReplaceItemValue("Pfad", mailFile)
End If

Call doc.ReplaceItemValue("Server", mailServer)

Set userMailDb = ses.GetDatabase(mailServer, mailFile, True)

If Not (userMailDb Is Nothing) Then

'Call userMailDb.Open("", "")

Call doc.ReplaceItemValue("DBName", userMailDb.Title)

mailFileSize = userMailDb.Size

If userMailDb.IsOpen Then
Msgbox "Offen, Größe: " + Cstr(mailFileSize)
Else
Msgbox "Geschlossen, Größe: " + Cstr(mailFileSize)
End If

mfsMB = Clng((mailFileSize / 1024) / 1024)
charge = (mfsMB - 50) / 50

If (charge < 0) Then charge = 0

Call doc.ReplaceItemValue("Datum", Today)
Call doc.ReplaceItemValue("Speicherplatz", mfsMB)
Call doc.ReplaceItemValue("PreisSpeicher", charge)

Msgbox "Benutzer: " + userName + " Speicher: " + Format$(mfsMB, "Fixed") + " Preis: " + Format$(charge, "Fixed")

Call doc.ReplaceItemValue("Errorflag", "0")

Else 'Not (userMailDb Is Nothing)

If Err Then

Call agentLog.LogError(Err, Error$ + " at Line " + Cstr(Erl))
Err = 0

End If

Call doc.ReplaceItemValue("Errorflag", "1")

End If 'Not (userMailDb Is Nothing)

Else 'Not ((mailFile = "") Or (mailServer = ""))

Call doc.ReplaceItemValue("Errorflag", "1")

End If 'Not ((mailFile = "") Or (mailServer = ""))

Else 'Not (userDoc Is Nothing)

Call doc.ReplaceItemValue("Errorflag", "1")

End If 'Not (userDoc Is Nothing)

Call doc.save(True,True)

Set doc = view.GetNextDocument(doc)
Set userDoc = Nothing

Wend 'Not(doc Is Nothing)

End If 'Not (dirServer = "")

End Sub

--- Ende Code ---

botschi:
Wie führst Du den Agenten denn aus? Der Agent kann ja vom Server unterzeichnet sein, aber wenn Du ihn ausführst, läuft er mit deinen Rechten.

Matthias

HarryB:

--- Zitat von: botschi am 28.05.08 - 10:06:32 ---Wie führst Du den Agenten denn aus? Der Agent kann ja vom Server unterzeichnet sein, aber wenn Du ihn ausführst, läuft er mit deinen Rechten.
--- Ende Zitat ---
Zeitgesteuert bzw. per "tell amgr run ..."

botschi:
Mit der Zeile
--- Code: ---mailFile = ReplaceSubstring(mailFile, "\", "/")
--- Ende Code ---
stimmt auch was nicht...
Ich kann den Agenten nicht speichern.
Das gibt es in Script nicht.

Matthias

HarryB:
Ja, sorry, da ist noch eine selbstprogrammierte Funktion drin (die ich selbst geerbt habe).


--- Code: ---Function ReplaceSubstring(strSourceText As String, strSearchText As String, strReplaceText As String) As String
Dim strNewText As String
Dim pos As Integer
Dim inc As Integer

pos = 0
strNewText = strSourceText

If strReplaceText <> "" Then
inc = Len(strReplaceText)
Else
inc = 1
End If

pos = Instr(1, strNewText, strSearchText)
While pos <> 0
strNewText = Mid$(strNewText, 1, pos - 1) & strReplaceText & Mid$(strNewText, (Len(strSearchText) + pos))
pos = Instr(pos + inc, strNewText, strSearchText)
Wend
ReplaceSubstring = strNewText
End Function
--- Ende Code ---

Navigation

[0] Themen-Index

[#] Nächste Seite

Zur normalen Ansicht wechseln