LotusScript获得未读邮件

Option Public
Option Explicit

'** Notes C-API functions used by the UnreadDocList class (these are Windows-specific
'** calls -- please adjust as necessary for other operating system platforms)
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

'** Error code masks
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
%REM
The UnreadDocList class provides a way to programmatically access
the list of unread docs in a database or a view/folder. As far as I know,
there's no good built-in way of doing this as of Notes 6.x, so I had to use
some C-API calls.

Because we're calling the C-API, you'll also need to declare several API
functions in the Declarations section of the agent or script library that
holds this class. If you got this class without the related API declarations,
please see the original version of this code at http://www.nsftools.com

Here's an example of getting the unread docs in a user's inbox:

 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
 
 mailDb = Evaluate("@MailDbName")
 Set db = session.GetDatabase(mailDb(0), mailDb(1))
 Set inbox = db.GetView("($Inbox)")
 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
  Print "There are " & (Ubound(unreadArray) + 1) & " unread docs in your inbox"
 End If

A few things to note about this class:

1. The GetUnreadInDB and GetUnreadInView functions return an
array with a single empty element if nothing is found.

2. The GetUnreadInDB and GetUnreadInView functions return an
array of NoteIDs if unread docs are found. If you need to access the
docs themselves, you can step through the array and get them one
at a time with NotesDatabase.GetDocumentByID(noteID)

3.  The process is that you first get all of the unread docs in the entire
database, then you see which of those docs are in a given view. The
GetUnreadInDB function actually only gets the first 32,767 unread docs
in the database, so it's possible that you won't get an accurate list for
databases with really large numbers of unread docs.

4. You need to supply a valid user name that you're checking the unread
docs for. This is because different users have different unread counts
(which is obvious if you think about it).

5. I'm not sure how well this works when run on a server versus being
run on a user's workstation. That's because I think the unread marks
used to be stored in the user's local desktop.dsk file, and in some version
of Notes (version 6?) I think it was stored in the database somehow,
to allow unread marks to replicate. Your best bet is to test it and see.

You can use this code in any way you want, as long as you don't hold me
liable for anything, and you don't pretend you wrote it yourself.

version 1.0
April 15, 2005
Julian Robichaux ( http://www.nsftools.com )
%END REM
 
 Private lastError As String
 
 Public Function getLastError () As String
  '** if any errors occurred while the getUnreadInView or
  '** getUnreadInDb functions ran, getLastError will return
  '** a string indicating the nature of the error (if there were
  '** no errors, a blank string will be returned)
  getLastError = lastError
 End Function
 
 
 Public Function getUnreadInView (view As NotesView, userName As String) As Variant
  '** returns an array of NoteIDs representing the docs in the view
  '** that are marked as unread for the given user (or an empty
  '** array if nothing was found)
  On Error Goto processError
  Dim returnArray() As String
  
  '** first try to get all the unread docs in the database (if there are
  '** none, we can stop processing right now)
  Dim unreadArray As Variant
  Redim returnArray(0) As String
  unreadArray = getUnreadInDB(view.Parent, userName)
  If (unreadArray(0) = "") Then
   getUnreadInView = returnArray
   Exit Function
  End If
  
  '** set the view's AutoUpdate flag to False, so we can step through
  '** the view a little faster
  Dim viewFlag As Integer
  viewFlag = view.AutoUpdate
  view.AutoUpdate = False
  
  '** get the NoteIDs of all the docs in the view
  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, 8)) = doc.NoteID
   Set doc = view.GetNextDocument(doc)
  Loop
  view.AutoUpdate = viewFlag
  
  '** compare the NoteIDs in the view with the ones in the unreadArray
  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
  '** return an array of NoteIDs for all the "unread" docs in the given
  '** database for the given user (or at least the first 32,767 unread
  '** docs, since that's the maximum upper-bound of an array -- you
  '** could actually double this number by starting the array at -32,786
  '** instead of 0, but it's more "natural" to return a 0-based array, and
  '** frankly if there are more than 32,000 unread docs in the database
  '** you should probably narrow your query anyway)
  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 = ""
  
  '** create a proper network path name with OSPathNetConstruct
  Call OSPathNetConstruct(0, db.Server, db.FilePath, pathName)
  
  '** open the database and get a handle with NSFDbOpen
  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
  
  '** get the ID table of all the unread docs in the database (unread marks are
  '** kept on a per-user basis, so you need to provide a user name as well)
  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
  
  '** make sure we got some IDs returned to us (if not, just exit)
  count = IDEntries(hIDTable)
  If (count = 0) Then
   Goto freeIDTable
  Else
   '** redim the return array to the proper size, but don't let it get
   '** too big
   If (count > 32767) Then
    Redim returnArray(32767) As String
   Else
    Redim returnArray(count) As String
   End If
   count = 0
  End If
  
  '** get the NoteIDs in the table and put them in the array
  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:
  '** free the memory used when we grabbed the ID table
  Call OsMemFree(hIDTable)  ' should possibly use IDDestroyTable instead?
  
closeDb:
  '** close the database with NSFDbClose
  Call NSFDbClose(hDb)
  
endOfFunction:
  getUnreadInDB = returnArray
  Exit Function
  
 End Function
 
 
 Private Function GetAPIError (errorCode As Integer) As String
  '** this function translates Notes API error codes into their
  '** corresponding error strings
  Dim errorString As String*256
  Dim returnErrorString As String
  Dim resultStringLength As Long
  Dim errorCodeTranslated As Integer
  
  '** mask off the top 2 bits of the errorCode that was returned; this is
  '** what the ERR macro in the API does
  errorCodeTranslated = (errorCode And ERR_MASK)
  
  '** get the error code translation using the OSLoadString API function
  resultStringLength = OSLoadString(0, errorCodeTranslated, errorString, Len(errorString) - 1)
  
  '** strip off the null-termination on the string before you return it
  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
  '** convert the noteID to a Hex value, and left-pad it with zeros
  Dim noteIDString As String
  noteIDString = Hex$(noteID)
  noteIDString = String(8 - Len(noteIDString), "0") & noteIDString
  
  ConvertNoteID = noteIDString
 End Function
 
End Class

 

Sub Initialize
 '** This is an example of using the UnreadDocList class
 '** PLEASE REMOVE THIS SUB IF YOU COPY THE CLASS
 '** TO AN AGENT OR SCRIPT LIBRARY
 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
 
 mailDb = Evaluate("@MailDbName")
 'Set db = session.CurrentDatabase
 Set db = session.GetDatabase(mailDb(0), mailDb(1))
 Set inbox = db.GetView("($Inbox)")
 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
  Print "There are " & (Ubound(unreadArray) + 1) & " unread docs in your inbox"
 End If
 
End Sub