Agent running v quickly but sucking all memory from server. Where is the leak?

hcl-bot · May 20, 2008, 10:49pm

Hi

I have an agent that runs really quickly and polls all databases in a NotesDbDirectory, returning a bunch of information on each one, including the contents of the ACL, a listing of all agents and the user activity. I’ve run the agent both with and without logging the user activity, and had the same results (the user activity code accesses the databases at the file system level as this information isn’t available via the Notes classes {hint hint to IBM}).

Below is the code. It runs super-fast, but sucks the memory from the server it runs on, to the extent that it’ll just stop running as the server can’t handle it.

Can someone please help me out with where the memory problem might be occuring? Sorry the code is so long, but it needs to all be here. The “CLASSUserActivity” is the one found in the Sandbox for logging user detail in the database.

Thanks in advance!

Option Public

Option Declare

Use “CLASSUserActivity”

Dim session As NotesSession

Dim dbThis As NotesDatabase

Dim logStartText As String

Sub Initialize

Dim configDoc As NotesDocument

Dim StartAtNumberView As NotesView

Dim ServerStartAtDoc As NotesDocument



On Error Goto ErrorHandler



Set session = New NotesSession

Set dbThis = session.CurrentDatabase

logStartText = Cstr(Now)

Set configDoc = dbThis.GetProfileDocument("Config")

Set StartAtNumberView = dbThis.GetView("StartAtNumber")



'Exception List

Dim eListItem As NotesItem

Set eListItem = configDoc.GetFirstItem("ExceptionList")



'List of Mail Servers (used in mail file flag)

Dim lookupItem As NotesItem

Set lookupItem = configDoc.GetFirstItem("MailServers")



'List of all servers (used for user activity logging)

Dim lookupItemAccess As NotesItem

Set lookupItemAccess = configDoc.GetFirstItem("AllServers")



Dim svrname As NotesName

Dim svr As String

Set svrname = New NotesName(dbThis.Server)

svr = svrname.Common

Call LogStuff("Starting", svr,0,"","","","","","Analysis agent starting")

Call StartAtNumberView.Refresh

Set ServerStartAtDoc = StartAtNumberView.GetDocumentByKey(svr, True)

If ServerStartAtDoc Is Nothing Then

	Set ServerStartAtDoc = New NotesDocument(dbThis)

	With ServerStartAtDoc

		Call .ReplaceItemValue("Form", "StartAtNumber")

		Call .ReplaceItemValue("ServerName", svr)

		Call .ReplaceItemValue("StartAtNumber", 1)

		Call .Save(True, False)

	End With

End If



If ServerStartAtDoc.StartAtNumber(0) = 1 Then

	If ServerStartAtDoc.Finished(0) = "" Then

		Call DeleteOldDocs(svr)

	Else

		Call LogStuff("Completing", svr,0,"","","","","","Agent previously completed successfully")

		End

	End If

Else

	Call LogStuff("Restarting", svr,0,"","","","","","Restarting at DB number " & ServerStartAtDoc.StartAtNumber(0))

End If



If lookupItem.Contains(svr) Then

	'Mail server

	Call GetDBdirectory(session, svrname, "Yes", svr, ServerStartAtDoc, eListItem, lookupItemAccess)

	Call CheckForOrphans(session, svr)

Else

	'Application server

	Call GetDBdirectory(session, svrname, "No", svr, ServerStartAtDoc, eListItem, lookupItemAccess)

End If



'Agent has completed successfully

Call LogStuff("Completing", svr, 0, "", "", "", "", "", "")

With ServerStartAtDoc

	Call .ReplaceItemValue("StartAtNumber", 1)

	Call .ReplaceItemValue("Finished", "Yes")

	Call .Save(True, False)

End With



Delete session

Delete dbThis

Delete configDoc

Delete StartAtNumberView

Delete ServerStartAtDoc







Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "Initialize: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

End Sub

Sub DeleteOldDocs(svr As String)

Dim coll As NotesDocumentCollection

