mdlmain.bas

VB6.0编写的医院影像系统

Attribute VB_Name = "mdlMain"
Option Explicit

Public Sub Main()
'    If App.PrevInstance Then
'        Exit Sub
'    End If

    '//连接数据库//
    If Not OpenDataBase() Then
        MsgBox "无法连接数据库。"
        Exit Sub
    End If
    
    frmLogin.Show
    
End Sub

'-------------------------------------------------
'功能：自动连接数据库
'返回：（True：连接成功，False：连接失败）
'-------------------------------------------------
Private Function OpenDataBase() As Boolean
On Error GoTo ErrorAttach
Dim sDB As String
Dim sSERVER As String
Dim sPWD As String
Dim ConnectString As String
    
    '//连接主体数据库
    sDB = GetRegistry(HKEY_CURRENT_USER, _
        gsREGISTRY_SECTION_DATABASE, gsREGISTRY_KEY_DATABASE)
    sSERVER = GetRegistry(HKEY_CURRENT_USER, _
        gsREGISTRY_SECTION_DATABASE, gsREGISTRY_KEY_SERVER)
    sPWD = GetRegistry(HKEY_CURRENT_USER, _
        gsREGISTRY_SECTION_DATABASE, gsREGISTRY_KEY_PWD)
    
    If (sDB = "") Or (sSERVER = "") Then
        OpenDataBase = False
        GoTo ExitEntry
    End If
    
    Set GDB = New ADODB.Connection
    ConnectString = "driver={SQL Server}; server=" & sSERVER & _
                    ";uid=sa; pwd=" & sPWD & ";database=" & sDB
    GDB.Open ConnectString
    
    If GDB.State = adStateOpen Then
        OpenDataBase = True
    End If
    
    '打开几个公用的记录集
    Set rsSickInfo = OpenRSClient("SELECT * FROM SICK_INFO")
    
ExitEntry:
    Exit Function
ErrorAttach:
    OpenDataBase = False
End Function