writelogmodule.bas

饲料生产控制系统

Attribute VB_Name = "WriteLogModule"
Option Explicit
'******************************************************************************
' 柤徧丂丂丂: WriteErrLog
' 婡擻丂丂丂: 儘僌傪婰榐偡傞
' 嶲悢丂丂丂: strProgramName  ----儌僕儏乕儖柤
'             strProcName     ----娭悢柤
'             strErrLog       ----僄儔乕撪梕
'             strErrNumber    ----僄儔乕俶俷
'             strErrDesc      ----僄儔乕愢柧
' 曉夞丂丂  : true            ----惉岟
'             false           ----幐攕
'******************************************************************************
Public Static Function WriteErrLog(ByVal strProgramName As String, _
                                   ByVal strProcName As String, _
                                   ByVal strErrLog As String, _
                                   Optional ByVal strErrNumber As String, _
                                   Optional ByVal strErrDesc As String) As Boolean
    Dim FileHandle As Long
    Dim strTxtName As String
    Dim FSOLog As Object
    Dim gstrLogPath As String
    
    gstrLogPath = App.Path & "\Log"
    
    On Error GoTo WriteLogFileErr:

    Set FSOLog = CreateObject("Scripting.FileSystemObject")
    
    WriteErrLog = True

    If (gstrLogPath = "") Then
        WriteErrLog = False
        GoTo WriteLogFileErr:
    End If
    
    strTxtName = Format(Date, "YYYYMMDD") & ".log"
    
    If Dir(gstrLogPath, vbDirectory) = "" Then
            MkDir gstrLogPath
    End If

    FileHandle = FreeFile
    Open (gstrLogPath & "\" & strTxtName) For Append As #FileHandle
    Lock #FileHandle
        Print #FileHandle, "************************************************************************"
        Print #FileHandle, "帪        娫: " & Format(Time, "HH:MM:SS")
        Print #FileHandle, "儌僕儏乕儖柤: " & strProgramName
        Print #FileHandle, "娭   悢   柤: " & strProcName
        Print #FileHandle, "僄儔乕  俶俷: " & strErrNumber
        Print #FileHandle, "僄儔乕  愢柧: " & strErrDesc
        Print #FileHandle, "僄儔乕  撪梕: " & strErrLog
        Print #FileHandle, "************************************************************************" & vbNewLine
    Unlock #FileHandle
    Close #FileHandle
    
    Set FSOLog = Nothing
    Exit Function

WriteLogFileErr:
        WriteErrLog = False
End Function