Ungelesene Dokumente (Anzahl)

[William Wallace]

Hallo,

haben eine eigenentwickelte Startseite. Über diese sind zahlreiche Funktionen / Aktionen aufrufbar. U.a. Anzeige des digitalen schwarzes Brett's. Es besteht nun der Wunsch neue Mitteilungen (neue Dokumente) in diesem Bereich auf der Startseite kenntlich zu machen.
D.h. eine Prüfung, ob neue (ungelesene) Doks im Bereich Schwarze Brett und wenn ja, dann irgendwo ein Hinweis irgendeiner Art plazieren. Es geht mir hierbei um das Errechnen der neuen Dokumente. Habe da schon ein Script fertig, was ich per Agent im PostOpen einer Maske aufrufe - allerdings dauert dies ca. 20 Sekunden - was entschieden zu lange ist.

Habt ihr andere Lösungen oder Empfehlungen?

Gruß,
William



<sup>Declare Function OSPathNetConstruct Lib "nnotes.dll" (Byval portName As Integer, _
Byval serverName As String, Byval fileName As String, Byval pathName As String) As Integer
Declare Function NSFDbOpen Lib "nnotes.dll" (Byval dbName As String, rethDb As Long) As Integer
Declare Function NSFDbClose Lib "nnotes.dll" (Byval hDb As Long) As Integer
Declare Function NSFDbGetUnreadNoteTable Lib "nnotes.dll" (Byval hDB As Long, _
Byval userName As String, Byval userNameLength As Integer, _
Byval fCreateIfNotAvailable As Boolean, rethUnreadList As Long) As Integer
Declare Function NSFDbGetModifiedNoteTable Lib "nnotes" ( Byval hDB As Long, Byval noteClassMask As Integer, _
Byval startDate As Double, retEndDate As Double, rethTable As Long ) As Integer
Declare Function IDEntries Lib "nnotes" ( Byval hTable As Long ) As Long
Declare Function IDScan Lib "nnotes" ( Byval hTable As Long, Byval tFirstBool As Integer, retID As Long) As Integer
Declare Function OSMemFree Lib "nnotes" (Byval handle As Long) As Integer
Const ERR_MASK = &H3fff
Const PKG_MASK = &H3f00
Const ERRNUM_MASK = &H00ff
Declare Function OSLoadString Lib "nnotes.dll" (Byval hModule As Long, Byval stringCode As Integer, _
Byval retBuffer As String, Byval bufferLength As Integer) As Integer
Class UnreadDocList

   
   Private lastError As String
   
   Public Function getLastError () As String
      getLastError = lastError
   End Function
   
   
   Public Function getUnreadInView (view As NotesView, userName As String) As Variant
      On Error Goto processError
      Dim returnArray() As String
      
      Dim unreadArray As Variant
      Redim returnArray(0) As String
      unreadArray = getUnreadInDB(view.Parent, userName)
      If (unreadArray(0) = "") Then
         getUnreadInView = returnArray
         Exit Function
      End If
      
      Dim viewFlag As Integer
      viewFlag = view.AutoUpdate
      view.AutoUpdate = False
      
      Dim doc As NotesDocument
      Dim viewDocList List As String
      Dim count As Integer
      Dim i As Integer
      
      Set doc = view.GetFirstDocument
      Do Until (doc Is Nothing)
         viewDocList(Right("00000000" & doc.NoteID, ) = doc.NoteID
         Set doc = view.GetNextDocument(doc)
      Loop
      view.AutoUpdate = viewFlag
      
      For i = 0 To Ubound(unreadArray)
         If Iselement(viewDocList(unreadArray(i))) Then
            Redim Preserve returnArray(count) As String
            returnArray(count) = unreadArray(i)
            count = count + 1
         End If
      Next
      
      getUnreadInView = returnArray
      Exit Function
      
processError:
      lastError = Error$
      getUnreadInView = returnArray
      Exit Function
      
   End Function
   
   
   Public Function getUnreadInDB (db As NotesDatabase, userName As String) As Variant
      Dim hDb As Long
      Dim hIDTable As Long
      Dim notesUserName As NotesName
      Dim longUserName As String
      Dim pathName As String*256
      Dim noteID As Long
      Dim firstFlag As Integer
      Dim result As Integer
      Dim count As Long
      Dim returnArray() As String
      
      '** initialize some variables
      Redim returnArray(0) As String
      lastError = ""
      
      Call OSPathNetConstruct(0, db.Server, db.FilePath, pathName)

      result = NSFDbOpen(pathName, hDb)
      If result <> 0 Then
         lastError = "Cannot open database " & db.FilePath & " on server " & db.Server & _
         ". Error was " & Cstr(result) & ": " & GetAPIError( result )
         Goto endOfFunction
      End If
      
      Set notesUserName = New NotesName(userName)
      longUserName = notesUserName.Canonical
      result = NSFDbGetUnreadNoteTable(hDB, userName, Len(username), 0, hIDTable)
      If result <> 0 Then
         lastError = "Cannot open ID Table on " & db.FilePath & " on server " & db.Server & _
         ". Error was " & Cstr(result) & ": " & GetAPIError( result )
         Goto closeDb
      End If
      
      count = IDEntries(hIDTable)
      If (count = 0) Then
         Goto freeIDTable
      Else
         If (count > 32767) Then
            Redim returnArray(32767) As String
         Else
            Redim returnArray(count) As String
         End If
         count = 0
      End If
      
      firstFlag = True
      Do While IDScan(hIDTable, firstFlag, noteID) > 0
         returnArray(count) = ConvertNoteID(noteID)
         firstFlag = False
         count = count + 1
         If (count > Ubound(returnArray)) Then
            Exit Do
         End If
      Loop
      
      
freeIDTable:
      Call OsMemFree(hIDTable)      ' should possibly use IDDestroyTable instead?
      
closeDb:
      Call NSFDbClose(hDb)
      
endOfFunction:
      getUnreadInDB = returnArray
      Exit Function
      
   End Function
   
   
   Private Function GetAPIError (errorCode As Integer) As String
      Dim errorString As String*256
      Dim returnErrorString As String
      Dim resultStringLength As Long
      Dim errorCodeTranslated As Integer
      
      errorCodeTranslated = (errorCode And ERR_MASK)
      
      resultStringLength = OSLoadString(0, errorCodeTranslated, errorString, Len(errorString) - 1)
      
      If (Instr(errorString, Chr(0)) > 0) Then
         returnErrorString = Left$(errorString, Instr(errorString, Chr(0)) - 1)
      Else
         returnErrorString = errorString
      End If
      
      GetAPIError = returnErrorString
      
   End Function
   
   
   Private Function ConvertNoteID (noteID As Long) As String
      Dim noteIDString As String
      noteIDString = Hex$(noteID)
      noteIDString = String(8 - Len(noteIDString), "0") & noteIDString
      
      ConvertNoteID = noteIDString
   End Function
   
End Class






Sub Initialize
   Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim inbox As NotesView
   Dim mailDb As Variant
   Dim udc As New UnreadDocList
   Dim unreadArray As Variant
   
   Set db = session.GetDatabase("Domino1/boge Kompressoren/de", "boge\InfoCenter.nsf")
   Set inbox = db.GetView("BlackUNID")
   unreadArray = udc.getUnreadInView(inbox, session.EffectiveUserName)
   
   If (Len(udc.getLastError()) > 0) Then
      Print "There was an error: " & udc.getLastError()
   End If
   
   If (unreadArray(0) = "") Then
      Print "There are 0 unread docs in your inbox"
   Else
      Dim workspace As New NotesUIWorkspace
      Dim doc As NotesDocument
      Dim anzahl
      Set doc = workspace.CurrentDocument.Document
      anzahl = Ubound(unreadArray) + 1
      Call doc.ReplaceItemValue("Anzahl" , anzahl)
   End If
   
End Sub</sup>