modcommon.bas

智能邮件管理信息系统

Attribute VB_Name = "modCommon"
'******************************************************************************
' -概要定义-
'  系统名称
'                   Copyright(C) 2004
'  程序名称         Common.bas
'  功能概要         通用函数定义
'  日期             2004.05.18
'  作成者
'  备注
'******************************************************************************
'修改简历
'******************************************************************************
Option Explicit

'******************************************************************************
'自定义数据类型
'******************************************************************************


'******************************************************************************
'DLL 函数声明
'******************************************************************************
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'******************************************************************************
'全局变量的声明
'******************************************************************************

'系统全局变量
Public gsIni_MachineName        As String               '机器名
Public gsIni_HomePath           As String               '应用程序当前路径
Public goFSO                    As New FileSystemObject '文件系统对象(microsoft scripting runtime)
Public gots_ErrorLog            As TextStream           '错误日志文件流
Public gots_NormalLog           As TextStream           '常规日志文件流



'******************************************************************************
'函数名称   |获得程序的计算机名称
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |Boolean:计算机名称获得的结果 True-正确,False-失败
'******************************************************************************
Public Function cmnfGetComputerName() As Boolean

    Dim iLength As Long
    Dim iRet As Integer
    On Error Resume Next
    
    gsIni_MachineName = String(255, 0)
    iLength = 255
    iRet = 0
    iRet = GetComputerName(gsIni_MachineName, iLength)
    If iRet = 0 Then
        cmnfGetComputerName = False
    Else
        gsIni_MachineName = left(gsIni_MachineName, iLength)
        cmnfGetComputerName = True
    End If
    
End Function

'******************************************************************************
'函数名称   |程序运行当前路径的获得
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsGetHomePath()

    On Error Resume Next
    
    gsIni_HomePath = App.Path
    If Right(gsIni_HomePath, 1) <> "\" Then gsIni_HomePath = gsIni_HomePath & "\"
   
End Sub

'******************************************************************************
'函数名称   |从初始化文件中获得系统设置参数
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |Boolean:参数获得的结果 True-正确,False-失败
'******************************************************************************
Public Function cmnfGetInitParam() As Boolean

    Dim sFileName        As String
    Dim sTmpStr          As String
    Dim iParamMaxSize    As Long
    Dim oIniFile         As New clsIniFile
    Const sInisFileName  As String = "test.ini"
    Dim baMessage() As Byte
    
    On Error Resume Next
   
    '取得系统初始化文件
    iParamMaxSize = 255
    sFileName = gsIni_HomePath & sInisFileName
  
    If Dir(sFileName) = "" Then                            '系统初始化文件不存在
        Call cmnsErrMessage(gsEMSG_INISEARCH)
        cmnsWriteErrorLog (gsEMSG_INISEARCH)
        GoTo cmnfGetInitParam_Abort
    End If
    
    oIniFile.SetIniFileName (sFileName)
       
    '获得数据库驱动
    sTmpStr = oIniFile.GetStringParameter("DATABASE", "Driver", iParamMaxSize)
    If sTmpStr = vbNullString Then
        Call cmnsErrMessage(gsEMSG_INIDRIVER)
        cmnsWriteErrorLog (gsEMSG_INIDRIVER)
        GoTo cmnfGetInitParam_Abort
    Else
        gsIni_Driver = Trim(sTmpStr)
    End If
    
    '获得数据库名称
    sTmpStr = oIniFile.GetStringParameter("DATABASE", "Database", iParamMaxSize)
    If sTmpStr = vbNullString Then
        Call cmnsErrMessage(gsEMSG_INIDATABASE)
        cmnsWriteErrorLog (gsEMSG_INIDATABASE)
        GoTo cmnfGetInitParam_Abort
    Else
        gsIni_Database = Trim(sTmpStr)
    End If
    
    '获得数据库服务器地址
    sTmpStr = oIniFile.GetStringParameter("DATABASE", "Server", iParamMaxSize)
    If sTmpStr = vbNullString Then
        Call cmnsErrMessage(gsEMSG_INISERVER)
        cmnsWriteErrorLog (gsEMSG_INISERVER)
        GoTo cmnfGetInitParam_Abort
    Else
        gsIni_Server = Trim(sTmpStr)
    End If
    
    '获得数据用户名称
    sTmpStr = oIniFile.GetStringParameter("DATABASE", "LoginID", iParamMaxSize)
    If sTmpStr = vbNullString Then
'        Call cmnsErrMessage(gsEMSG_INILOGIN)
        cmnsWriteErrorLog (gsEMSG_INILOGIN)
        GoTo cmnfGetInitParam_Abort
    Else
        gsIni_LoginID = Trim(sTmpStr)
    End If
    
    '获得数据用户口令
    sTmpStr = oIniFile.GetStringParameter("DATABASE", "Password", iParamMaxSize)
    If sTmpStr = vbNullString Then
        Call cmnsErrMessage(gsEMSG_INIPASSWORD)
        cmnsWriteErrorLog (gsEMSG_INIPASSWORD)
        GoTo cmnfGetInitParam_Abort
    Else
        gsIni_Password = sTmpStr
    End If
    
