par Droad » 16 Juil 2003 à 16:36
Voila un agent Win32 que j'ai adapté et testé sur ma boite mail et qui semble faire le boulot.J'ai essayé de sécuriser le code, mais si ça fait tous sauter, je nierais avoir eu connaissance de mes agissements:Const API_DLL = "nnotes.dll"Const API_PLATFORM = "Windows/32"Declare Function apiNSFDbOpen Lib API_DLL Alias "NSFDbOpen" (Byval dbName As String, hdb As Long) As IntegerDeclare Function apiNSFDbClose Lib API_DLL Alias "NSFDbClose" (Byval hdb As Long) As IntegerDeclare Function apiNSFDbGetUnreadNoteTable Lib API_DLL Alias "NSFDbGetUnreadNoteTable" (Byval hDb As Long, Byval UserName As String, Byval NameLength As Integer, Byval Create As Integer, hUnreadTable As Integer) As IntegerDeclare Function apiNSFIDIsPresent Lib API_DLL Alias "IDIsPresent" (Byval hTable As Integer, Byval NoteID As Long) As IntegerDeclare Sub apiOSMemFree Lib API_DLL Alias "OSMemFree" (Byval handle As Integer)Declare Function apiNSFDbUpdateUnread Lib API_DLL Alias "NSFDbUpdateUnread" (Byval hDb As Long, Byval hTable As Integer) As LongClass NotesUnreadTableReader Private hDb As Long Private hUnreadTable As Integer Private isInitialized As Variant Public Sub new(db As NotesDatabase, username As String) Me.isInitialized = False Dim session As New NotesSession If session.Platform <> API_PLATFORM Then Messagebox "Sorry, this only works on " & API_PLATFORM & " at the moment!" Exit Sub End If Dim server As String, filename As String, rc As Integer server$ = db.Server filename$ = db.FilePath Me.hDb = 0 If server$ = "" Then rc% = apiNSFDbOpen(filename$, Me.hDb) Else rc% = apiNSFDbOpen(server$ & "!!" & filename$, Me.hDb) End If If rc% <> 0 Then Messagebox "Impossible d'ouvrit la base " & server$ & "!!" & filename$ Exit Sub End If Me.hUnreadTable = 0 rc% = apiNSFDbGetUnreadNoteTable(hDb, UserName$, Len(UserName$), False, Me.hUnreadTable) If rc% <> 0 Then Call apiNSFDbClose(hDb) Error 8001, "Erreur lors de l'accés à la table des non-lus." End If If Me.hUnreadTable = 0 Then Call apiNSFDbClose(hDb) Error 8001, "La table des non-lus n'existe pas." Exit Sub End If Dim rl As Long rl& = apiNSFDbUpdateUnread(hDb, hUnreadTable) If rl& <> 0 Then Print "Erreur non fatale: Echec de la mise à jour la table des non-lus" End Sub Public Function isUnread(doc As NotesDocument) As Variant If Not Me.isInitialized Then Error 8001, "L'objet n'est pas correctement initialisé" isUnread = apiNSFIDIsPresent(Me.hUnreadTable, Clng("&H" & doc.NoteId))<>0 End Function Sub delete() If Not Me.isInitialized Then Exit Sub If hUnreadTable>0 Then Call apiOSMemFree(hUnreadTable) If hDb>0 Then Call apiNSFDbClose(hDb) End SubEnd ClassSub Initialize Dim s As New NotesSession Dim dc As NotesDocumentCollection Dim doc As NotesDocument Dim unreads As New NotesUnreadTableReader(s.CurrentDatabase, s.EffectiveUsername) Dim unreadCount As Long Set dc = S.CurrentDatabase.UnprocessedDocuments Set doc = dc.GetFirstDocument() While Not(doc Is Nothing) If unreads.IsUnread(doc) Then unreadCount = unreadCount+1 Print "UNREAD: " & doc.Subject(0) End If Set doc = dc.GetNextDocument(doc) Wend Messagebox "Non-Lus: " & unreadCountEnd Sub[%sig%]