Dim colldoc As NotesDocument

Dim tempdoc As NotesDocument

Dim strSearch As String



On Error Goto ErrorHandler



strSearch = |Form="DatabaseCapture" & Deleted=("" : "No") & db_server_commonname="| & svr & |"|

Set coll = dbThis.Search(strSearch, Nothing, 0)



If coll.Count > 0 Then

	Set colldoc = coll.GetFirstDocument

	Do Until colldoc Is Nothing

		Set tempdoc = coll.GetNextDocument(colldoc)

		Call colldoc.Remove(True)

		Set colldoc = tempdoc

	Loop

End If



Delete coll

Delete colldoc

Delete tempdoc







Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "DeleteOldDocs: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub GetDBdirectory(session As NotesSession, svrname As NotesName, mFlag As String, svr As String, ServerStartAtDoc As NotesDocument, eListItem As NotesItem, lookupItemAccess As NotesItem)

On Error Goto ErrorHandler



Dim x As Long

Dim db As NotesDatabase

Dim dbDir As NotesDbDirectory



Set dbDir = New NotesDbDirectory(svrname.Abbreviated)

Set db = dbDir.GetFirstDatabase( DATABASE )



x = 1



While Not (db Is Nothing)

	

	If x >= ServerStartAtDoc.StartAtNumber(0) Then

		

		Select Case mFlag

			

		Case "No"

			If Not(isOnRoot(db, svr)) Then

				Dim strFolderPortion As String

				strFolderPortion = Left$(db.Filepath, Instr(1, db.Filepath, "\", 5))

				

				If Isnull(Arraygetindex(eListItem.Values, Cvar(strFolderPortion), 5)) Then

					Call PopulateDoc("No", svrname, db, lookupItemAccess, svr, x)

				Else

					Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Skipping", "Folder in Exception List","","")

				End If

			Else

				Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Skipping", "Database on Root","","")

			End If

			

		Case "Yes"

			If Left(Ucase(db.FilePath),5) = "MAIL\" Then

				Call PopulateDoc("Yes", svrname, db, lookupItemAccess, svr, x)

			Else

				Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Skipping", "Database not in Mail folder","","")

			End If

		End Select

		

		Call ServerStartAtDoc.ReplaceItemValue("StartAtNumber", x)

		Call ServerStartAtDoc.Save(True, False)

	End If

RestartHere:

	Set db = Nothing

	Set db = dbDir.GetNextDatabase

	x = x + 1

	

Wend



Delete db

Delete dbDir







Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "GetDBdirectory: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume RestartHere

End Sub

Function isOnRoot(db As NotesDatabase, svr As String) As Boolean

On Error Goto ErrorHandler



Dim intPos As Integer

isOnRoot = False

intPos = Instr(1, db.Filepath, "\", 5)

If Not(intPos <> 0) Then isOnRoot = True

intPos=0



Exit Function

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "isOnRoot: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Function

Sub PopulateDoc(mFlag As String, svrname As NotesName, db As NotesDatabase, lookupItemAccess As NotesItem, svr As String, x As Long)

On Error Goto Errorhandler



If Not(db.IsOpen) Then Call db.Open(svr,db.FilePath)

If db.IsOpen Then

	

	Select Case mFlag

	Case "No"

		Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Logging","","","Logging application database")

	Case Else

		Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Logging","","","Logging mail database")

	End Select

	

	Dim doc As NotesDocument

	Set doc = New NotesDocument(dbThis)

	With doc

		Call .ReplaceItemValue("Form", "DatabaseCapture")

		Call .ReplaceItemValue("db_server", svrname.Abbreviated)

		Call .ReplaceItemValue("db_server_commonname", svrname.Common)

		Call .ReplaceItemValue("db_server_canonical", svrname.Canonical)

		Call .ReplaceItemValue("db_path", db.FilePath)

		Call .ReplaceItemValue("db_title", db.Title)

		Call .ReplaceItemValue("db_lastmod", Cdat(db.LastModified))

		Call .ReplaceItemValue("db_size", db.Size)

		Call .ReplaceItemValue("db_maxsize", db.MaxSize)

		Call .ReplaceItemValue("db_percentused", db.PercentUsed)

		Call .ReplaceItemValue("db_notesurl", db.NotesURL)

		Call .ReplaceItemValue("db_replicaid", db.ReplicaID)

		Call .ReplaceItemValue("db_templatename", db.TemplateName)

		Call .ReplaceItemValue("db_designtemplatename", db.DesignTemplateName)

		Call .ReplaceItemValue("db_type", db.Type)

		Call .ReplaceItemValue("db_mailfile", mFlag)

		Call .ReplaceItemValue("over3months", "No")

		Call .ReplaceItemValue("over6months", "No")

		Call .ReplaceItemValue("over9months", "No")

		Call .ReplaceItemValue("over12months", "No")

		If db.IsFTIndexed = True Then

			Call .ReplaceItemValue("db_fti", "Yes")

		Else

			Call .ReplaceItemValue("db_fti", "No")

		End If

	End With

	

	Dim linkitem As NotesRichTextItem

	Set linkitem = New NotesRichTextItem(doc, "db_link")

	Call linkitem.AppendDocLink( db, "Click to open " & db.Title )

	Call DbType(doc, svr)

	

	If mFlag = "No" Then Call LogUserActivity(db, doc, lookupItemAccess, svr)

	Call PopulateAgentInfo(db, doc, svr)

	Call PopulateACLDetails(db, doc, svr)

	Call SetSummaryFields(doc, svr)

	Call doc.Save(True, False)

	

	Delete linkitem

	Delete doc

	

Else

	Call LogStuff("Logging", svr, x, db.Title, db.FilePath, "Skipping", "Cannot open database","","")

End If







Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "PopulateDoc: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub LogUserActivity(db As NotesDatabase, doc As NotesDocument, lookupItemAccess As NotesItem, svr As String)

Dim ua As NotesUserActivity

Dim uae As NotesUserActivityEntry

Dim iCounter As Long



On Error Goto ErrorHandler



Set ua = New NotesUserActivity(db)



If ua.HasUserActivity Then

	

	Dim time_item As NotesItem

	Dim name_item As NotesItem

	Dim reads_item As NotesItem

	Dim writes_item As NotesItem

	

	For iCounter = 1 To ua.UserActivityCount

		Set uae = ua.GetNthUserActivityEntry(iCounter)

		Dim uname As New NotesName(uae.UserName)

		Dim unameStr As String

		unameStr = uname.Common

		

		If Isnull(Arraygetindex(lookupItemAccess.Values, unameStr, 5)) Then

			

			If iCounter = 1 Then

				doc.rtime = Cdat(uae.Time)

				doc.rtime_all = uae.Time

				doc.rname = uname.Abbreviated

				doc.rname_all = uname.Abbreviated

				doc.rreads = Cstr(uae.Reads)

				doc.rreads_all = Cstr(uae.Reads)

				doc.rwrites = Cstr(uae.Writes)

				doc.rwrites_all = Cstr(uae.Writes)

				Call CalcTimeDiff(doc, uae, svr)

				Set time_item = doc.GetFirstItem("rtime_all")

				Set name_item = doc.GetFirstItem("rname_all")

				Set reads_item = doc.GetFirstItem("rreads_all")

				Set writes_item = doc.GetFirstItem("rwrites_all")

			Else

				Call time_item.AppendToTextList(uae.Time)

				Call name_item.AppendToTextList(uname.Abbreviated)

				Call reads_item.AppendToTextList(Cstr(uae.Reads))

				Call writes_item.AppendToTextList(Cstr(uae.Writes))

			End If

			'If we have 20 values, then exit the user activity logging

			If iCounter = 20 Then

				Delete ua

				Delete uae

				Delete time_item

				Delete name_item

				Delete reads_item

				Delete writes_item

				Exit Sub

			End If

		End If

	Next iCounter

	

Else

	'There is no user activity

	doc.rtime = ""

	doc.rname = ""

	doc.rreads = ""

	doc.rwrites = ""

	Set ua = Nothing

End If



Delete ua

Delete uae

Delete time_item

Delete name_item

Delete reads_item

Delete writes_item







Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "LogUserActivity: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Exit Sub

’ Resume Next

End Sub

Sub PopulateACLDetails(db As NotesDatabase, doc As NotesDocument, svr As String)

Dim A As NotesACL

Dim ae As NotesACLEntry

Dim acl_1_item As NotesItem

Dim acl_2_item As NotesItem

Dim acl_3_item As NotesItem

Dim dspstrLevel As String

Dim dspstrType As String

Dim nameLevel(0 To 1) As String

Dim tempStr As String

Dim z As Integer

Dim nL As Integer



On Error Goto ErrorHandler



Set A = db.ACL

Set ae = A.GetFirstEntry



While Not(ae Is Nothing)

	

	'Type

	Select Case ae.UserType

	Case 0

		dspstrType = "Unspecified"

	Case 1

		dspstrType = "Person"

	Case 2

		dspstrType = "Server"

	Case 3

		dspstrType = "Mixed Group"

	Case 4

		dspstrType = "Person Group"

	Case 5

		dspstrType = "Server Group"

	End Select

	

	If Not(doc.HasItem("acl_type_" & ae.UserType)) Then

		Set acl_3_item = New NotesItem( doc, "acl_type_" & ae.UserType, dspstrType)

	Else

		Set acl_3_item = doc.GetFirstItem("acl_type_" & ae.UserType)

		Call acl_3_item.AppendToTextList(dspstrType)

	End If

	

	'Name

	If Not(doc.HasItem("acl_name_" & ae.UserType)) Then

		Set acl_1_item = New NotesItem( doc, "acl_name_" & ae.UserType, ae.Name)

	Else

		Set acl_1_item = doc.GetFirstItem("acl_name_" & ae.UserType)

		Call acl_1_item.AppendToTextList(ae.Name)

	End If

	

	'Level

	Select Case ae.Level

	Case 0

		dspstrLevel = "No Access"

	Case 1

		dspstrLevel = "Depositor"

	Case 2

		dspstrLevel = "Reader"

	Case 3

		dspstrLevel = "Author"

	Case 4

		dspstrLevel = "Editor"

	Case 5

		dspstrLevel = "Designer"

	Case 6

		dspstrLevel = "Manager"

	End Select

	

	If Not(doc.HasItem("acl_level_" & ae.UserType)) Then

		Set acl_2_item = New NotesItem( doc, "acl_level_" & ae.UserType, dspstrLevel)

	Else

		Set acl_2_item = doc.GetFirstItem("acl_level_" & ae.UserType)

		Call acl_2_item.AppendToTextList(dspstrLevel)

	End If

	

	Set ae = A.GetNextEntry(ae)

Wend



Delete A

Delete ae

Delete acl_1_item

Delete acl_2_item

Delete acl_3_item

z = 0

nL = 0

RestartHere:

Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "PopulateACLDetails: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume RestartHere

End Sub

Sub DbType(doc As NotesDocument, svr As String)

On Error Goto ErrorHandler



Select Case doc.db_type(0)

Case 1

	doc.db_disp_type = "Web Application"

Case 2

	doc.db_disp_type = "Mail File"

Case 3

	doc.db_disp_type = "Mail Box"

Case 4

	doc.db_disp_type = "Subscriptions"

Case 5

	doc.db_disp_type = "News Server Proxy"

Case 6

	doc.db_disp_type = "IMAP Server Proxy"

Case 7

	doc.db_disp_type = "Portfolio"

Case 8

	doc.db_disp_type = "Domain Catalog"

Case 9

	doc.db_disp_type = "Directory Catalog"

Case 10

	doc.db_disp_type = "Domino Directory or Personal Address Book"

Case 11

	doc.db_disp_type = "Personal Journal"

Case 12

	doc.db_disp_type = "Database Library"

Case 13

	doc.db_disp_type = "Standard"

Case Else

	doc.db_disp_type = "(Type Not Found)"

End Select



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "DbType: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub CheckForOrphans(session As NotesSession, svr As String)

Dim strSearch As String

Dim analysisDocsColl As NotesDocumentCollection

Dim mfLookupView As NotesView

Dim keys(0 To 1) As String

Dim mfLookupDoc As NotesDocument



On Error Goto ErrorHandler



Call DeleteOldMailFileLookupDocs(svr)

Call CreateNewMailFileLookupDocs(session, svr)



strSearch = |Form="DatabaseCapture" & db_server_commonname="| & svr & |" & Deleted="No"|

Set analysisDocsColl = dbThis.Search(strSearch, Nothing, 0)

If analysisDocsColl.Count = 0 Then Goto done



Set mfLookupView = dbThis.GetView("MailFileLookup")

Call mfLookupView.Refresh

keys(0) = svr



Dim doc As NotesDocument

Set doc = analysisDocsColl.GetFirstDocument

Do Until doc Is Nothing

	Dim n As Integer

	n = Len(doc.db_path(0))

	If Right(Ucase(doc.db_path(0)), 4) = ".NSF" Then

		keys(1) = Left(Ucase(doc.db_path(0)), n-4)

		n = n-4

	Else

		keys(1) = (doc.db_path(0))

	End If

	

	Set mfLookupDoc = mfLookupView.GetDocumentByKey(keys, True)

	

	If mfLookupDoc Is Nothing Then

		Call doc.ReplaceItemValue("db_isorphan", "Yes")

	Else

		Call doc.ReplaceItemValue("db_isorphan", "No")

	End If

	

	Call doc.ComputeWithForm(False, False)

	Call doc.Save(True, False)

	

	Delete mfLookupDoc

	Set doc = analysisDocsColl.GetNextDocument(doc)

Loop

done:

Delete analysisDocsColl

Delete mfLookupView

keys(0) = ""

keys(1) = ""



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "CheckForOrphans: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub DeleteOldMailFileLookupDocs(svr As String)

Dim colldoc As NotesDocument

Dim tempdoc As NotesDocument

Dim mfLookupView As NotesView

Dim coll As NotesDocumentCollection

Dim strSearch As String



On Error Goto ErrorHandler



Set mfLookupView = dbThis.GetView("MailFileLookup")

Set coll = mfLookupView.GetAllDocumentsByKey(svr, True)



If coll.Count > 0 Then

	Set colldoc = coll.GetFirstDocument

	Do Until colldoc Is Nothing

		Set tempdoc = coll.GetNextDocument(colldoc)

		Call colldoc.Remove(True)

		Set colldoc = tempdoc

	Loop

End If



Delete colldoc

Delete tempdoc

Delete mfLookupView

Delete coll

strSearch = ""



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "DeleteOldMailFileLookupDocs: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub CreateNewMailFileLookupDocs(session As NotesSession, svr As String)

Dim NABdb As NotesDatabase

Dim NABview As NotesView

Dim NABdoc As NotesDocument

Dim newMFdoc As NotesDocument



On Error Goto ErrorHandler



Set NABdb = session.GetDatabase(svr, "names.nsf", False)

If Not(NABdb.IsOpen) Then Call NABdb.Open(svr, "names.nsf")

Set NABview = NABdb.GetView("People")

Set NABdoc = NABview.GetFirstDocument



Do Until NABdoc Is Nothing

	Set newMFdoc = New NotesDocument(dbThis)

	With newMFdoc

		Call .ReplaceItemValue("Form", "MailFileLookup")

		Call .ReplaceItemValue("MailServer", NABdoc.MailServer(0))

		Call .ReplaceItemValue("MailFile", NABdoc.MailFile(0))

		Call .Save(True, False)

	End With

	Set NABdoc = NABview.GetNextDocument(NABdoc)

Loop



Delete NABdb

Delete NABview

Delete NABdoc

Delete newMFdoc



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "CreateNewMailFileLookupDocs: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

Sub CalcTimeDiff(doc As NotesDocument, uae As NotesUserActivityEntry, svr As String)

On Error Goto ErrorHandler



Dim timeDB As New NotesDateTime(uae.Time)

Dim timeNow As New NotesDateTime("Today")

Dim timeDiff As Long



timeDiff = timeNow.TimeDifference(timeDB)



If timeDiff >= 31536000 Then				'One year diff

	With doc

		Call .ReplaceItemValue("over3months", "Yes")

		Call .ReplaceItemValue("over6months", "Yes")

		Call .ReplaceItemValue("over9months", "Yes")

		Call .ReplaceItemValue("over12months", "Yes")

	End With

Elseif timeDiff >= 23652000 Then			'9 months diff

	With doc

		Call .ReplaceItemValue("over3months", "Yes")

		Call .ReplaceItemValue("over6months", "Yes")

		Call .ReplaceItemValue("over9months", "Yes")

	End With

Elseif timeDiff >= 15768000 Then			'6 months

	With doc

		Call .ReplaceItemValue("over3months", "Yes")

		Call .ReplaceItemValue("over6months", "Yes")

	End With

Elseif timeDiff >= 7884000 Then			'3 months diff

	With doc

		Call .ReplaceItemValue("over3months", "Yes")

	End With

End If



Delete timeDB

Delete timeNow

timeDiff=0



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "CalcTimeDiff: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If	

Resume Next

End Sub

Sub LogStuff(LogType As String, svr As String, x As Long, DBTitle As String, _

DBFilepath As String, LogStatus As String, SkipReason As String, ErrorDetails As String, _

Comment As String)

On Error Resume Next



Dim AL As New NotesDocument(dbThis)

With AL

	Call .ReplaceItemValue("Form", "AL")

	Call .ReplaceItemValue("LogType", LogType)

	Call .ReplaceItemValue("ServerName", svr)

	Call .ReplaceItemValue("DateTimeNow", Now)

	Call .ReplaceItemValue("LogStart", logStartText)

	

	Select Case LogType

	Case "Logging"

		Call .ReplaceItemValue("DBNumber", x)

		Call .ReplaceItemValue("DBTitle", DBTitle)

		Call .ReplaceItemValue("DBFilepath", DBFilepath)

		Call .ReplaceItemValue("LogStatus", LogStatus)

		Call .ReplaceItemValue("SkipReason", SkipReason)

	Case "Error"

		Call .ReplaceItemValue("DBNumber", x)

		Call .ReplaceItemValue("DBTitle", DBTitle)

		Call .ReplaceItemValue("DBFilepath", DBFilepath)

		Call .ReplaceItemValue("ErrorDetails", ErrorDetails)

	End Select

	Call .Save(True, False)

End With



Delete AL

End Sub

Sub PopulateAgentInfo(db As NotesDatabase, doc As NotesDocument, svr As String)

On Error Goto ErrorHandler



Dim ags As String

ags = "agent_"

Dim agitem As NotesItem

Dim Tstring As String

Dim LRstring As String



Forall ag In db.Agents

	

	'Name

	If doc.HasItem(ags & "Name") Then

		Set agitem = doc.GetFirstItem(ags & "Name")

		Call agitem.AppendToTextList(ag.Name)

	Else

		Set agitem = New NotesItem(doc, ags & "Name", ag.Name)

	End If

	

	'Trigger

	Select Case ag.Trigger

	Case 0

		Tstring = "None"

	Case 1

		Tstring = "Scheduled"

	Case 2

		Tstring = "After new mail has arrived"

	Case 3

		Tstring = "When documents are pasted"

	Case 4

		Tstring = "Action menu / Agent list"

	Case 5

		Tstring = "After documents are created or modified"

	Case 6

		Tstring = "Before new mail arrives"

	End Select

	

	If doc.HasItem(ags & "Trigger") Then

		Set agitem = doc.GetFirstItem(ags & "Trigger")

		Call agitem.AppendToTextList(Tstring)

	Else

		Set agitem = New NotesItem(doc, ags & "Trigger", Tstring)

	End If

	

	'Last Run

	If Cstr(ag.LastRun) = "12:00:00 a.m." Then

		LRstring = "(never)"

	Else

		LRstring = Cstr(ag.LastRun)

	End If

	

	If doc.HasItem(ags & "LastRun") Then

		Set agitem = doc.GetFirstItem(ags & "LastRun")

		Call agitem.AppendToTextList(LRstring)

	Else

		Set agitem = New NotesItem(doc, ags & "LastRun", LRstring)

	End If

	

	'IsEnabled

	If ag.IsEnabled = True Then

		Tstring = "Yes"

	Else

		Tstring = "No"

	End If

	If doc.HasItem(ags & "IsEnabled") Then

		Set agitem = doc.GetFirstItem(ags & "IsEnabled")

		Call agitem.AppendToTextList(Tstring)

	Else

		Set agitem = New NotesItem(doc, ags & "IsEnabled", Tstring)

	End If

	

	LRstring = ""

	Tstring = ""

End Forall



Delete agitem



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "PopulateAgentInfo: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Exit Sub

’ Resume Next

End Sub

Sub SetSummaryFields(doc As NotesDocument, svr As String)

Dim item As NotesItem

Dim itemStr As String

Dim y As Integer

Dim z As Integer



On Error Goto ErrorHandler



'agent items

Dim ag (0 To 3) As String

ag(0) = "Name"

ag(1) = "Trigger"

ag(2) = "LastRun"

ag(3) = "IsEnabled"



For z = 0 To Ubound(ag)

	itemStr = "agent_" & ag(z)

	If doc.HasItem(itemStr) Then

		Set item = doc.GetFirstItem(itemStr)

		item.IsSummary = True

	End If

Next



'ACL items

Dim NL (0 To 1) As String

NL(0) = "name"

NL(1) = "level"



For y = 0 To 5

	For z = 0 To Ubound(NL)

		itemStr = "acl_" & NL(z) & "_" & Cstr(y)

		If doc.HasItem(itemStr) Then

			Set item = doc.GetFirstItem(itemStr)

			item.IsSummary = True

		End If

	Next

Next



'user activity

If doc.HasItem("rtime_all") Then

	Set item = doc.GetFirstItem("rtime_all")

	item.IsSummary = True

End If

If doc.HasItem("rname_all") Then

	Set item = doc.GetFirstItem("rname_all")

	item.IsSummary = True

End If

If doc.HasItem("rreads_all") Then

	Set item = doc.GetFirstItem("rreads_all")

	item.IsSummary = True

End If

If doc.HasItem("rwrites_all") Then

	Set item = doc.GetFirstItem("rwrites_all")

	item.IsSummary = True

End If



Delete item

itemStr=""

y=0

z=0



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "SetSummaryFields: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

hcl-bot · May 20, 2008, 11:58pm

Subject: Agent running v quickly but sucking all memory from server. Where is the leak?

I can see one path out of LogUserActivity that doesn’t call the Delete method of the ua object (through the error handler) on a quick go-through, and the Sub Delete of the UserActivity class explicilty calls OSMemFree, but it would take an uncommon number of accumulated errors to suck all the memory from the server. As a diagnostic, you could try maintaining a global that increments whenever Sub New is called and decrements when Sub Delete is completed to see if the OSMemFree call is being skipped on a significant number of runs.

hcl-bot · May 21, 2008, 7:31am

Subject: RE: Agent running v quickly but sucking all memory from server. Where is the leak?

I also have this problem. Its something to be improved at the UserActivity class. It leaks lots of memory. I couldn’t find where yet but I guess Stan gave us a very good point so we can start with.

If you find that, please, let us know.

hcl-bot · May 21, 2008, 5:53pm

Subject: RE: Agent running v quickly but sucking all memory from server. Where is the leak?

Hi Stan and Gabriel.

Stan, thanks for your feedback. However, as I noted in the OP, when I completely removed all accessing and logging off the UA from the agent, the memory problems were the same.

As it stands, this agent is completely unusable.

If anyone has any other ideas, please post!

Thanks again,

Marion.

hcl-bot · May 21, 2008, 8:24pm

Subject: RE: Agent running v quickly but sucking all memory from server. Where is the leak?

Well it might be a bit of overkill, but I’ve amended the LogUserActivity sub, let’s see what this does…

Sub LogUserActivity(db As NotesDatabase, doc As NotesDocument, lookupItemAccess As NotesItem, svr As String)

Dim ua As NotesUserActivity

Dim uae As NotesUserActivityEntry

Dim iCounter As Long



On Error Goto ErrorHandler



Set ua = New NotesUserActivity(db)



If ua.HasUserActivity Then

	

	Dim time_item As NotesItem

	Dim name_item As NotesItem

	Dim reads_item As NotesItem

	Dim writes_item As NotesItem

	

	For iCounter = 1 To ua.UserActivityCount

		Set uae = ua.GetNthUserActivityEntry(iCounter)

		Dim uname As New NotesName(uae.UserName)

		Dim unameStr As String

		unameStr = uname.Common

		

		If Isnull(Arraygetindex(lookupItemAccess.Values, unameStr, 5)) Then

			

			If iCounter = 1 Then

				doc.rtime = Cdat(uae.Time)

				doc.rtime_all = uae.Time

				doc.rname = uname.Abbreviated

				doc.rname_all = uname.Abbreviated

				doc.rreads = Cstr(uae.Reads)

				doc.rreads_all = Cstr(uae.Reads)

				doc.rwrites = Cstr(uae.Writes)

				doc.rwrites_all = Cstr(uae.Writes)

				Call CalcTimeDiff(doc, uae, svr)

				Set time_item = doc.GetFirstItem("rtime_all")

				Set name_item = doc.GetFirstItem("rname_all")

				Set reads_item = doc.GetFirstItem("rreads_all")

				Set writes_item = doc.GetFirstItem("rwrites_all")

			Else

				Call time_item.AppendToTextList(uae.Time)

				Call name_item.AppendToTextList(uname.Abbreviated)

				Call reads_item.AppendToTextList(Cstr(uae.Reads))

				Call writes_item.AppendToTextList(Cstr(uae.Writes))

			End If

			'If we have 20 values, then free up memory

			'and exit the user activity logging

			If iCounter = 20 Then

				Goto DeleteStuff

				Exit Sub

			End If

		End If

	Next iCounter

	

Else

	'There is no user activity

	doc.rtime = ""

	doc.rname = ""

	doc.rreads = ""

	doc.rwrites = ""

	Set ua = Nothing

	Goto DeleteStuff

End If



Goto DeleteStuff

DeleteStuff:

Delete ua

Delete uae

Delete time_item

Delete name_item

Delete reads_item

Delete writes_item



Exit Sub

Errorhandler:

If Not(Err() = 91) Then

	Call LogStuff("Error", svr, 0, "", "", "", "", "LogUserActivity: " & Err() & ", " & Error() & " " & "at line " & Erl(), "")

End If

Resume Next

End Sub

hcl-bot · June 8, 2008, 6:47pm

Subject: SOLVED: Agent running v quickly but sucking all memory from server. Where is the leak?

In the GetDbDirectory subroutine, where you have this:

RestartHere:

Set db = Nothing

Set db = dbDir.GetNextDatabase

x = x + 1

Wend

After setting the db to the next database, you need to check to see if it’s nothing! The problem wasn’t when the code was running, it was hogging memory once it had run through everything and was trying to go through the while/wend loop without a valid db object.

A simple piece of code like this is all you need:

RestartHere:

Set db = Nothing

Set db = dbDir.GetNextDatabase

if not (db is nothing) then

'do stuff to exit here

end

end if

x = x + 1

Wend

Cheers,

Marion Down Under