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: Удаление старых документов с базы.

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

%REM
    Agent KillOldXML
    Created Feb 28, 2024 by Administrator NYY VSMJ/VSPMRMJ
    Description: Comments for Agent
%END REM
Option Public
Option Declare

Sub Initialize
  %REM 
  2.0 - ВКЛючена отправка ConfirmationXXX.xml  на FTP    
  %END REM
    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") | (Form = "incoming") & kill !="1" &   issend !="2"  & @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 CStr(doc.Created)  " - "  CStr(doc.header(0))
            If doc.form(0)= "outgoing" then
            Set rtitem = doc.GetFirstItem( "attach" )
            else
            Set rtitem = doc.GetFirstItem( "text" ) ' входящий
            End If
            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 = "outgoing") | (Form = "incoming")  & @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
    
ErrH:
    Print "Агент KillOldXML - Ошибка: " & Error(Err) & " в строке " & Erl
    Exit Sub
End Sub

Поделиться