Attribute VB_Name = "modErrorInfo"
'****************************************************************************************
' MODULE        : modErrorInfo
' DESCRIPTION   : 錯誤信息模塊
' CREATE        : yin 2001-11-02
' CODE          : yin 2001-11-02
' FUNCTION      : 將錯誤信息寫入錯誤日志文件并可設置錯誤日志文件
' USAGE         :
' SUMMARY       :
'       1.數(shù)據(jù)類型定義
'           (1)定義錯誤信息格式                     Public Type TYPE_ERRORINFO
'       2.變量聲明
'           (1)默認的錯誤日志文件                   Const m_strDEFAULR_ERRORLOG_FILE = "ERRORLOG.LOG"
'           (2)用戶設置的錯誤日志文件               Dim m_strErrLog As String
'       3.函數(shù)定義
'           (1)寫錯誤日志文件函數(shù)——將錯誤信息寫入錯誤日志文件
'                   Public Function WriteErrLog(ErrorInfo As TYPE_ERRORINFO) As Boolean
'           (2)設置錯誤日志文件函數(shù)
'                   Public Function SetErrorLog(ByVal strFile As String) As Boolean
'*********************************************************************************************************************************
Option Explicit
Const m_strDEFAULR_ERRORLOG_FILE = "ERRORLOG.RLG"   '默認的錯誤日志文件
Const m_lDEFAULT_ERRORFILE_SIZE = 1 * 1024          '默認錯誤文件大小為 1 兆字節(jié) ( 1024 K )

Dim m_fFilelen As Double
Dim m_strErrLog As String                   '用戶設置的錯誤日志文件

Public Type TYPE_ERRORINFO     '定義錯誤信息格式
   strErrDate As String
   strErrFile As String
   strErrFunc As String
   nErrNum As Long
   strErrDesc As String
End Type

'*****************************************
'設置錯誤日志文件
Public Function SetErrorLog(ByVal strFile As String) As Boolean
    On Error Resume Next
    m_strErrLog = strFile
End Function

'*****************************************
'寫錯誤日志文件

Public Function WriteErrLog(ErrorInfo As TYPE_ERRORINFO) As Boolean
    On Error GoTo ERROR_EXIT
    Dim nfile As Integer
    Dim fFileOpened As Boolean    '判斷文件是否被打開(true---打開,false---未打開)
    fFileOpened = False
    
    If m_fFilelen <= 0 Then m_fFilelen = CDbl(m_lDEFAULT_ERRORFILE_SIZE) * CDbl(1024)
    '若m_strErrLog為空,則錯誤日志文件為默認值("ERRORLOG.LOG")
    If m_strErrLog = "" Then m_strErrLog = m_strDEFAULR_ERRORLOG_FILE
    
    nfile = FreeFile
    Open m_strErrLog For Binary Access Write As #nfile       ' 打開錯誤日志文件
    fFileOpened = True
    ' 文件長度超過上限后，將文件長度重新設為 0
    If LOF(nfile) >= m_fFilelen Then
        Close #nfile
        Open m_strErrLog For Output As #nfile '自動截斷文件為 0 字節(jié)
        Close #nfile
        Open m_strErrLog For Binary Access Write As #nfile
    End If
    
    If LOF(nfile) > 0 Then Seek #nfile, LOF(nfile) + 1          ' 定位到文件末尾
    Put #nfile, , ErrorInfo                                 ' 寫入文件
    Close #nfile                                            ' 關閉錯誤日志文件
    
    Debug.Print "--Error(" & _
                ErrorInfo.strErrFile & " -- " & _
                ErrorInfo.strErrFunc & " : " & _
                ErrorInfo.nErrNum & "):" & ErrorInfo.strErrDesc
    
    fFileOpened = False
    WriteErrLog = True
    Exit Function
ERROR_EXIT:
    If Err.Number <> 0 Then
        Debug.Print "   Error(" & Err.Number & ")" & Error(Err.Number)
        Err.Clear
    End If
    WriteErrLog = False
    If fFileOpened = True Then Close #nfile             '若錯誤日志文件被打開則關閉該文件
End Function

'''''''''''''''''''''''''''''''''''
' 設置錯誤文件
' strPath 錯誤文件路徑
' strFile 錯誤文件名稱
' dLen    錯誤文件長度(K)
Public Sub SetErrorLogFile(ByVal strPath As String, _
            Optional ByVal strFile As String = m_strDEFAULR_ERRORLOG_FILE, _
            Optional dLen As Double = m_lDEFAULT_ERRORFILE_SIZE)
    On Error Resume Next
    Dim FileSystems
    
    Set FileSystems = CreateObject("Scripting.FileSystemObject")
    If Not FileSystems.FolderExists(strPath) Then
        Debug.Print "Error (SetErrorLogFile) -- 路徑 " & strPath & "不存在。"
        strPath = App.Path
    End If
    
    AddDirSep strPath
    If Trim(strFile) = "" Then strFile = m_strDEFAULR_ERRORLOG_FILE
    If dLen <= 0 Then dLen = CDbl(m_lDEFAULT_ERRORFILE_SIZE)
    m_fFilelen = CDbl(dLen) * CDbl(1024)
    m_strErrLog = strPath & strFile
End Sub

Public Sub AddDirSep(strPathName As String)
    On Error Resume Next
    
    If Right(Trim(strPathName), Len("\")) <> "\" Then
        strPathName = RTrim$(strPathName) & "\"
    End If
End Sub