mirror of
https://github.com/cheveguerra/Pusher_2.0.git
synced 2026-04-17 19:37:05 +00:00
122 lines
4.5 KiB
QBasic
122 lines
4.5 KiB
QBasic
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
|
|
'---------------------------------------------------------------------------------
|
|
'---------------------------------------------------------------------------------
|