vb 与SQL /ACCESS的连接 从 ini文件里读配置
2005-08-26 14:23
495 查看
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数据库文件的路径
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数据库文件的路径
相关文章推荐
- vb 与SQL /ACCESS的连接 从 ini文件里读配置
- springmvc+sqlserver中的连接sqlserver的spring配置文件
- Mac配置php.ini文件,连接mysql数据库
- 将DELPHI数据库连接写进INI配置文件中
- (转载)将DELPHI数据库连接写进INI配置文件中
- C# asp.net 配置文件连接sql 数据库
- C# 读写ini配置文件(.net/SQL技术交流群206656202 入群需注明博客园)
- Java 连接access 使用access文件 不用配置
- [sql]配置文件 SQL SERVER 2005连接字符串
- pl/sql通过修改配置文件的方式实现数据库的连接
- PL/SQL通过修改配置文件的方式实现数据库的连接听语音
- PL/SQL Developer快速连接数据库(不需要再在Oracle数据库安装文件下配置tnsnames.ora文件)
- [学习笔记]将LinqToSql的连接字符串写在配置文件中
- asp.net通过配置文件连接Access的方法
- 将LinqToSql的连接字符串写在配置文件中
- Spring4.1使用c3p0加载配置文件连接数据库,Access denied for user 'root'@'localhost' 错误!
- "System.Data.SqlServerCe.SqlCeException: 数据库文件大于配置的最大数据库大小。该设置仅在第一次并发数据库连接后生效"解决方案
- Spring4.X使用c3p0加载配置文件连接数据库,出现的Access denied for user 'root'@'localhost' 错误!
- VB.NET读写INI配置文件
- [转]VB 读写ini 配置文件