Классы для работы со стабами удалённых документов

Классы для работы со стабами удалённых документов
Константин Червоненко
kchervonenko@mail.ru
В продолжении материала Как отследить удаление документа >>>

'DeletionStubs:

Option Declare
%INCLUDE "common.lss"

'Public Const NOTE_CLASS_ALL = &H7fff
Const NOERROR = 0
'Const NULLHANDLE = 0&
Const MAXPATH = 256
Const RRV_DELETED = &H80000000&
Const PKG_NSF = &H200
Const ERR_NOTE_DELETED = PKG_NSF + 37
Const eHead = "Notes C API Error: ", padl = "0000000"

Public Class DeletionStub
Private ParentRef As DeletionStubCollection
Private CurrNoteID As Long
Private NoteOID As OID

Public NoteClass As Integer
Public LastModified As Variant

Property Get NoteID As String
NoteID = Hex$(CurrNoteID And (Not RRV_DELETED))
End Property
Property Get UNID As String
UNID = Right$(padl & Hex$(NoteOID.FileDBID.Innards(1)),8) & Right$(padl & Hex$(NoteOID.FileDBID.Innards(0)),8)_
& Right$(padl & Hex$(NoteOID.Note.Innards(1)),8) & Right$(padl & Hex$(NoteOID.Note.Innards(0)),8)
End Property
Property Get Created As Variant
Call ConvTIMEDATEtoDateTime(NoteOID.Note, Created)
End Property
Property Get Parent
Set Parent = ParentRef
End Property

Sub Remove
If Me.ParentRef.hDb=0 Then Exit Sub
Call NSFNoteDelete(Me.ParentRef.hDb, Me.CurrNoteID And (Not RRV_DELETED), UPDATE_NOSTUB)
Delete .Me
End Sub
End Class

Public Class DeletionStubCollection As DeletionStub
Private ParentDb As NotesDataBase
Private hDb As Long
Private hTable As Long
Private tdEnd As TIMEDATE
Private CurrentNum As Long

Sub New(db As NotesDataBase, Byval iNoteClass As Integer, Byval iSince As Variant)
Dim tdStart As TIMEDATE
Dim sPath As String
Dim iStatus As Integer

On Error Goto ErrH
If iNoteClass=0 Then iNoteClass = NOTE_CLASS_DOCUMENT
Select Case Datatype(iSince)
Case V_DATE
ConvDateTimeToTIMEDATE iSince, tdStart
Case V_PRODOBJ
ConvDateTimeToTIMEDATE iSince.LSLocalTime, tdStart
Case Else
TimeConstant TIMEDATE_WILDCARD, tdStart
End Select

'build an API-friendly path to the current database (i.e., !!)
sPath = String$(MAXPATH, 0)
OSPathNetConstruct "", db.Server, db.FilePath, sPath
sPath = Left$(sPath, Instr(1, sPath, Chr$(0)) - 1)

iStatus = NSFDbOpen(sPath, hDb)
If iStatus <> NOERROR Then
Error 7000+iStatus, eHead & GetCAPIErrorMsg(iStatus)
End If

iStatus = NSFDbGetModifiedNoteTable(hDb, iNoteClass, tdStart.Innards(0), tdStart.Innards(1), tdEnd, hTable)
If iStatus <> NOERROR Then
NSFDbClose hDb
Error 7000+iStatus, eHead & GetCAPIErrorMsg(iStatus)
End If
Set ParentDb = db
CurrentNum = 0
Eos: Exit Sub
ErrH:
On Error Goto 0
Error Err, "New.DeletionStubCollection("& Cstr(Erl) &"): "& Error$
Resume Eos
End Sub

Function GetFirstStub() As DeletionStub
On Error Goto ErrH
Set GetFirstStub = New DeletionStub
If IDScan(hTable, True, GetFirstStub.CurrNoteID) Then
If SrchNext(GetFirstStub) Then
Set GetFirstStub.ParentRef = Me
Else
Delete GetFirstStub
End If
Else
Delete GetFirstStub
End If
Eos: Exit Function
ErrH:
On Error Goto 0
Error Err, "GetFirstStub.DeletionStubCollection("& Cstr(Erl) &"): "& Error$
Resume Eos
End Function

Function GetNextStub(Stub As DeletionStub) As DeletionStub
If Not Stub.ParentRef Is Me Then
Error 7000,"Это stub из другой коллекции"
End If
On Error Goto ErrH
Set GetNextStub = New DeletionStub
Set GetNextStub.ParentRef = Me
GetNextStub.CurrNoteID = Stub.CurrNoteID
If IDScan(hTable, False, GetNextStub.CurrNoteID) Then
If Not SrchNext(GetNextStub) Then Delete GetNextStub
Else
Delete GetNextStub
End If
Eos: Exit Function
ErrH:
On Error Goto 0
Error Err, "GetNextStub.DeletionStubCollection("& Cstr(Erl) &"): "& Error$
Resume Eos
End Function

Property Get Count As Long
Count = IDEntries(Me.hTable)
End Property
Property Get Parent
Set Parent = Me.ParentDb
End Property
Property Get CurrentPos As Single
CurrentPos = CurrentNum / Count
End Property
Property Get Since As Variant
Call ConvTIMEDATEtoDateTime(tdEnd, Since)
End Property

Sub Delete
If hTable<>0 Then Call IDDestroyTable(hTable)
If hDb<>0 Then Call NSFDbClose(hDb)
End Sub

Private Function SrchNext(Stub As DeletionStub) As Integer
Dim tdModified As TIMEDATE
Dim DeletedNoteID As Long
Dim iStatus As Integer