'函数正常退出
cmnfGetInitParam_End:
    cmnfGetInitParam = True
    Exit Function

'函数异常退出
cmnfGetInitParam_Abort:
    cmnfGetInitParam = False
    
End Function

'******************************************************************************
'函数名称   |普通消息提示函数
'------------------------------------------------------------------------------
'函数参数   |1| IN|String:消息ID
'           |2| IN|Variant:PreFix string(前缀消息)
'           |3| IN|String:LastFix string(后缀消息)
'           |4| IN|String:Title string(字符串)
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsMessage(MessageID As String, Optional PreFix As Variant = "", _
    Optional LastFix As String = "", Optional Title As String = "")
    Dim sMsgStr, sTitleStr    As String
    
    On Error Resume Next
    
    If MessageID = "" Then Exit Sub
    
    sMsgStr = PreFix & MessageID & LastFix
    sTitleStr = "提示消息"
    If Title <> "" Then sTitleStr = Title
    
    MsgBox sMsgStr, vbCritical, sTitleStr
    
End Sub

'******************************************************************************
'函数名称   |警告消息提示函数
'------------------------------------------------------------------------------
'函数参数   |1| IN|String:消息ID
'------------------------------------------------------------------------------
'函数返回值 |vbYes:是  vbNo:否
'******************************************************************************

Public Function cmnfMessage(MessageID As String) As String
    Dim sMsgStr, sTitleStr, sTxtStyle As String
    
    On Error Resume Next
    
    If MessageID = "" Then Exit Function
    
    sMsgStr = MessageID
    sTitleStr = "警告提示"
    sTxtStyle = vbYesNo + vbExclamation
    
    cmnfMessage = MsgBox(sMsgStr, sTxtStyle, sTitleStr)
    
End Function

'******************************************************************************
'函数名称   |错误消息提示函数
'------------------------------------------------------------------------------
'函数参数   |1| IN|String:消息ID
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsErrMessage(MessageID As String)
    Dim sMsgStr, sTitleStr    As String
    
    On Error Resume Next
    
    If MessageID = "" Then Exit Sub
    
    sMsgStr = MessageID
    sTitleStr = "错误提示"
    
    MsgBox sMsgStr, vbCritical, sTitleStr
    
End Sub


'******************************************************************************
'函数名称   |写错误日志函数
'------------------------------------------------------------------------------
'函数参数   |1| IN|String:错误信息
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsWriteErrorLog(sMsg As String)
    
    On Error Resume Next

    If gots_ErrorLog Is Nothing Then
        Err
        Dim sFileName, sLogPath As String
        sLogPath = gsIni_HomePath & "logs\"
        If Not goFSO.FolderExists(sLogPath) Then
            goFSO.CreateFolder (sLogPath)
        End If
        sFileName = "error_log" & Format(Now, "yyyymmdd") & ".txt"
        Set gots_ErrorLog = goFSO.OpenTextFile(sLogPath & sFileName, ForAppending, Not goFSO.FileExists(sLogPath & sFileName), TristateUseDefault)
    End If

    gots_ErrorLog.WriteLine Now & "|" & sMsg
    
End Sub

'******************************************************************************
'函数名称   |写常规日志函数
'------------------------------------------------------------------------------
'函数参数   |1| IN|String:错误信息
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsWriteNormalLog(sMsg As String)
    
    On Error Resume Next
    
    If gots_NormalLog Is Nothing Then
        Dim sFileName, sLogPath As String
        sLogPath = gsIni_HomePath & "logs\"
        If Not goFSO.FolderExists(sLogPath) Then
            goFSO.CreateFolder (sLogPath)
        End If
        sFileName = "normal_log" & Format(Now, "yyyymmdd") & ".txt"
        Set gots_NormalLog = goFSO.OpenTextFile(sLogPath & sFileName, ForAppending, Not goFSO.FileExists(sLogPath & sFileName), TristateUseDefault)
    End If
    
    gots_NormalLog.WriteLine Now & "|" & sMsg
    
End Sub

'******************************************************************************
'函数名称   |释放系统资源函数
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsReleaseSysResource()
    
    On Error Resume Next
    
    '释放错误日志文件流
    If Not gots_ErrorLog Is Nothing Then gots_ErrorLog.Close
    
    '释放常规日志文件流
    If Not gots_NormalLog Is Nothing Then gots_NormalLog.Close
    
    '释放数据库连接句柄
    If Not gdbCurrentDB Is Nothing Then
        If gdbCurrentDB.State = adStateOpen Then gdbCurrentDB.Close
    End If
    
End Sub