How To Count And Delete Deletion Stubs

  • Автор темы Akupaka
  • Дата начала
R

rinsk

Lotus team
12.11.2009
1 049
86
Надеюсь авторы будет не против, если размещу здесь доработку класса для получения 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
 
  • Нравится
Реакции: The Codeby
Мы в соцсетях:  ТелеграмВконтактеДзенФейсбукТвиттерЮтуб