Initial commit

TrsLogClass.bas

@@ -0,0 +1,121 @@
+B4A=true
+Group=Default Group
+ModulesStructureVersion=1
+Type=Class
+Version=6.5
+@EndOfDesignText@
+' TrsLogClass Class module
+' Version 1.0 20FEB17
+'---------------------------------------------------------------------------------
+Sub Class_Globals
+	Private faultLogEntry As 		Int = 0
+	Private warningLogEntry As 		Int = 1
+	Public informationLogEntry As 	Int = 2
+	Private testResultLogEntry As 	Int = 3
+'	
+	Dim typeStrings() As String = Array As String ("F","W","I","T")
+
+	Dim Const textExtension As String = ".txt"
+	Private logFileToUse As String
+	Private fileRootIs As String
+
+	Private logTimer As Timer
+
+	Type logEntryStruct (logType As Int, timeAndDate As Long, source As String, message As String)
+	Public faultReportingList As List
+	Private myLogTestResults As Boolean
+	
+End Sub
+'---------------------------------------------------------------------------------
+'---------------------------------------------------------------------------------
+' delete tomorrow file if it exists
+' is not designed to run over midnight
+Public Sub Initialize(pathName As String, logFileName As String)
+Dim fileToDelete As String
+	
+	logFileToUse = logFileName&DateTime.GetDayOfMonth(DateTime.Now)&textExtension
+	fileRootIs = pathName
+	Dim tomorrowDay As Int = DateTime.GetDayOfMonth(DateTime.Now)+1
+	If tomorrowDay > 31 Then tomorrowDay = 1
+	fileToDelete = logFileName&tomorrowDay&textExtension
+	If File.Exists(fileRootIs,fileToDelete) Then 
+		File.Delete(fileRootIs,fileToDelete)
+	End If
+	
+	faultReportingList.Initialize
+	myLogTestResults = False
+	logTimer.Initialize("LogTimer",250)
+	logTimer.Enabled = True
+	DateTime.TimeFormat = "HH:mm:ss:SSS"
+	
+	LogInformation("TrsLogClass", "Log file is "&logFileToUse)
+End Sub
+'---------------------------------------------------------------------------------
+Public Sub Flush
+	LogTimer_Tick
+End Sub
+'---------------------------------------------------------------------------------
+'---------------------------------------------------------------------------------
+'write to the log file - could include a midnight check if required
+Sub LogTimer_Tick()
+	If faultReportingList.Size = 0 Then Return	' nothing to do
+Dim TextWriter1 As TextWriter
+	TextWriter1.Initialize(File.OpenOutput(fileRootIs, logFileToUse, True))
+	Do While faultReportingList.Size > 0
+		Dim entry  As logEntryStruct = faultReportingList.Get(0)
+		faultReportingList.RemoveAt(0)
+		Dim strToLog As String = DateTime.Time(entry.timeAndDate) &"::" & typeStrings(entry.logType)&":"&entry.source&":"&entry.message
+		TextWriter1.WriteLine(strToLog)
+		Log("*"&strToLog)
+	Loop
+	TextWriter1.Close
+End Sub
+'---------------------------------------------------------------------------------
+'---------------------------------------------------------------------------------
+Public Sub LogInformation(sendingRoutine As String, theInformationMessage As String)
+Dim entry As logEntryStruct
+	entry.Initialize
+	entry.logType = informationLogEntry
+	entry.timeAndDate = DateTime.Now
+	entry.source  = sendingRoutine
+	entry.message = theInformationMessage
+	faultReportingList.Add(entry)
+End Sub
+'---------------------------------------------------------------------------------
+Public Sub LogFault(sendingRoutine As String, theFaultMessage As String)
+Dim entry As logEntryStruct
+	entry.Initialize
+	entry.logType = faultLogEntry
+	entry.timeAndDate = DateTime.Now
+	entry.source  = sendingRoutine
+	entry.message = theFaultMessage
+	faultReportingList.Add(entry)
+End Sub
+'---------------------------------------------------------------------------------
+Public Sub LogWarning(sendingRoutine As String, theWarningMessage As String)
+Dim entry As logEntryStruct
+	entry.Initialize
+	entry.logType = warningLogEntry
+	entry.timeAndDate = DateTime.Now
+	entry.source  = sendingRoutine
+	entry.message = theWarningMessage
+	faultReportingList.Add(entry)
+End Sub
+'---------------------------------------------------------------------------------
+' can be turned off to suppress test results
+Public Sub LogTest(sendingRoutine As String, theTestMessage As String)
+	If myLogTestResults = False Then Return
+Dim entry As logEntryStruct
+	entry.Initialize
+	entry.logType = testResultLogEntry
+	entry.timeAndDate = DateTime.Now
+	entry.source  = sendingRoutine
+	entry.message = theTestMessage
+	faultReportingList.Add(entry)
+End Sub
+'---------------------------------------------------------------------------------
+Public Sub LogTestResults(nv As Boolean)
+	myLogTestResults = nv
+End Sub
+'---------------------------------------------------------------------------------
+'---------------------------------------------------------------------------------