Надеюсь авторы
в базе ок 1 млн доков находил 500 тыс окурков.
Если вылетала ошибка "Notes C API Error: Unable to extend an ID table - insufficient memory" то лечилось load compact -REPLICA -RESTART и повторным запуском. ODS52
Агент привожу целиком:
Ссылка скрыта от гостей
будет не против, если размещу здесь доработку класса для получения deleted stub под linux/64в базе ок 1 млн доков находил 500 тыс окурков.
Если вылетала ошибка "Notes C API Error: Unable to extend an ID table - insufficient memory" то лечилось load compact -REPLICA -RESTART и повторным запуском. ODS52
Агент привожу целиком:
Код:
%Include "lsconst.lss"
'Option Public
' --- Notes C API declares and constants (translated from the header files)
Public Const TIMEDATE_MINIMUM = 0
Public Const TIMEDATE_MAXIMUM = 1
Public Const TIMEDATE_WILDCARD = 2
Public Const MAXALPHATIMEDATE = 80
' --- note classifications
Public Const NOTE_CLASS_DOCUMENT = &H0001
Public Const NOTE_CLASS_INFO = &H0002
Public Const NOTE_CLASS_FORM = &H0004
Public Const NOTE_CLASS_VIEW = &H0008
Public Const NOTE_CLASS_ICON = &H0010
Public Const NOTE_CLASS_DESIGN = &H0020
Public Const NOTE_CLASS_ACL = &H0040
Public Const NOTE_CLASS_HELP_INDEX = &H0080
Public Const NOTE_CLASS_HELP = &H0100
Public Const NOTE_CLASS_FILTER = &H0200
Public Const NOTE_CLASS_FIELD = &H0400
Public Const NOTE_CLASS_REPLFORMULA = &H0800
Public Const NOTE_CLASS_PRIVATE = &H1000
Public Const NOTE_CLASS_ALL = &H7fff&
'Public Const NOTE_CLASS_ALL = &Hffff&
Public Const UPDATE_NOSTUB = &H0200 'Ключик для NSFNoteDelete
'Public Const NOTE_CLASS_ALL = &H7fff
Const ERROR_ErrTypeMismatch = 13
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 Type TIMEDATE
Innards(1) As Long
End Type
Public Type OID
FileDBID As TIMEDATE
Note As TIMEDATE
Sequence As Long
SequenceTime As TIMEDATE
End Type
Declare Function W32ConvertTIMEDATEToText Lib "nnotes" Alias "ConvertTIMEDATEToText"(ByVal intFormat&, ByVal TextFormat&, InputTime As TIMEDATE, ByVal retTextBuffer$, ByVal TextBufferLength%, retTextLength%) As Integer
Declare Function Os2ConvertTIMEDATEToText Lib "inotes" Alias "ConvertTIMEDATEToText"(ByVal intFormat&, ByVal TextFormat&, InputTime As TIMEDATE, ByVal retTextBuffer$, ByVal TextBufferLength%, retTextLength%) As Integer
Declare Function LnxConvertTIMEDATEToText Lib "libnotes.so" Alias "ConvertTIMEDATEToText"(ByVal intFormat&, ByVal TextFormat&, InputTime As TIMEDATE, ByVal retTextBuffer$, ByVal TextBufferLength%, retTextLength%) As Integer
Declare Function W32NSFNoteDelete Lib "nnotes" Alias "NSFNoteDelete" ( ByVal hDb As Long, ByVal NoteID As Long, ByVal UpdateFlags As Integer) As Integer
Declare Function Os2NSFNoteDelete Lib "inotes" Alias "NSFNoteDelete" ( ByVal hDb As Long, ByVal NoteID As Long, ByVal UpdateFlags As Integer ) As Integer
Declare Function LnxNSFNoteDelete Lib "libnotes.so" Alias "NSFNoteDelete" ( ByVal hDb As Long, ByVal NoteID As Long, ByVal UpdateFlags As Integer ) As Integer
Declare Sub W32TimeConstant Lib "nnotes" Alias "TimeConstant"(ByVal TimeConstantType As Integer, td As TIMEDATE)
Declare Sub Os2TimeConstant Lib "inotes" Alias "TimeConstant"(ByVal TimeConstantType As Integer, td As TIMEDATE)
Declare Sub LnxTimeConstant Lib "libnotes.so" Alias "TimeConstant"(ByVal TimeConstantType As Integer, td As TIMEDATE)
Declare Sub W32OSPathNetConstruct Lib "nnotes" Alias "OSPathNetConstruct" ( ByVal portName As LMBCS String, ByVal ServerName As LMBCS String, ByVal FileName As String, ByVal retPathName As String)
Declare Sub Os2OSPathNetConstruct Lib "inotes" Alias "OSPathNetConstruct" ( ByVal portName As LMBCS String, ByVal ServerName As LMBCS String, ByVal FileName As String, ByVal retPathName As String)
Declare Sub LnxOSPathNetConstruct Lib "libnotes.so" Alias "OSPathNetConstruct" ( ByVal portName As LMBCS String, ByVal ServerName As LMBCS String, ByVal FileName As String, ByVal retPathName As String)
Declare Function W32NSFDbOpen Lib "nnotes" Alias "NSFDbOpen" (ByVal PathName As LMBCS String, rethDb As Long) As Integer
Declare Function Os2NSFDbOpen Lib "inotes" Alias "NSFDbOpen" (ByVal PathName As LMBCS String, rethDb As Long) As Integer
Declare Function LnxNSFDbOpen Lib "libnotes.so" Alias "NSFDbOpen" (ByVal PathName As LMBCS String, rethDb As Long) As Integer
Declare Function W32NSFDbClose Lib "nnotes" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Function Os2NSFDbClose Lib "inotes" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Function LnxNSFDbClose Lib "libnotes.so" Alias "NSFDbClose" (ByVal hDb As Long) As Integer
Declare Function W32OSLoadString Lib "nnotes" Alias "OSLoadString" (ByVal hModule As Long, ByVal StringCode As Integer, ByVal retBuffer As LMBCS String, ByVal BufferLength As Integer) As Integer
Declare Function Os2OSLoadString Lib "inotes" Alias "OSLoadString" (ByVal hModule As Long, ByVal StringCode As Integer, ByVal retBuffer As LMBCS String, ByVal BufferLength As Integer) As Integer
Declare Function LnxOSLoadString Lib "libnotes.so" Alias "OSLoadString" (ByVal hModule As Long, ByVal StringCode As Integer, ByVal retBuffer As LMBCS String, ByVal BufferLength As Integer) As Integer
Declare Function W64IDEntries Lib "nnotes" Alias "IDEntries"(ByVal hTable As Double) As Long
Declare Function L64IDEntries Lib "libnotes.so" Alias "IDEntries"(ByVal hTable As Double) As Long
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 W64IDScan Lib "nnotes" Alias "IDScan"(ByVal hTable As Double, ByVal fFirst As Integer, retID As Long) As Integer
Declare Function L64IDScan Lib "libnotes.so" Alias "IDScan"(ByVal hTable As Double, ByVal fFirst As Integer, retID As Long) As Integer
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 W64IDDestroyTable Lib "nnotes" Alias "IDDestroyTable" (ByVal hTable As Double) As Integer
Declare Function L64IDDestroyTable Lib "libnotes.so" Alias "IDDestroyTable" (ByVal hTable As Double) 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
Declare Function W32NSFDbGetNoteInfo Lib "nnotes" Alias "NSFDbGetNoteInfo"(ByVal hDb As Long, ByVal NoteID As Long, _
retNoteOID As OID, retModified As TIMEDATE, retNoteClass As Integer) As Integer
Declare Function Os2NSFDbGetNoteInfo Lib "inotes" Alias "NSFDbGetNoteInfo"(ByVal hDb As Long, ByVal NoteID As Long, _
retNoteOID As OID, retModified As TIMEDATE, retNoteClass As Integer) As Integer
Declare Function LnxNSFDbGetNoteInfo Lib "libnotes.so" Alias "NSFDbGetNoteInfo"(ByVal hDb As Long, ByVal NoteID As Long, _
retNoteOID As OID, retModified As TIMEDATE, retNoteClass As Integer) 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 W64NSFDbGetModifiedNoteTable Lib "nnotes" Alias "NSFDbGetModifiedNoteTable" (ByVal hDb As Long, ByVal NoteClassMask As Long, ByVal sinceDate As Double, retUntil As TIMEDATE, rethTable As Double) As Integer
Declare Function L64NSFDbGetModifiedNoteTable Lib "libnotes.so" Alias "NSFDbGetModifiedNoteTable" (ByVal hDb As Long, ByVal NoteClassMask As Long, ByVal sinceDate As Double, retUntil As TIMEDATE, rethTable As Double) As Integer
Public Class DeletionStub
Private session As NotesSession
Private platform As Long
Private ParentRef As DeletionStubCollection
Private CurrNoteID As Long
Private NoteOID As OID
Private errorSequenceConvert As Boolean
Public NoteClass As Integer
Public LastModified As Variant
Sub New(session As NotesSession)
Set Me.session = session
Select Case Me.session.platform
Case "Windows/32":
Me.platform = 1
Case "Windows/64":
Me.platform = 8
Case "Linux/64":
Me.platform = 9
Case "OS/2v2":
Me.platform = 2
Case "Windows/16":
Me.platform = 3
Case "Linux":
Me.platform = 4
Case Else
Error 4000,"Unsupported platform:" & Me.session.platform
End Select
End Sub
Property Get NoteID As String
NoteID = Hex$(Me.CurrNoteID And (Not RRV_DELETED))
End Property
Property Get UNID As String
UNID = Right$(padl & Hex$(Me.NoteOID.FileDBID.Innards(1)),8) & Right$(padl & Hex$(Me.NoteOID.FileDBID.Innards(0)),8)_
& Right$(padl & Hex$(Me.NoteOID.Note.Innards(1)),8) & Right$(padl & Hex$(Me.NoteOID.Note.Innards(0)),8)
End Property
Property Get Created As Variant
Call Me.ConvTIMEDATEtoDateTime(Me.NoteOID.Note, Created)
End Property
Property Get Parent
Set Parent = Me.ParentRef
End Property
Property Get sequence As Long
sequence = Me.NoteOID.sequence
End Property
Property Get sequenceTime As Variant
On Error GoTo ErrH
Call Me.ConvTIMEDATEtoDateTime(Me.NoteOID.sequenceTime, sequenceTime)
Eos: Exit Property
ErrH:
On Error GoTo 0
If Err = ERROR_ErrTypeMismatch Then sequenceTime = CDat(0) : Me.errorSequenceConvert = True
Resume Eos
End Property
Property Get isErrorSequence As Boolean
isErrorSequence = Me.errorSequenceConvert
End Property
Sub Remove
If Me.ParentRef.hDb=0 Then Exit Sub
Call Me.NSFNoteDelete(Me.ParentRef.hDb, Me.CurrNoteID And (Not RRV_DELETED), UPDATE_NOSTUB)
' Delete Me
End Sub
Private Function ConvertTIMEDATEToText(ByVal intFormat&, ByVal TextFormat&, InputTime As TIMEDATE, retTextBuffer$, ByVal TextBufferLength%, retTextLength%) As Integer
Select Case Me.platform
Case 1, 8:
ConvertTIMEDATEToText = W32ConvertTIMEDATEToText(intFormat, TextFormat, InputTime, retTextBuffer, TextBufferLength, retTextLength)
Case 2:
ConvertTIMEDATEToText = Os2ConvertTIMEDATEToText(intFormat, TextFormat, InputTime, retTextBuffer, TextBufferLength, retTextLength)
Case 4,9:
ConvertTIMEDATEToText = LnxConvertTIMEDATEToText(intFormat, TextFormat, InputTime, retTextBuffer, TextBufferLength, retTextLength)
End Select
End Function
Private Sub ConvTIMEDATEtoDateTime(td As TIMEDATE, nt As Variant)
Dim buf As String
Dim rc As Integer, rlen As Integer
On Error GoTo ErrH
buf = Space$(32)
rc = Me.ConvertTIMEDATEToText(0&,0&, td, buf, Len(buf)-1, rlen)
If rc<>0 Then Error 7000,"ConvTIMEDATEtoDateTime: ConvertTIMEDATEToText rc="& CStr(rc)
Select Case DataType(nt)
Case V_PRODOBJ
Set nt = New NotesDateTime(Trim$(buf))
Case Else
nt = CDat(Trim$(buf))
End Select
Eos: Exit Sub
ErrH:
On Error GoTo 0
Error Err, "ConvTIMEDATEtoDateTime("& CStr(Erl) &"): "& Error$
Resume Eos
End Sub
Private Function NSFNoteDelete(ByVal hDb As Long, ByVal NoteID As Long, ByVal UpdateFlags As Integer) As Integer
Select Case Me.platform
Case 1, 8:
NSFNoteDelete = W32NSFNoteDelete(hDb, NoteID, UpdateFlags)
Case 2:
NSFNoteDelete = Os2NSFNoteDelete(hDb, NoteID, UpdateFlags)
Case 4,9:
NSFNoteDelete = LnxNSFNoteDelete(hDb, NoteID, UpdateFlags)
End Select
End Function
End Class
Public Class DeletionStubCollection As DeletionStub
Private isOnServer As Boolean
Private server As String
Private parentDb As NotesDatabase
Private hDb As Long
Private hTable As Long
Private hTable64 As Double
Private tdEnd As TIMEDATE
Private currentNum As Long
Sub New(session As NotesSession, db As NotesDatabase, ByVal iNoteClass As Integer, ByVal iSince As Variant), DeletionStub(session)
Me.isOnServer = Me.session.isOnServer
Dim currentDatabase As NotesDatabase
Set currentDatabase = Me.session.currentDatabase
Me.server = currentDatabase.server
Dim tdStart As TIMEDATE
Dim sPath As String
Dim iStatus As Integer
Dim sinceDate As Double
On Error GoTo ErrH
If iNoteClass=0 Then iNoteClass = NOTE_CLASS_DOCUMENT
Select Case DataType(iSince)
Case V_DATE
Me.ConvDateTimeToTIMEDATE iSince, tdStart
sinceDate = CDbl(iSince)
Case V_PRODOBJ
Me.ConvDateTimeToTIMEDATE iSince.LSLocalTime, tdStart
sinceDate = CDbl(iSince.LSLocalTime)
Case Else
Me.TimeConstant TIMEDATE_WILDCARD, tdStart
sinceDate = CDbl(TIMEDATE_WILDCARD)
End Select
'build an API-friendly path to the current database (i.e., !!)
sPath = String$(MAXPATH, 0)
Dim server As String
If Me.isOnServer Then ' если скрипт выполняется на сервере
If Not Me.server = db.server Then server = db.server ' если база открывается на другом сервере, в противном случае - локально
Else
server = db.server
End If
Me.OSPathNetConstruct "", server, db.filePath, sPath
sPath = Left$(sPath, InStr(1, sPath, Chr$(0)) - 1)
iStatus = Me.NSFDbOpen(sPath, Me.hDb)
If iStatus <> NOERROR Then
Error 7000+iStatus, eHead & Me.GetCAPIErrorMsg(iStatus)
End If
iStatus = NSFDbGetModifiedNoteTable(iNoteClass, tdStart.Innards(0), tdStart.Innards(1), sinceDate)
If iStatus <> NOERROR Then
Call Me.NSFDbClose
Error 7000+iStatus, eHead & GetCAPIErrorMsg(iStatus)
End If
Set Me.parentDb = db
Me.currentNum = 0
Eos: Exit Sub
ErrH:
On Error GoTo 0
Error Err, "New.DeletionStubCollection("& CStr(Erl) &"): "& Error$
Resume Eos
End Sub
Public Sub Delete
If Me.platform = 8 Or Me.platform=9 Then
If Me.hTable64<>0 Then Call Me.IDDestroyTable()
Else
If Me.hTable<>0 Then Call Me.IDDestroyTable()
End If
If Me.hDb<>0 Then Call NSFDbClose()
End Sub
Public Function getFirstStub() As DeletionStub
On Error GoTo ErrH
Set getFirstStub = New DeletionStub(Me.session)
If Me.IDScan(True, getFirstStub.CurrNoteID) Then
If Me.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(Me.session)
Set getNextStub.ParentRef = Me
getNextStub.currNoteID = stub.currNoteID
If IDScan(False, getNextStub.currNoteID) Then
If Not Me.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
Public Property Get count As Long
count = Me.IDEntries()
End Property
Public Property Get parent
Set parent = Me.parentDb
End Property
Public Property Get currentPos As Single
currentPos = currentNum / count
End Property
Public Property Get since As Variant
Call Me.ConvTIMEDATEtoDateTime(Me.tdEnd, since)
End Property
Private Sub TimeConstant(ByVal TimeConstantType As Integer, td As TIMEDATE)
Select Case Me.platform
Case 1,8:
Call W32TimeConstant(TimeConstantType, td)
Case 2
Call Os2TimeConstant(TimeConstantType, td)
Case 4,9
Call LnxTimeConstant(TimeConstantType, td)
End Select
End Sub
Private Sub ConvDateTimeToTIMEDATE(nt As Variant, td As TIMEDATE)
Dim nTime As NotesDateTime
Dim Intr As NotesInternational
Dim bits As String
On Error GoTo ErrH
Select Case DataType(nt)
Case V_DATE
Set nTime = session.CreateDateTime(CStr(nt))
Case V_PRODOBJ
Set nTime = nt
End Select
Set Intr = session.International
td.Innards(0) = ((Hour(nTime.LSGMTTime)*60+Minute(nTime.LSGMTTime))*60+Second(nTime.LSGMTTime))*100
bits = "&B"
If Intr.IsDST Then
bits = bits &"1"
Else
bits = bits &"0"
End If
If Intr.TimeZone<0 Then 'East?
bits = bits &"1"
Else
bits = bits &"0"
End If
bits = bits & Right$("0"& Bin$(CInt(Abs(Intr.TimeZone)\100)\15), 2) & Right$("000"& Bin$(Abs(Intr.TimeZone) Mod 100), 4)
bits = bits & Right$(String(23,"0") & Bin$(CLng(CDbl(nTime.LSLocalTime))+2415018), 24) 'дни от сотворения Мира
td.Innards(1)= Val(bits &"&")
Eos: Exit Sub
ErrH:
On Error GoTo 0
Error Err, "ConvDateTimeToTIMEDATE("& CStr(Erl) &"): "& Error$
Resume Eos
End Sub
Private Sub OSPathNetConstruct(ByVal portName As String, ByVal ServerName As String, ByVal FileName As String, retPathName As String)
Select Case Me.platform
Case 1, 8:
Call W32OSPathNetConstruct(PortName, ServerName, FileName, retPathName)
Case 2
Call Os2OSPathNetConstruct(PortName, ServerName, FileName, retPathName)
Case 4,9
Call LnxOSPathNetConstruct(PortName, ServerName, FileName, retPathName)
End Select
End Sub
Private Function OSLoadString(ByVal hModule As Long, ByVal StringCode As Integer, retBuffer As String, ByVal BufferLength As Integer) As Integer
Select Case Me.platform
Case 1, 8:
OSLoadString = W32OSLoadString(hModule, StringCode, retBuffer, BufferLength)
Case 2
OSLoadString = Os2OSLoadString(hModule, StringCode, retBuffer, BufferLength)
Case 4,9
OSLoadString = LnxOSLoadString(hModule, StringCode, retBuffer, BufferLength)
End Select
End Function
Private Function GetCAPIErrorMsg(iStatus As Integer) As String
%REM
GetCAPIErrorMsg - This function takes a status code returned from a C API call, retrieves the corresponding
error message from Notes' internal string tables, and returns the string to the caller.
%END REM
Const NULLHANDLE = 0&
Dim iLen As Integer
Dim sBuffer As String
sBuffer = String$(256, 0)
' --- get the API error message from the internal Notes/Domino string tables
iLen = Me.OSLoadString(NULLHANDLE, iStatus, sBuffer, Len(sBuffer) - 1)
If iLen > 0 Then
GetCAPIErrorMsg = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
Else
GetCAPIErrorMsg = "Unknown error"
End If
End Function
Private Function NSFDbOpen(ByVal PathName As String, rethDb As Long) As Integer
Select Case Me.platform
Case 1, 8:
NSFDbOpen = W32NSFDbOpen(PathName, rethDb)
Case 2
NSFDbOpen = Os2NSFDbOpen(PathName, rethDb)
Case 4,9
NSFDbOpen = LnxNSFDbOpen(PathName, rethDb)
End Select
End Function
Private Function NSFDbClose() As Integer
Select Case Me.platform
Case 1, 8:
NSFDbClose = W32NSFDbClose(Me.hDb)
Case 2
NSFDbClose = Os2NSFDbClose(Me.hDb)
Case 4,9
NSFDbClose = LnxNSFDbClose(Me.hDb)
End Select
Me.hDb = 0
End Function
Private Function NSFDbGetNoteInfo(ByVal NoteID As Long, retNoteOID As OID, retModified As TIMEDATE, retNoteClass As Integer) As Integer
Select Case Me.platform
Case 1, 8:
NSFDbGetNoteInfo = W32NSFDbGetNoteInfo(Me.hDb, NoteID, retNoteOID, retModified, retNoteClass)
Case 2
NSFDbGetNoteInfo = Os2NSFDbGetNoteInfo(Me.hDb, NoteID, retNoteOID, retModified, retNoteClass)
Case 4,9
NSFDbGetNoteInfo = LnxNSFDbGetNoteInfo(Me.hDb, NoteID, retNoteOID, retModified, retNoteClass)
End Select
End Function
Private Function IDEntries() As Long
Select Case Me.platform
Case 1
IDEntries = W32IDEntries(Me.hTable)
Case 2
IDEntries = Os2IDEntries(Me.hTable)
Case 4
IDEntries = LnxIDEntries(Me.hTable)
Case 8:
IDEntries = W64IDEntries(Me.hTable64)
Case 9:
IDEntries = L64IDEntries(Me.hTable64)
End Select
End Function
Private Function IDScan(ByVal fFirst As Integer, retID As Long) As Integer
Select Case Me.platform
Case 1
IDScan = W32IDScan(Me.hTable, fFirst, retID)
Case 2
IDScan = Os2IDScan(Me.hTable, fFirst, retID)
Case 4
IDScan = LnxIDScan(Me.hTable, fFirst, retID)
Case 8:
IDScan = W64IDScan(Me.hTable64, fFirst, retID)
Case 9:
IDScan = L64IDScan(Me.hTable64, fFirst, retID)
End Select
End Function
Private Function SrchNext(stub As DeletionStub) As Integer
Dim tdModified As TIMEDATE
Dim DeletedNoteID As Long
Dim iStatus As Integer
Do
Me.currentNum = Me.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 = Me.NSFDbGetNoteInfo(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 Me.ConvTIMEDATEtoDateTime(tdModified, stub.lastModified)
SrchNext = True
Exit Function
ElseIf iStatus <> NOERROR Then
Error 7000+iStatus, eHead & Me.GetCAPIErrorMsg(iStatus) &" ("& Hex$(DeletedNoteID) &")"
End If
End If
Loop Until Me.IDScan(False, stub.currNoteID)<>1
End Function
Private Function IDDestroyTable() As Integer
Select Case Platform
Case 1
IDDestroyTable = W32IDDestroyTable(Me.hTable)
Case 2
IDDestroyTable = Os2IDDestroyTable(Me.hTable)
Case 4
IDDestroyTable = LnxIDDestroyTable(Me.hTable)
Case 8:
IDDestroyTable = W64IDDestroyTable(Me.hTable64)
Case 9:
IDDestroyTable = L64IDDestroyTable(Me.hTable64)
End Select
Me.hTable = 0
End Function
Private Function NSFDbGetModifiedNoteTable(ByVal NoteClassMask As Integer, ByVal Innards1 As Long, ByVal Innards2 As Long, sinceDate As Double) As Integer
Select Case Platform
Case 1
NSFDbGetModifiedNoteTable = W32NSFDbGetModifiedNoteTable(Me.hDb, NoteClassMask, Innards1, Innards2, Me.tdEnd, Me.hTable)
Case 2
NSFDbGetModifiedNoteTable = Os2NSFDbGetModifiedNoteTable(Me.hDb, NoteClassMask, Innards1, Innards2, Me.tdEnd, Me.hTable)
Case 4
NSFDbGetModifiedNoteTable = LnxNSFDbGetModifiedNoteTable(Me.hDb, NoteClassMask, Innards1, Innards2, Me.tdEnd, Me.hTable)
Case 8:
NSFDbGetModifiedNoteTable = W64NSFDbGetModifiedNoteTable(Me.hDb, NoteClassMask, sinceDate, Me.tdEnd, Me.hTable64)
Case 9:
NSFDbGetModifiedNoteTable = L64NSFDbGetModifiedNoteTable(Me.hDb, NoteClassMask, sinceDate, Me.tdEnd, Me.hTable64)
End Select
End Function
End Class
Sub Initialize
GoTo begin
errors: MsgBox Error & "|" & "Agent.StubDeleter.Initialize:"& Erl
Exit Sub
begin:On Error GoTo errors
Dim session As New NotesSession
Dim currentDatabase As NotesDatabase
Set currentDatabase = session.currentDatabase
Dim stubs As DeletionStubCollection
Dim stub As DeletionStub, nextStub As DeletionStub
Dim cutoff_date As Variant
cutoff_date = DateValue(Now)-1
Print "Cutoff date:" , CStr(cutoff_date)
Set stubs = New DeletionStubCollection(session, currentDatabase, NOTE_CLASS_ALL, 0)
Print "Document counts in database:" , stubs.count
Set stub = stubs.getFirstStub()
Dim i As Long
Dim stubs_all As Long, stubs_count As Long
Dim sdoc As NotesDocument
Do While Not stub Is Nothing
Set nextStub = stubs.getNextStub(stub)
i= i + 1
If stub.sequenceTime < cutoff_date Then
' Set sdoc=currentDatabase.Getdocumentbyid(stub.noteId) ' пока бегали - оно стало доком...
' If sdoc Is Nothing Then
Call stub.remove
stubs_count = stubs_count + 1
' Else
' Print stub.noteId,sdoc.Isvalid,sdoc.Isdeleted
' End if
End If
If Not stub Is Nothing Then Delete stub
If i Mod 10000 = 0 Then Print "found stub.", i, "deleted:",stubs_count
' Print stub.noteId, stub.unid, stub.created, stub.sequence, stub.sequenceTime
Set stub = nextStub
Loop
Print "Total stubs:", i
Print "Deleted stubs", stubs_count
End Sub