Option Explicit
'Settings interface class
'Copyright ?2000 - Stan Schultes
'Written for VBPJ Getting Started September, 2000
'CSetting mode enum
Public Enum csModes
csModeRegistry = 0
csModeINI = 1
End Enum
'class member variables
Private m_eSaveMode As csModes
'module-level variables
Private msININame As String 'name of .INI file
Private msAppName As String 'app name for settings
'INI setting APIs
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal SectionName As String, ByVal KeyName As String, ByVal Default As Long, ByVal FileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal SectionName As String, ByVal KeyName As String, ByVal Default As String, ByVal ReturnedString As String, ByVal StringSize As Long, ByVal FileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal SectionName As String, ByVal KeyName As String, ByVal KeyValue As String, ByVal FileName As String) As Long
'there is no WritePrivateProfileInt declaration...
'Error definitions
Private Const mklErrOffset As Long = vbObjectError + 512
Private Const mklErrNotNumeric As Long = mklErrOffset + 1
Private Const mksErrNotNumeric As String = "The setting value returned was not numeric"
Private Const mklErrWriting As Long = mklErrOffset + 2
Private Const mksErrWriting As String = "Error writing Setting "
Private Const mklErrReading As Long = mklErrOffset + 3
Private Const mksErrReading As String = "Error reading Setting "
Public Function Init(Optional ByVal AppPath As String, Optional ByVal AppName As Variant, Optional ByVal Mode As csModes = csModeRegistry)
'Set up class variables, default to Registry mode
If IsMissing(AppPath) Then
msININame = App.Path
Else
msININame = Trim$(AppPath)
End If
If IsMissing(AppName) Then
msAppName = App.EXEName
Else
msAppName = Trim$(AppName)
End If
'default to the app's .exe path
msININame = msININame & "\" & msAppName & ".ini"
' msININame = App.Path & "\" & msAppName & ".ini"
SaveMode = Mode
End Function
Public Function GetSettingStr(ByVal Section As String, ByVal KeyName As String, ByVal DefaultValue As String) As String
'returns a string setting
Dim lRet As Long
Dim sBuf As String * 128
On Error GoTo GetSettingStr_Error
If Len(msAppName) = 0 Then Init
Select Case m_eSaveMode
Case csModeRegistry
GetSettingStr = GetSetting(msAppName, Section, KeyName, DefaultValue)
Case Else
lRet = GetPrivateProfileString(Section, KeyName, DefaultValue, sBuf, Len(sBuf), msININame)
GetSettingStr = TrimNull(sBuf)
End Select
GetSettingStr_Exit:
Exit Function
GetSettingStr_Error:
Err.Raise mklErrReading, "CSetting.GetSettingStr", mksErrReading & "(" & Err & ", " & Error & ")"
End Function
Public Function GetSettingInt(ByVal Section As String, ByVal KeyName As String, ByVal DefaultValue As Integer) As Integer
'returns a numeric setting
Dim sSetting As String
On Error GoTo GetSettingInt_Error
If Len(msAppName) = 0 Then Init
Select Case m_eSaveMode
Case csModeRegistry
sSetting = GetSetting(msAppName, Section, KeyName, CStr(DefaultValue))
'check if value is numeric
If IsNumeric(sSetting) Then
GetSettingInt = CInt(sSetting)
Else
'match behavior of .INI return
GetSettingInt = 0
'or - return error if desired
'On Error GoTo 0 'disable handler to return error
'Err.Raise mklErrNotNumeric, "CSetting.GetSettingInt", mksErrNotNumeric
End If
Case Else
'returns 0 if not numeric
GetSettingInt = GetPrivateProfileInt(Section, KeyName, DefaultValue, msININame)
End Select
GetSettingInt_Exit:
Exit Function
GetSettingInt_Error:
Err.Raise mklErrReading, "CSetting.GetSettingInt", mksErrReading & "(" & Err & ", " & Error & ")"
End Function
Public Sub SaveSettingStr(ByVal Section As String, ByVal KeyName As String, ByVal Setting As String)
'saves a string setting
Dim lRet As Long
On Error GoTo SaveSettingStr_Error
If Len(msAppName) = 0 Then Init
Select Case m_eSaveMode
Case csModeRegistry
SaveSetting msAppName, Section, KeyName, Setting
Case Else
lRet = WritePrivateProfileString(Section, KeyName, Setting, msININame)
End Select
SaveSettingStr_Exit:
Exit Sub
SaveSettingStr_Error:
Err.Raise mklErrWriting, "CSetting.SaveSettingStr", mksErrWriting & "(" & Err & ", " & Error & ")"
End Sub
Public Sub SaveSettingInt(ByVal Section As String, ByVal KeyName As String, Setting As Integer)
'saves a numeric setting
Dim lRet As Long
On Error GoTo SaveSettingInt_Error
If Len(msAppName) = 0 Then Init
Select Case m_eSaveMode
Case csModeRegistry
SaveSetting msAppName, Section, KeyName, CStr(Setting)
Case Else
lRet = WritePrivateProfileString(Section, KeyName, CStr(Setting), msININame)
End Select
SaveSettingInt_Exit:
Exit Sub
SaveSettingInt_Error:
Err.Raise mklErrWriting, "CSetting.SaveSettingInt", mksErrWriting & "(" & Err & ", " & Error & ")"
End Sub
Public Property Let SaveMode(Mode As csModes)
'sets save mode, see csModes enum
m_eSaveMode = Mode
End Property
Public Property Get SaveMode() As Long
'returns save mode
SaveMode = CLng(m_eSaveMode)
End Property
Private Function TrimNull(ByVal InString As String) As String
'trims string at first Null character
Dim lPos As Long
TrimNull = Trim$(InString)
lPos = InStr(TrimNull, vbNullChar)
If lPos > 0 Then TrimNull = Left$(TrimNull, lPos - 1)
End Function
Private Sub Class_Initialize()
msININame = App.Path & "\" & App.EXEName & ".ini"
End Sub
使用方法：
在程序的全局模塊中定義CSetting的類實例變量：（以下定義了兩個，分別讀寫ini和註冊表）
Public SetIni As CSetting '讀寫ini配置文件參數 '
Public SetReg As CSetting'讀寫註冊表配置參數
在sub main 中初始化：(其中PATH_EXE是妳的程序路徑，放ini文件的路徑)
Set SetIni = New CSetting
SetIni.Init PATH_Exe, App.Title, csModeINI
Set SetReg = New CSetting
SetReg.Init PATH_Exe, App.Title, csModeRegistry
這就可以隨便用了。
dbPassword = SetIni.GetSettingStr(NameDB, "Password", "111111")
dbUserID = SetIni.GetSettingStr(NameDB, "UserID", "123456")
dbCatalog = SetIni.GetSettingStr(NameDB, "Catalog", "aaa")
dbDataSource = SetIni.GetSettingStr(NameDB, "DataSource", sky)
cnStr= "Provider=SQLOLEDB.1;Password=" & dbPassword & ";Persist Security Info=True;User ID=" & dbUserID & ";Initial Catalog=" & dbCatalog & ";Data Source=" & dbDataSource '
其它由妳自己補充了。