VB

Option Explicit
Dim m_oIniFile As New clsIniFile

Private Const gProjectCaption As String = "Fabric提示"

Private Sub Command1_Click(Index As Integer)
Dim Str As String

On Error GoTo err
If Index = 0 Then
Dim oEn As New qlEncEncoder

m_oIniFile.SaveSetting "DBConn","ConnString1",oEn.Encoder(Trim(Text1(0)))
m_oIniFile.SaveSetting "DBConn","ConnString2",oEn.Encoder(Trim(Text1(1)))
m_oIniFile.SaveSetting "DBConn","ConnString3",oEn.Encoder(Trim(Text1(2)))


Dim oDBConn As New ADODB.Connection
If Trim(Text1(0)) <> "" Then
oDBConn.ConnectionString = Trim(Text1(0))
oDBConn.Open

MsgBox "数据库连接1成功",vbInformation,gProjectCaption
Unload Me
End If
End If

If Index = 1 Then Unload Me
Exit Sub
err:
MsgBox err.Description,vbCritical,gProjectCaption
End Sub

Private Sub Form_Load()
Dim oEn As New qlEncDecoder

m_oIniFile.File = App.Path & "System.ini"

Text1(0) = oEn.Decoder(m_oIniFile.GetSetting("DBConn","ConnString1"))
Text1(1) = oEn.Decoder(m_oIniFile.GetSetting("DBConn","ConnString2"))
Text1(2) = oEn.Decoder(m_oIniFile.GetSetting("DBConn","ConnString3"))
End Sub

Private Sub Label2_Click(Index As Integer)

End Sub

Option Explicit

' --------
' Public
' --------
'
' Property for file to read
Public File As String

' ---------
' Private
' ---------
'
' API to read/write ini's
#If Win32 Then
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 Integer,ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "KERNEL32" Alias "WritePrivateProfileStringA" (ByVal Appname As String,ByVal KeyName As Any,ByVal NewString As Any,ByVal Filename As String) As Integer
#Else
Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String,ByVal lpFileName As String) As Integer
Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal Appname As String,ByVal Filename As String) As Integer
#End If

Public Sub DeleteSection(ByVal Section As String)
Dim RetVal As Integer

RetVal = WritePrivateProfileString(Section,0&,"",File)
End Sub

Public Function SaveSetting(ByVal Section$,ByVal Key$,ByVal Value$)
Dim RetVal As Integer

SaveSetting = WritePrivateProfileString(Section$,Key$,Value$,File)
End Function

Public Function GetSetting(ByVal Section As String,ByVal KeyName As String) As String
Dim RetVal As Integer
Dim t As String * 10000

' Get the value
RetVal = GetPrivateProfileString(Section,KeyName,t,Len(t),File)

' If there is one,return it
If RetVal > 0 Then
GetSetting = Replace(Trim(Left$(t,RetVal)),Chr(0),"")
Else
GetSetting = ""
End If
End Function

Public Function GetSection(ByVal Section As String,KeyArray() As String) As Integer
Dim RetVal As Integer
' Allocate space for return value
Dim t As String * 10000
Dim lastpointer As Integer
Dim nullpointer As Integer
Dim ArrayCount As Integer
Dim keystring As String
ReDim KeyArray(0)

' Get the value
RetVal = GetPrivateProfileString(Section,return it
If RetVal > 0 Then
'
' Separate the keys and store them in the array
nullpointer = InStr(t,Chr$(0))
lastpointer = 1
Do While (nullpointer <> 0 And nullpointer > lastpointer + 1)
'
' Extract key string
keystring = Mid$(t,lastpointer,nullpointer - lastpointer)
'
' Now add to array
ArrayCount = ArrayCount + 1
ReDim Preserve KeyArray(ArrayCount)
KeyArray(ArrayCount) = keystring
'
' Find next null
lastpointer = nullpointer + 1
nullpointer = InStr(nullpointer + 1,Chr$(0))
Loop
End If
'
' Return the number of array elements
GetSection = ArrayCount
End Function

Public Function GetSections(Optional ByVal INIFileLoc As String) As String
Dim RetVal As String
Dim KeyLen As Integer
Dim useFile As String

'since we could have a lot of sections in one file we are going to use a 1024 char buffer
RetVal = String$(10240,0)
KeyLen = GetPrivateProfileString(vbNullString,vbNullString,RetVal,Len(RetVal),File)

'if no sections are found then return "" (vbNullString)
If KeyLen = 0 Then
GetSections = ""
Else
'if the retval is > 0 then return the results
'since we are getting multiple sections but returning them as one string the
'programer should use the split() function in the returned value with
'chr$(0) being the delimiter
GetSections = Trim(Left$(RetVal,KeyLen - 1))
If Right(GetSections,1) = Chr(0) Then
GetSections = Left(GetSections,Len(GetSections) - 1)
End If
GetSections = Replace(GetSections,",")
End If
End Function

Private Sub Class_Initialize()

End Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!