mconnectdb.bas

公司订单管理系统,这对于方便公司管理床单

Attribute VB_Name = "mConnectDB"
Option Explicit
'**************************************************************************************
'软件名称：订料管理
'开发语言：visual basic 6.0
'开发日期：2007-11
'开发作者：剪刀石头布
'联系方式：[e-mail]
'**************************************************************************************
Public pCnn As New ADODB.Connection
Public pRs As New ADODB.Recordset
Public pCmd As New ADODB.Command

Public psUserName As String            '保存當前登錄用户的用戶名稱
Public psAdministrator As String       '記錄當前登錄用户的权限名稱.普通用戶,管理員
Public pbAdministrator As Boolean      '保存當前登錄用户的权限.True:管理员;False:普通用户
Public pbSuccessLogin As Boolean       '用戶登录成功标记
Public psDatabasePath As String        '保存數據庫路徑
Public psDatabaseName As String        '保存數據庫名稱
Public psDataSource As String          '数据庫完整路徑

'繫統登錄入口
Public Sub Main()
Form1.Show
Form1.Refresh
    
    '從註冊表中讀取數據源信息
    If GetDataSourceInfo(psDatabasePath, psDatabaseName) Then
       '讀取數據源信息成功
       psDataSource = psDatabasePath & "\" & psDatabaseName
       '顯示數據庫登錄對話框
       frmLogin.Show
       Unload Form1
    Else
       '讀取數據源信息失敗
       '顯示數據源配置對話框
       frmConfigDataSource.Show
    End If
End Sub

'连接数据库，使用Microsoft Access数据库为数据源，必须先配置好ODBC数据源。
Public Function ConnectionDB(ByVal sUserName As String, _
                             ByVal sPassWord As String) As String

On Error GoTo ErrorHandler
    
   '已经配置了ODBC数据源。使用Microsoft Access数据库为数据源。
   'pCnn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
                            "Data Source=" & psDataSource & ";"
   'pCnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
                            "Data Source=\\Computer\ShareName\*.mdb"
    pCnn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
                            "DBQ=" & psDataSource & ";" & "Password=yaufat;"

    pCnn.CursorLocation = adUseClient
    pCnn.Open
    
    Set pRs.ActiveConnection = pCnn    '将Recordset对象实例绑定到一个已经打开的数据库物理连接
    pRs.CursorType = adOpenStatic      '设置游标类型:静态游标，其他用户对表的记录进行删除和修改不可见
    pRs.LockType = adLockOptimistic    '设置锁类型:开放锁
    pRs.Source = "SELECT * FROM Administrator" '打開用戶管理表
    pRs.Open , , , , adCmdText
    '驗證用戶和密碼
    pbSuccessLogin = False
    If (Not pRs.BOF) And (Not pRs.EOF) Then
        Do While Not pRs.EOF
           If (StrComp(pRs("UserName"), sUserName, vbBinaryCompare) = 0) And _
              (StrComp(pRs("Password"), sPassWord, vbBinaryCompare) = 0) Then
               pbSuccessLogin = True
               psUserName = pRs("UserName")
               pbAdministrator = pRs("Authority")
               If pbAdministrator = True Then
                  psAdministrator = "管理員"
               Else
                  psAdministrator = "普通用戶"
               End If
               Exit Do
           End If
           'Debug.Print pRs("UserName"), pRs("Password"), pRs("Authority")
           pRs.MoveNext
        Loop
        If pbSuccessLogin = True Then
           'MsgBox "登录成功！", vbExclamation, "用户"
        Else
           pbSuccessLogin = False
           MsgBox "登錄失敗！請驗證輸入的用戶名和密碼是否正確。", vbExclamation, "用戶"
        End If
    Else
        pbSuccessLogin = False
        MsgBox "當前用戶管理列表中沒有任何用戶，請和管理員聯繫！", vbExclamation, "用戶登錄失敗"
    End If
    CloseDBConnection            '关闭数据库的连接,释放系统资源
    
Exit Function
ErrorHandler:
    pbSuccessLogin = False
    CloseDBConnection            '关闭数据库的连接,释放系统资源
    MsgBox "驗證用戶和密碼失敗！", vbCritical, "錯誤"
    'MsgBox "[ErrorNumber]" & Err.Number & vbCrLf & _
            "[ErrorDescription ]" & Err.Description, vbExclamation, "连接数据库失败"
End Function

'关闭数据库的连接,释放系统资源
Public Function CloseDBConnection()
On Error Resume Next
    pRs.Close
    pCnn.Close
    Set pCmd = Nothing
    Set pRs = Nothing
    Set pCnn = Nothing
End Function

'数据库连接状态
'ConnectionState(pCnn)
'Private Function ConnectionState(ByVal cnnState As ADODB.Connection) As String
'    Select Case cnnState.State
'        Case adStateClosed     '0 数据库已经被关闭
'            ConnectionState = "数据库连接被关闭"
'        Case adStateOpen       '1 数据库已经被打开
'            ConnectionState = "连接数据库成功"
'        Case adStateConnecting '2 数据库正在连接
'            ConnectionState = "正在连接数据库"
'        Case adStateExecuting  '4 正在执行查询
'            ConnectionState = "正在执行查询"
'        Case adStateFetching   '8
'
'    End Select
'End Function

'pCnn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
                            "Server=" & sServerName & ";" & "Initial Catalog=" & psDataSource & ";"
'pCnn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
                            "Server=" & sServerName & ";" & "Data Source=" & psDataSource & ";"
'pCnn.ConnectionString = "Driver={Microsoft Access Driver (*.mdb)};" & _
                            "Initial Catalog=" & psDataSource & ";"
'pRs.Source = "SELECT * FROM Administrator" & _
                   "WHERE" & "'" & UserName & "'=" & sUserName & _
                             "'" & Password & "'=" & sPassWord    '打开用户管理表"