Do
CurrentNum = CurrentNum+1
If (Stub.CurrNoteID And RRV_DELETED) Then 'test for deleted flag bit
DeletedNoteID = Stub.CurrNoteID And (Not RRV_DELETED) 'clear flag bit so we won't get an error indicating an invalid note
'get the information we need about the note
iStatus = NSFDbGetNoteInfo(hDb, DeletedNoteID, Stub.NoteOID, tdModified, Stub.NoteClass)
If iStatus = ERR_NOTE_DELETED Then 'check to see that this note is in fact a deletion stub
Call ConvTIMEDATEtoDateTime(tdModified, Stub.LastModified)
SrchNext = True
Exit Function
Elseif iStatus <> NOERROR Then
Error 7000+iStatus, eHead & GetCAPIErrorMsg(iStatus) &" ("& Hex$(DeletedNoteID) &")"
End If
End If
Loop Until IDScan(hTable, False, Stub.CurrNoteID)<>1
End Function
End Class

Dim Platform As Integer

Declare Function W32NSFDbGetModifiedNoteTable Lib "nnotes" Alias "NSFDbGetModifiedNoteTable" ( _
Byval hDb As Long, Byval NoteClassMask As Integer, Byval Innards1 As Long, Byval Innards2 As Long, _
retUntil As TIMEDATE, rethTable As Long) As Integer
Declare Function Os2NSFDbGetModifiedNoteTable Lib "inotes" Alias "NSFDbGetModifiedNoteTable" ( _
Byval hDb As Long, Byval NoteClassMask As Integer, Byval Innards1 As Long, Byval Innards2 As Long, _
retUntil As TIMEDATE, rethTable As Long) As Integer
Declare Function LnxNSFDbGetModifiedNoteTable Lib "libnotes.so" Alias "NSFDbGetModifiedNoteTable" ( _
Byval hDb As Long, Byval NoteClassMask As Integer, Byval Innards1 As Long, Byval Innards2 As Long, _
retUntil As TIMEDATE, rethTable As Long) As Integer

Declare Function W32IDEntries Lib "nnotes" Alias "IDEntries"(Byval hTable As Long) As Long
Declare Function Os2IDEntries Lib "inotes" Alias "IDEntries"(Byval hTable As Long) As Long
Declare Function LnxIDEntries Lib "libnotes.so" Alias "IDEntries"(Byval hTable As Long) As Long

Declare Function W32IDScan Lib "nnotes" Alias "IDScan"(Byval hTable As Long, Byval fFirst As Integer, _
retID As Long) As Integer
Declare Function Os2IDScan Lib "inotes" Alias "IDScan"(Byval hTable As Long, Byval fFirst As Integer, _
retID As Long) As Integer
Declare Function LnxIDScan Lib "libnotes.so" Alias "IDScan"(Byval hTable As Long, Byval fFirst As Integer, _
retID As Long) As Integer

Declare Function W32IDDestroyTable Lib "nnotes" Alias "IDDestroyTable" (Byval hTable As Long) As Integer
Declare Function Os2IDDestroyTable Lib "inotes" Alias "IDDestroyTable" (Byval hTable As Long) As Integer
Declare Function LnxIDDestroyTable Lib "libnotes.so" Alias "IDDestroyTable" (Byval hTable As Long) As Integer

Sub Initialize
Dim session As NotesSession
Set session = New NotesSession
Select Case session.Platform
Case "Windows/32"
Platform = 1
Case "OS/2v2"
Platform = 2
Case "Windows/16"
Platform = 3
Case "Linux"
Platform = 4
End Select
End Sub
Function NSFDbGetModifiedNoteTable(Byval hDb As Long, Byval NoteClassMask As Integer, Byval Innards1 As Long, Byval Innards2 As Long, _
retUntil As TIMEDATE, rethTable As Long) As Integer
Select Case Platform
Case 1
NSFDbGetModifiedNoteTable = W32NSFDbGetModifiedNoteTable(hDb, NoteClassMask, Innards1, Innards2, _
retUntil, rethTable)
Case 2
NSFDbGetModifiedNoteTable = Os2NSFDbGetModifiedNoteTable(hDb, NoteClassMask, Innards1, Innards2, _
retUntil, rethTable)
Case 4
NSFDbGetModifiedNoteTable = LnxNSFDbGetModifiedNoteTable(hDb, NoteClassMask, Innards1, Innards2, _
retUntil, rethTable)
End Select
End Function

Function IDEntries(Byval hTable As Long) As Long
Select Case Platform
Case 1
IDEntries = W32IDEntries(hTable)
Case 2
IDEntries = Os2IDEntries(hTable)
Case 4
IDEntries = LnxIDEntries(hTable)
End Select
End Function
Function IDScan(Byval hTable As Long, Byval fFirst As Integer, retID As Long) As Integer
Select Case Platform
Case 1
IDScan = W32IDScan(hTable, fFirst, retID)
Case 2
IDScan = Os2IDScan(hTable, fFirst, retID)
Case 4
IDScan = LnxIDScan(hTable, fFirst, retID)
End Select
End Function
Function IDDestroyTable(Byval hTable As Long) As Integer
Select Case Platform
Case 1
IDDestroyTable = W32IDDestroyTable(hTable)
Case 2
IDDestroyTable = Os2IDDestroyTable(hTable)
Case 4
IDDestroyTable = LnxIDDestroyTable(hTable)
End Select
hTable = 0
End Function

Опубликовано — 06/20/2007 |

Добавить комментарий Имя * : e-mail Комментарий * : Код подтверждения * :