VB6 定時寫文字檔(用於避免頻繁寫入)

程式內容有用到前幾篇的 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