程式內容有用到前幾篇的 CQueue,SelfTimer,Base64Encode
Dim m_Log As New CQueue
Dim WithEvents m_WriteTime As SelfTimer
Public Sub init()
Set m_WriteTime = New SelfTimer
m_WriteTime.Interval = 2000
End Sub
Public Sub vSave(ByVal sData As String, ByVal bSec As Boolean)
If bSec = True Then
sData = Unit.Base64Encode(sData)
End If
m_Log.Enqueue ("[" & Unit.sGetNowTimeString("hhmmssfff", ":") & "]" & sData)
End Sub
Public Sub vForceSave(ByVal sData As String, ByVal bSec As Boolean)
If bSec = True Then
sData = Unit.Base64Encode(sData)
End If
Call vRealSave(sData)
End Sub
Private Sub m_WriteTime_Timer(ByVal Seconds As Currency)
Call vRealSave("")
End Sub
Private Sub vRealSave(ByVal sNewData As String)
Dim fso As FileSystemObject
Dim fid As TextStream
Dim sWriteText As String
Dim iQCount As Integer
Dim i As Integer
Dim LogPath As String
Dim sLogFile As String
iQCount = m_Log.Count
For i = 1 To iQCount
If sWriteText = "" Then
sWriteText = m_Log.Dequeue
Else
sWriteText = sWriteText & vbCrLf & m_Log.Dequeue
End If
Next i
If sNewData <> "" Then
sWriteText = sWriteText & vbCrLf & "[" & Unit.sGetNowTimeString("hhmmssfff", ":") & "]" & sNewData
End If
Set fso = CreateObject("Scripting.FileSystemObject")
LogPath = App.Path & "\log"
sLogFile = LogPath & "\" & Unit.sGetNowDateString("yyyymmdd", "") & ".log"
If fso.FolderExists(LogPath) = False Then
Call fso.CreateFolder(LogPath)
End If
If fso.FileExists(sLogFile) Then
Dim tmpFile As File
Set tmpFile = fso.GetFile(sLogFile)
Set fid = tmpFile.OpenAsTextStream(ForAppending)
Else
Set fid = fso.CreateTextFile(sLogFile, True)
End If
fid.WriteLine (sWriteText)
fid.Close
End Sub