Дополнительные инструменты в панели инструментов |
|
|
|
Классы для работы со стабами удалённых документов для Windows64 |
|
|
|
Базовые компоненты XPages Extension Library: Widget Container Серия статьей дающая представление о базовых компонентах Extension Library, их основных свойствах и мест применения |
|
|
|
|
Главная Библиотека Шаблоны и примерыКлассы для работы со стабами удалённых документов
Классы для работы со стабами удалённых документов
Константин Червоненко
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
Библиотека оформлена в виде файла stubs.lss Скачать >>>
В библиотеке используется подключение кода из файлов common.lss >>>, declare.lss >>>, timedate.lss >>>
Разместите файлы в каталоге программ Notes, при отличном от этого размещения пропишите полный путь к файлу в директиве %Include
Читайте также Классы для работы со стабами удалённых документов для Windows64 >>>
|
Опубликовано — 06/20/2007 |
| |
|
|
Последнее на форуме |
 |
|
 |
|
|