1

Тема: Удаление старых документов с базы.

Агент удаляет документы и вложения, в зависимости от времени в днях в служебных полях Del_XML_Time и Del_Lotus_Time.


Option Public
Use "Lib_Other"
Sub Initialize

    On Error GoTo ErrH
    Dim session As New NotesSession, db As NotesDatabase    
    Dim doc As NotesDocument' доки в роутере
    Dim item As NotesItem, object As NotesEmbeddedObject, rtitem As NotesRichTextItem
    Dim dateTime As New NotesDateTime( "" ), DocColl As NotesDocumentCollection
    Dim vFile As NotesEmbeddedObject
    Dim i As Integer        
    
    Print "KillOldXML старовал агент!"
    
    Call dateTime.SetNow
    Set db = session.CurrentDatabase ' роутер
    Set view_conf=db.GetView("Config")
    Set doc_conf=view_conf.GetFirstDocument
    If doc_conf.Del_XML_Time(0) = "" Then Print("Поле Del_XML_Time в конфиге пустое!") :  Exit Sub
    If doc_conf.Del_Lotus_Time(0) = "" Then Print("Поле Del_Lotus_Time в конфиге пустое!") :  Exit Sub
    Del_XML_Time% =    CInt (doc_conf.Del_XML_Time(0)) * (-1)
    Del_Lotus_Time% = CInt (doc_conf.Del_Lotus_Time(0))* (-1)
    
    Dim weekDateTime As NotesDateTime
    Set weekDateTime = New NotesDateTime( "Today" )
    Call weekDateTime.AdjustDay( Del_XML_Time% )
    Print "weekDateTime.DateOnly    " CStr(weekDateTime.DateOnly)
    
    searchFormula$ = {Form = "fmejved" & kill !="1" & @Created < @date([} & CStr(weekDateTime.DateOnly) & {])}
    Print "searchFormula " searchFormula$ 
    Dim collection As NotesDocumentCollection

    'Call dateTime.SetNow
    'Call dateTime.AdjustMonth(-1) 
    Set DocColl = db.Search(searchFormula$,Nothing,0)    'dateTime

    Print "DocColl.Count:" DocColl.Count 


    If DocColl.Count=0 Then
      Print "1.агент KillOldXML нет  XML документов."
    Else
        For i=1 To DocColl.count
            Set doc = DocColl.GetNthDocument(i)
            Print CStr(doc.Created)  " - "  CStr(doc.ЗАГОЛОВОК(0))
            Set rtitem = doc.GetFirstItem( "ПРИЛОЖЕНИЯ_" )
            Print "ПРИЛОЖЕНИЯ_"
            If Not IsEmpty( rtitem.EmbeddedObjects) Then

                Set vFile = rtitem.GetEmbeddedObject(rtitem.EmbeddedObjects(0).Source)
                If Not ( vFile Is Nothing ) Then
                    If ( vFile.Type = EMBED_ATTACHMENT ) Then
                    Print "EMBED_ATTACHMENT"
                Else
                    Print "EMBED_NO"
                End If    
                Call vFile.Remove 'удаляем аттачмент с лотус дока
                Call rtitem.Update
        
                doc.kill="1"
                Call doc.Save(True, False)            
                Print doc.ЗАГОЛОВОК(0) " удалили вложение"
                    End If
            End If            
        Next
    End If
    

    Print  "2. Удаление старых карточек" 
    Call weekDateTime.AdjustDay( Del_Lotus_Time% )
    searchFormula$ = {Form = "fmejved" & @Created < @date([} & CStr(weekDateTime.DateOnly) & {])}
    Print "searchFormula " searchFormula$ 
    Set DocColl = db.Search(searchFormula$,Nothing,0)
    
    If DocColl.Count=0 Then
        Print "2.агент KillOldXML нет старых лотус карточек."
    Else
        Print "DocColl.Count на удаление старых карточек:" DocColl.Count 
        For i=1 To DocColl.count
            Set doc = DocColl.GetNthDocument(i)
            Print CStr(doc.Created)
            doc.Remove(1) 
        Next
    End If

    

    Print "KillOldXML - Отработал!" 
    
    Exit Sub
    
    
    
    %REM     Вадим - примерно так хотел? нет.. я так не хотел...
        
    Dim view As NotesView
    formula="SELECT (Form = "fmejved") & @Created  < @date("+  CStr(weekDateTime.DateOnly)    + ")"  
    Set view= db.CreateView("tmp",formula)
    view.Autoupdate = false
        Set doc=view.GetFirstDocument        
    While Not doc Is Nothing        
doc.Remove(1) 
Set doc = view.GetNextDocument( doc )                        
Wend        
                
    %End rem
    
ErrH:
    
    Print "ошибка - KillOldXML Agent"
'Запись об ошибке в лог
    Print "Агент KillOldXML - Ошибка: " & Error(Err) & " в строке " & Erl
    infa$=CStr(Now) & " Агент "& agent.Name &" (ф-ция Initialize): " & "Ошибка " & Error$  & " в строке " & Erl()
    If Not(doc Is Nothing) Then infa$=infa$ & " UNID doc: " & doc.Universalid
    If Not(docD Is Nothing) Then infa$=infa$ & " UNID docD: " & docD.Universalid  
    Call AppendsInLogs(db, infa$)
    Print "лог сохранен"
            Exit Sub
End Sub

Поделиться

2

Re: Удаление старых документов с базы.

Вот еще аналогичный агент для чуть другой модификации базы.

Option Public
Option Declare

