Lotus Domino script to log all scheduled server agents
List all scheduled agents that run on the current server (enabled and disabled)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 |
Option Public Option Declare Dim dbCur As NotesDatabase Sub Initialize Dim sn As New NotesSession Dim dbDir As NotesDbDirectory Dim db As NotesDatabase Dim agt As NotesAgent Dim varAgts Dim i As Integer Dim strMsg As String On Error GoTo ErrorHandler On Error 4060 GoTo NO_DB_ACCESS On Error 4063 GoTo NO_DB_OPEN On Error 4296 GoTo DATABASE_ALREADY_OPEN Set dbCur = sn.CurrentDatabase Call Logging (dbCur, "# Agent CheckSchedAgents started") Set dbDir = sn.GetDbDirectory(dbCur.Server) Set db = dbDir.GetFirstDatabase(DATABASE) Do Until db Is Nothing If Not db.IsOpen Then 'Open database first Call db.Open(dbCur.Server, db.FilePath) 'Results in error 4060 if No Access --> db.IsOpen = False End If If db.IsOpen Then Print "Checking " + db.FilePath + " for scheduled agents..." i = 0 Set varAgts = Nothing getDesignElements db, "AGENTS", varAgts, i If i <> 0 Then For i = 0 To UBound(varAgts) Set agt = db.GetAgent(varAgts(i)) If Not agt Is Nothing Then If agt.Trigger = TRIGGER_SCHEDULED Then If UCase(agt.ServerName) Like UCase(dbCur.Server) Then If agt.Isenabled Then Call Logging(dbCur, "# " + db.FilePath + " - Agent Name: " + agt.Name + " - Enabled") Else Call Logging(dbCur, "# " + db.FilePath + " - Agent Name: " + agt.Name + " - Disabled") End If End If End If End If Next End If Else Call Logging (dbCur, "# Database skipped. No access - " + db.Filepath) End If GoTo finally NO_DB_ACCESS: Call Logging(dbCur, "Error in Initialize for db: " + CStr(db.ReplicaID)) Resume finally NO_DB_OPEN: Call Logging(dbCur, "Error in Initialize for db: " + CStr(db.ReplicaID)) Resume finally DATABASE_ALREADY_OPEN: Resume Next finally: Set db = dbDir.Getnextdatabase() Loop TheEnd: Call Logging (dbCur, "# Agent CheckSchedAgents finished") Exit Sub ErrorHandler: Call Logging(dbCur, "Error in Initialize") Exit Sub End Sub Private Sub SelectDesignTypeCollection(nc As NotesNoteCollection, ByVal DocType As String, NotFound As Boolean) Select Case UCase(DocType) Case "ACTIONS" nc.SelectActions = True Case "AGENTS" nc.SelectAgents = True Case "DATABASESCRIPT" nc.SelectDatabaseScript = True Case "DATACONNECTIONS" nc.SelectDataConnections = True Case "FOLDERS" nc.SelectFolders = True Case "FORMS" nc.SelectForms = True Case "FRAMESETS" nc.SelectFramesets = True Case "HELPABOUT" nc.SelectHelpAbout = True Case "HELPINDEX" nc.SelectHelpIndex = True Case "HELPUSING" nc.SelectHelpUsing = True Case "ICON" nc.SelectIcon = True Case "IMAGERESOURCES" nc.SelectImageResources = True Case "FORMULA" nc.SelectionFormula = True Case "JAVARESOURCES" nc.SelectJavaResources = True Case "MISCCODEELEMENTS" nc.SelectMiscCodeElements = True Case "MISCFORMATELEMENTS" nc.SelectMiscFormatElements = True Case "INDEXELEMENTS" nc.SelectMiscIndexElements = True Case "NAVIGATORS" nc.SelectNavigators = True Case "OUTLINES" nc.SelectOutlines = True Case "PAGES" nc.SelectPages = True Case "REPLICATIONFORMULAS" nc.SelectReplicationFormulas = True Case "SCRIPTLIBRARIES" nc.SelectScriptLibraries = True Case "SHAREDFIELDS" nc.SelectSharedFields = True Case "STYLESHEETRESOURCES" nc.SelectStyleSheetResources = True Case "SUBFORMS" nc.SelectSubforms = True Case "VIEWS" nc.SelectViews = True Case Else NotFound = True End Select End Sub Function getHiddenProperty(doc As NotesDocument) As String If InStr(1, doc.GetItemValue("$Flags")(0), "n", 5) > 0 Then 'Hidden for Notes getHiddenProperty = " [W]" ElseIf InStr(1, doc.GetItemValue("$Flags")(0), "w", 5) > 0 Then 'Hidden for Web getHiddenProperty = " [N]" Else 'Both Notes and Web getHiddenProperty = "" End If End Function Sub getDesignElements(db As NotesDatabase, strDesignType As String, varAgts, i As Integer) 'here are some fields witch carrying the scripting text according to the design document Const fnScriptLib = "$ScriptLib" Const fnDBScript = "$DBScript" Const fnFormGlobalScript = "$Script" Const fnFormScript = "$$FormScript" Const fnViewGlobalScript = "$ViewGlobalScript" Const fnViewScript = "$ViewScript" Const fnAgentGlobalScript = "$AgentGlobalScript" Const fnAgentScript = "$AgentScript" On Error GoTo ErrorHandler Dim sn As New NotesSession Dim DocTypes(0) Dim DesignDocs() As NotesDocument Dim fns As Variant Dim ErrMsg As String Dim x As Long Dim strAgentName As String Dim varAgents() DocTypes(0) = strDesignType For x = LBound(DocTypes) To UBound(DocTypes) GoSub GetScriptFields If fns(0) = "" Then GoTo GetNextType If Not getDesignDocs(db, DocTypes(x), DesignDocs(), ErrMsg) Then GoTo GetNextType ForAll doc In DesignDocs strAgentName = doc.GetItemValue("$Title")(0) ReDim Preserve varAgents(i) varAgents(i) = strAgentName i = i + 1 End ForAll GetNextType: Next If i <> 0 Then varAgts = varAgents End If Exit Sub ErrorHandler: Dim dbCur As NotesDatabase Set dbCur = sn.CurrentDatabase Call Logging(dbCur, "Error in getDesignElements") Exit Sub '================================================== GetScriptFields: ReDim fns(0) Select Case DocTypes(x) Case "SCRIPTLIBRARIES" ReDim fns(0) fns(0) = fnScriptLib Case "DATABASESCRIPT" ReDim fns(0) fns(0) = fnDBScript Case "FORMS", "SUBFORMS", "PAGES" ReDim fns(0 To 1) fns(0) = fnFormGlobalScript fns(1) = fnFormScript Case "VIEWS" ReDim fns(0 To 1) fns(0) = fnViewGlobalScript fns(1) = fnViewScript Case "FOLDERS" ReDim fns(0 To 1) fns(0) = fnViewGlobalScript fns(1) = fnViewScript Case "AGENTS" ReDim fns(0 To 1) fns(0) = fnAgentGlobalScript fns(1) = fnAgentScript Case Else 'not supported End Select Return End Sub Sub Logging(dbCur As NotesDatabase, strErrDB As String) Dim docLog As NotesDocument Set docLog = dbCur.CreateDocument docLog.Form = "AgtLog" If Left(strErrDB, 1) <> "#" Then strErrDB = strErrDB & " at line " & Erl() & ": code = " & Err() & ", message= " & Error() End If Print strErrDB docLog.ErrorLog = strErrDB Call docLog.Save(True, False) End Sub Function getDesignDocs(db As NotesDatabase, ByVal DesignDocType As String, DesignDocs() As NotesDocument, ErrMsg As String) As Boolean Const LSI_THREAD_PROC = 1 Dim nc As NotesNoteCollection Dim notedoc As NotesDocument Dim nid As String Dim TypeNotFound As Boolean Dim msgNotFound As String Dim x As Long, y As Long msgNotFound = "No design documents found from type " & DesignDocType Set nc = db.CreateNoteCollection(False) Call SelectDesignTypeCollection(nc, DesignDocType, TypeNotFound) If TypeNotFound Then ErrMsg = msgNotFound Exit Function Else Call nc.BuildCollection End If nid = nc.GetFirstNoteId y = 0 ReDim DesignDocs(y) For x = 1 To nc.Count Set notedoc = db.GetDocumentByID(nid) If notedoc Is Nothing Then GoTo GetNextNote ReDim Preserve DesignDocs(y) Set DesignDocs(y) = notedoc y = y + 1 GetNextNote: nid = nc.GetNextNoteId(nid) Next If DesignDocs(0) Is Nothing Then ErrMsg = msgNotFound Else GetDesignDocs = True End If End Function |