moddatabase.bas

智能邮件管理信息系统

Attribute VB_Name = "modDatabase"
'******************************************************************************
' -概要定义-
'  系统名称
'                   Copyright(C) 2004
'  程序名称         Database.bas
'  功能概要         数据库操作相关定义
'  日期             2004.05.18
'  作成者
'  备注
'******************************************************************************
'修改简历
'******************************************************************************
Option Explicit


            
'******************************************************************************
'全局变量的声明
'******************************************************************************

'数据库全局变量
Public gsIni_Driver         As String               '数据库驱动
Public gsIni_Database       As String               '数据库名称
Public gsIni_Server         As String               '数据服务器地址
Public gsIni_LoginID        As String               '数据库用户名称
Public gsIni_Password       As String               '数据库用户口令

'数据库环境全局变量
Public gdbCurrentDB             As New ADODB.Connection '数据库连接对象



'******************************************************************************
'函数名称   |打开数据库连接
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |Boolean:打开结果 True-正确,False-失败
'******************************************************************************
Public Function cmnfGetConnection() As ADODB.Connection
    Dim ConnectStr  As String
    Dim adoDBConn             As New ADODB.Connection '数据库连接对象

    On Error GoTo cmnfOpenDatabase_Err
'
'    If App.PrevInstance Then
'        MsgBox "当前应用程序实例已经在运行,不能运行程序!", vbOKOnly, "提示"
'        End
'    End If

'连接数据库
    With adoDBConn
         Select Case UCase(gsIni_Driver)
            Case UCase("sqlsever")
'                '数据源方式
                .ConnectionString = "driver={SQL SERVER}" & _
                                    ";server=" & gsIni_Server & _
                                    ";uid=" & gsIni_LoginID & _
                                    ";pwd=" & gsIni_Password & _
                                    ";database=" & gsIni_Database

'                无数据源方式
'                               .ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=SmartMail;Data Source=XHT\TT"
                               
            Case UCase("access")
                .ConnectionString = "Driver={Microsoft Access Driver (*.mdb)}" & _
                                    ";Dbq=" & App.Path & "\db2.mdb" & _
                                    ";Uid=" & _
                                    ";Pwd="
                                    
                                    
                
                
        End Select
        .CursorLocation = adUseClient
        .Open
        If .State <> adStateOpen Then GoTo cmnfOpenDatabase_Err
    End With
    
    If adoDBConn Is Nothing Then
        Unload frmMain
    End If
    Set cmnfGetConnection = adoDBConn
    Exit Function
'打开数据库不正确
cmnfOpenDatabase_Err:
    If adoDBConn.State = adStateOpen Then adoDBConn.Close
    cmnsWriteErrorLog gsEMSG_OPENDATABASE & "|" & Err.Description
    Call cmnsErrMessage(gsEMSG_OPENDATABASE)
    Set cmnfGetConnection = adoDBConn
    Exit Function

End Function

'******************************************************************************
'函数名称   |关闭数据库连接
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub cmnsCloseDatabase()

    On Error Resume Next

    '关闭数据库连接
    If Not gdbCurrentDB Is Nothing Then gdbCurrentDB.Close

End Sub

'******************************************************************************
'函数名称   |启动程序主函数
'------------------------------------------------------------------------------
'函数参数   |无
'------------------------------------------------------------------------------
'函数返回值 |无
'******************************************************************************
Public Sub MainRun()
    
'获得系统初始化参数
    Call cmnsGetHomePath
    If Not cmnfGetComputerName() Then
                Unload frmMain
    End If
    If Not cmnfGetInitParam() Then
    End If
    
'得到数据库连接
    If gdbCurrentDB.State <> adStateOpen Then Set gdbCurrentDB = cmnfGetConnection
    If gdbCurrentDB.State <> adStateOpen Then
        Unload frmMain
    End If
    
    
     Dim mclsEmployee As PEmployee.clsEmployee
    
    Set mclsEmployee = New PEmployee.clsEmployee
    mclsEmployee.Init gdbCurrentDB
    
    #If ChengRen = 1 Then
        gLngEmployeeID1 = 1
        If gLngEmployeeID1 = 0 Then
           End
        End If
    #ElseIf V98989 = 1 Then
        gLngEmployeeID1 = 1
        If gLngEmployeeID1 = 0 Then
            End
        End If
    #Else
        Call frmLogin.ShowLoginDialog(gLngEmployeeID1, blnIsSystem)
        If gLngEmployeeID1 = 0 Then
            Unload frmMain
        End If
    #End If


    
End Sub




Public Function GetSeverDateTime() As Date
    Dim strsql As String
    
    If Not InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
        strsql = "select now from mail WHERE lngMailID=0"
        
    ElseIf InStr(1, UCase(gdbCurrentDB.ConnectionString), UCase("Microsoft Access Driver")) > 0 Then
        strsql = "select GetUtCDate() from mail "
    End If
End Function