moderrorinfo.bas

ERP管理系统源代码erp 管理系统源代码

Attribute VB_Name = "modErrorInfo"
'****************************************************************************************
' MODULE        : modErrorInfo
' DESCRIPTION   : 错误信息模块
' CREATE        : FengJie 2001-11-02
' CODE          : FengJie 2001-11-02
' FUNCTION      : 将错误信息写入错误日志文件并可设置错误日志文件
' USAGE         :
' SUMMARY       :
'       1.数据类型定义
'           (1)定义错误信息格式                     Public Type TYPE_ERRORINFO
'       2.变量声明
'           (1)默认的错误日志文件                   Const m_strDEFAULR_ERRORLOG_FILE = "ERRORLOG.LOG"
'           (2)用户设置的错误日志文件               Dim m_strErrLog As String
'       3.函数定义
'           (1)写错误日志文件函数——将错误信息写入错误日志文件
'                   Public Function WriteErrLog(ErrorInfo As TYPE_ERRORINFO) As Boolean
'           (2)设置错误日志文件函数
'                   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 兆字节 ( 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 字节
        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)
    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