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 iDbType As Integer
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 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
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数据库文件的路径