Sub Initialize

    On Error GoTo ErrH
    Dim session As New NotesSession, db As NotesDatabase    
    Dim doc As NotesDocument' доки в роутере
    Dim item As NotesItem, object As NotesEmbeddedObject, rtitem As NotesRichTextItem
    Dim dateTime As New NotesDateTime( "" ), DocColl As NotesDocumentCollection
    Dim vFile As NotesEmbeddedObject
    Dim i As Integer, Del_XML_Time As Integer, Del_Lotus_Time As Integer        
    Dim view_conf As NotesView, doc_conf As NotesDocument
    Dim searchFormula As String
    Print "KillOldXML старовал агент!"
    
    Call dateTime.SetNow
    Set db = session.CurrentDatabase ' роутер
    Set view_conf=db.GetView("from")
    Set doc_conf=view_conf.GetFirstDocument
    If doc_conf.Del_XML_Time(0) = "" Then Print("Поле Del_XML_Time в конфиге пустое!") :  Exit Sub
    If doc_conf.Del_Lotus_Time(0) = "" Then Print("Поле Del_Lotus_Time в конфиге пустое!") :  Exit Sub
    Del_XML_Time% =    CInt (doc_conf.Del_XML_Time(0)) * (-1)
    Del_Lotus_Time% = CInt (doc_conf.Del_Lotus_Time(0))* (-1)
    
    Dim weekDateTime As NotesDateTime
    Set weekDateTime = New NotesDateTime( "Today" )
    Call weekDateTime.AdjustDay( Del_XML_Time% )
    Print "weekDateTime.DateOnly    " CStr(weekDateTime.DateOnly)
    '  
    searchFormula$ = { ((Form = "outgoing" &   confirm ="1") | (Form = "incoming" &  received ="1"))  & kill !="1" & @Created < @date([} & CStr(weekDateTime.DateOnly) & {])}
    Print "searchFormula " searchFormula$ 
    Dim collection As NotesDocumentCollection

    Set DocColl = db.Search(searchFormula$,Nothing,0)    'dateTime

    Print "DocColl.Count:" DocColl.Count 

    If DocColl.Count=0 Then
        Print "1.агент KillOldXML нет  XML документов."
    Else
        For i=1 To DocColl.Count
            
            Set doc = DocColl.GetNthDocument(i)
            Print i 
            Print CStr(doc.Created)  " - "  CStr( doc.form(0))  " - "   CStr(doc.header(0))
            Set rtitem = doc.GetFirstItem( "attach" )
            
                If  Not rtitem Is Nothing Then
                    If Not IsEmpty( rtitem.EmbeddedObjects) Then

                    Set vFile = rtitem.GetEmbeddedObject(rtitem.EmbeddedObjects(0).Source)
                        
                        If Not ( vFile Is Nothing ) Then
                            If ( vFile.Type = EMBED_ATTACHMENT ) Then
                                Print "EMBED_ATTACHMENT"
                                Call vFile.Remove 'удаляем аттачмент с лотус дока
                                Call rtitem.Update
                                doc.kill="1"
                                Call doc.Save(True, False)            
                                Print  "удалили вложение"
                            End If    
                        End If  'vFile
                        
                    End If        'rtitem.EmbeddedObjects    
                End If
            
        Next   
    End If  'DocColl.Count


    Print "KillOldXML - Отработал!" 
    Exit Sub
    
ErrH:
    Print "Агент KillOldXML - Ошибка: " & Error(Err) & " в строке " & Erl
    Exit Sub
End Sub

Поделиться

3

Re: Удаление старых документов с базы.

Агент для удаления документов с индексной базы, которых уже нет в  рабочей или оной базе.

Sub Initialize
    Dim session As New NotesSession
    Dim indexdb As NotesDatabase, sourcedb As NotesDatabase
    Dim indexview As NotesView, sourceview As NotesView
    Dim sourcedoc As NotesDocument, indexdoc As NotesDocument
    Dim item As NotesItem
    Dim server As String, formula As String, st As String
    Dim i As Integer
    On Error GoTo ErrH    
    Print "AGENT Kill_Del - УДАЛЯЕМ В ИНДЕКСНОЙ ДОКИ, КОТОРЫЕ СТЕРТЫ В РАБОЧИХ БАЗАХ"    
    server=session.CurrentDatabase.Server
    Print "server " server
    Set indexdb = session.Currentdatabase  ' GetDatabase(server,"promdoc\index.nsf")
    Set indexview=indexdb.GetView("docunids")
    Print "indexview " indexview.Name
    i=1
        Set indexdoc=indexview.GetFirstDocument    
        While Not indexdoc Is Nothing
Set    sourcedb = session.Getdatabase(server, indexdoc.database(0))
            Set sourcedoc=DatabaseGetDocumentByUnid(sourcedb,indexdoc.docunid(0))
            If sourcedoc Is Nothing Then    ' DEL
                Print CStr(i) ".Удалить "    indexdoc.header(0)
                indexdoc.del="1"
                Call indexdoc.save(1,1)
                i=i+1
            End If
            Set indexdoc=indexview.GetNextDocument(indexdoc)
        Wend
        
    searchFormula$ = { Form = "index" &  del ="1"  }
    Print "searchFormula " searchFormula$ 
    Dim DocColl As NotesDocumentCollection

    Set DocColl = indexdb.Search(searchFormula$,Nothing,0) 
    If DocColl.Count=0 Then
            Print "агент Kill_Del нет  мертвых документов."
    Else
            Print DocColl.Count
            For i=1 To DocColl.Count
                Set doc = DocColl.GetNthDocument(i)
                Print i     
                Call doc.remove (true)
            Next
        End If
                    
    Print "AGENT Kill_Del - конец"    
    Exit Sub
ErrH:
    Print "Kill_Del! - Ошибка: " & Error(Err) & " в строке " & Erl
    Exit Sub
End Sub

Поделиться