vb 与SQL /ACCESS的连接 从 ini文件里读配置

Option Explicit
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
                            ByVal lpKeyName As Any, _
                            ByVal lpDefault As String, _
                            ByVal lpReturnedString As String, _
                            ByVal nSize As Long, _
                            ByVal lpFileName As String _
                           ) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
                              ByVal lpKeyName As Any, _
                              ByVal lpString As Any, _
                              ByVal lpFileName As String _
                             ) As Long
                             
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private StrServer As String
Private StrUid As String
Private StrPwd As String
Private StrDataBase As String
Private StrSQLDSN As String

Private StrDbPath As String
Private StrMDBDSN As String

Public Group_UserNow As New Group_UserType
Private iDbType As Integer
Public Function getStrSQLDSN() As String
    getStrSQLDSN = StrSQLDSN
End Function
Public Function getStrMDBDSN() As String
    getStrMDBDSN = StrMDBDSN
End Function
Public Function getStrDSN() As String
    Select Case iDbType
    Case 0
        getStrDSN = getStrSQLDSN
    Case 1
        getStrDSN = getStrMDBDSN
    End Select
End Function
Public Function setStrSQLDSN() As Boolean
    setStrSQLDSN = True
    StrServer = GetIniStr("SQLSERVER", "SERVER")
    StrDataBase = GetIniStr("SQLSERVER", "DATABASE")
    StrUid = GetIniStr("SQLSERVER", "UID")
    StrPwd = GetIniStr("SQLSERVER", "PWD")
On Error GoTo ERR_FLG
    StrSQLDSN = "  driver={SQL server}" & _
                "; server=" & StrServer & _
                "; uid=" & StrUid & _
                "; pwd=" & StrPwd & _
                "; database=" & StrDataBase
   Exit Function
ERR_FLG:
   setStrSQLDSN = False
End Function
Public Function setStrMDBDSN() As Boolean
    setStrMDBDSN = True
    StrDbPath = GetIniStr("ACCESS", "DBPATH")
   On Error GoTo ERR_FLG
   StrMDBDSN = " Provider=Microsoft.Jet.OLEDB.4.0" & _
                ";Data Source=" & StrDbPath
   Exit Function
ERR_FLG:
   setStrMDBDSN = False
End Function
Public Function setDbType() As Boolean
    setDbType = True
    iDbType = CStr(GetIniStr("DBTYPE", "TYPE"))
On Error GoTo ERR_FLG
   Exit Function
ERR_FLG:
   setDbType = False
End Function
Public Function GetIniTF(ByVal In_Key As String) As Boolean
On Error GoTo GetIniTFErr
GetIniTF = True
Dim GetStr As String
GetStr = VBA.String(128, 0)
GetPrivateProfileString "Setting", In_Key, "", GetStr, 256, App.Path & "/SourceDB.ini"
GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "1" Then
   GetIniTF = True
   GetStr = ""
Else
   GoTo GetIniTFErr
End If
Exit Function
GetIniTFErr:
   Err.Clear
   GetIniTF = False
   GetStr = ""
End Function
Public Function WriteIniTF(ByVal In_Key As String, ByVal In_Data As Boolean) As Boolean
On Error GoTo WriteIniTFErr
WriteIniTF = True
If In_Data = True Then
 WritePrivateProfileString "Setting", In_Key, "1", App.Path & "/COMMON/database.ini"
Else
 WritePrivateProfileString "Setting", In_Key, "0", App.Path & "/COMMON/database.ini"
End If
Exit Function
WriteIniTFErr:
   Err.Clear
   WriteIniTF = False
End Function
Public Function GetIniStr(ByVal AppName As String, ByVal In_Key As String) As String
On Error GoTo GetIniStrErr
If VBA.Trim(In_Key) = "" Then
   GoTo GetIniStrErr
End If
Dim GetStr As String
GetStr = VBA.String(128, 0)
 GetPrivateProfileString AppName, In_Key, "", GetStr, 256, App.Path & "/COMMON/database.ini"
  GetStr = VBA.Replace(GetStr, VBA.Chr(0), "")
If GetStr = "" Then
   GoTo GetIniStrErr
Else
   GetIniStr = GetStr
   GetStr = ""
End If
Exit Function
GetIniStrErr:
   Err.Clear
   GetIniStr = ""
   GetStr = ""
End Function
Public Function WriteIniStr(ByVal AppName As String, ByVal In_Key As String, ByVal In_Data As String) As Boolean
On Error GoTo WriteIniStrErr
WriteIniStr = True
If VBA.Trim(In_Data) = "" Or VBA.Trim(In_Key) = "" Or VBA.Trim(AppName) = "" Then
   GoTo WriteIniStrErr
Else
 WritePrivateProfileString AppName, In_Key, In_Data, App.Path & "/COMMON/database.ini"
End If
Exit Function
WriteIniStrErr:
   Err.Clear
   WriteIniStr = False
End Function
Public Sub Main()
If Not setDbType Then
    MsgBox "读取数据库配置类型选项失败！"
End If
If Not setStrSQLDSN Then
    MsgBox "读取SQL数据库配置选项失败！"
End If
If Not setStrMDBDSN Then
    MsgBox "读取ACCESS数据库配置选项失败！"
End If
If Not testConnection Then
  frmLogin.btnOK.Enabled = False
End If
frmSplash.Show
End Sub

配置文件 参数说明
[DBTYPE]
TYPE=0--------------------------------------------------------------------采用的数据库类型 0-SQL 1-ACCESS
[SQLSERVER]
TYPE=0--------------------------------------------------------------------SQL的数据库类型值
SERVER=zjc-------------------------------------------------------------SQL SERVER的Name
DATABASE=database-------------------------------------------------数据库Name
UID=sa--------------------------------------------------------------------登陆身份号
PWD=sa------------------------------------------------------------------登陆密码
[ACCESS]
TYPE=1-------------------------------------------------------------------ACCESS的数据库类型值
DBPATH=G:/工作/PROJECT/database/database.mdb-----ACCESS数据库文件的路径