Bonne lecture
- Code : Tout sélectionner
Option Public
Option Declare
Use "LogManager"
Const TEMP_AGENT_NAME = "send-digest-as-user"
Dim session As NotesSession
Dim LF As String
Sub Initialize
Dim users As Variant
Set session = New NotesSession()
LF = Chr(10)
On Error Goto LogError
Call LogBegin
LogTitle "Send Digest", COLOR_DARK_BLUE, 12
LogText "Début de l'execution", COLOR_BLACK, False
users = Evaluate(|@Sort(@Unique(@DbColumn("":"" ; "":"" ; "vwSUB" ; 3)))|)
Forall user In users
LogText "- " + Cstr(user), COLOR_BLACK, True
' first delete the agent, if it exists (replace it doesn't work for an unknown reason)
LogText "Suppression de l'agent '" + TEMP_AGENT_NAME + "'", COLOR_GRAY, False
Call removeAgent()
' then create it w/ DXL, running on behalf of the current user in the loop
LogText "Création de l'agent via DXL", COLOR_GRAY, False
Call createDXLAgent(Cstr(user))
' sign the newly created agent
LogText "Signature de l'agent", COLOR_GRAY, False
Call signDXLAgent()
' and finally run it
LogText "Exécution de l'agent", COLOR_GRAY, False
Call runAgent()
End Forall
fin:
LogText "Fin de l'execution", COLOR_BLACK, False
Call LogEnd
Exit Sub
logError :
Call LogError("Erreur "+ Cstr(Err) + " à la ligne n°"+Cstr(Erl)+" - "+ Error)
Resume fin
End Sub
Function createDXLAgent(username As String) As Boolean
Dim inputStream As NotesStream
Dim importer As NotesDXLImporter
Dim xml As String
On Error Goto LogError
' build the DXL content
xml = |<?xml version='1.0' encoding='ISO-8859-1'?>| + LF ' problems with special characters and UTF-8 (on Windows 2003)
xml = xml + |<!DOCTYPE agent SYSTEM 'xmlschemas/domino_7_0_2.dtd'>| + LF
xml = xml + |<agent name='| + TEMP_AGENT_NAME + |' hide='v3' publicaccess='false' designerversion='7' runonbehalfof='| + username + |'>| + LF
xml = xml + |<noteinfo><created><datetime dst='true'>20071023T145402,68+02</datetime></created></noteinfo>| + LF
xml = xml + |<designchange><datetime dst='true'>20071023T145523,52+02</datetime></designchange>| + LF
xml = xml + |<trigger type='actionsmenu'/>| + LF
xml = xml + |<documentset type='runonce'/><code event='options'><lotusscript>Option Public
Option Declare
Use "DigestManager"
</lotusscript></code><code event='initialize'><lotusscript>Sub Initialize
Dim s as new NotesSession
Dim dm As New DigestManager(s, "| + username + |")
Call dm.send()
End Sub</lotusscript></code>| + LF
xml = xml + |<rundata processeddocs='0' exitcode='0'></rundata></agent>|
' now we create input stream from previous string
Set inputStream = session.CreateStream()
Call inputStream.writeText(xml)
' let's import the DXL agent into the db
Set importer = session.CreateDXLImporter()
importer.DesignImportOption = DXLIMPORTOPTION_REPLACE_ELSE_CREATE
Call importer.import(inputStream, session.CurrentDatabase)
createDXLAgent = True
fin:
Exit Function
logError :
Call LogError("[createDXLAgent] Erreur "+ Cstr(Err) + " à la ligne n°"+Cstr(Erl)+" - "+ Error)
createDXLAgent = False
Resume fin
End Function
Function signDXLAgent() As Boolean
Dim view As notesview
Dim doc As notesdocument
On Error Goto LogError
' tweaked view for listing agents ($FormulaClass = 512)
Set view = session.CurrentDatabase.GetView("lkp-agents")
Set doc = view.GetDocumentByKey(TEMP_AGENT_NAME)
Call doc.Sign() ' NotesDatase.sign() only works on workstation
signDXLAgent = doc.save(False, False)
fin:
Exit Function
logError :
Call LogError("[signDXLAgent] Erreur "+ Cstr(Err) + " à la ligne n°"+Cstr(Erl)+" - "+ Error)
signDXLAgent = False
Resume fin
End Function
Function removeAgent() As Boolean
Dim view As notesview
Dim doc As notesdocument
On Error Goto LogError
' tweaked view for listing agents ($FormulaClass = 512)
Set view = session.CurrentDatabase.GetView("lkp-agents")
Set doc = view.GetDocumentByKey(TEMP_AGENT_NAME)
removeAgent = doc.Remove(True) ' workaround because NotesAgent.Remove() throws an error (signature issue)
fin:
Exit Function
logError :
Call LogError("[removeAgent] Erreur "+ Cstr(Err) + " à la ligne n°"+Cstr(Erl)+" - "+ Error)
removeAgent = False
Resume fin
End Function
Function runAgent() As Boolean
Dim agent As NotesAgent
On Error Goto LogError
Set agent = session.CurrentDatabase.GetAgent(TEMP_AGENT_NAME)
Call agent.Run()
runAgent = True
fin:
Exit Function
logError :
Call LogError("[runAgent] Erreur "+ Cstr(Err) + " à la ligne n°"+Cstr(Erl)+" - "+ Error)
runAgent = False
Resume fin
End Function
je ferai un billet là dessus avec les explications qui vont bien quand j'aurais le temps.