VB

VB   发布时间:2022-04-03  发布网站:大佬教程  code.js-code.com
大佬教程收集整理的这篇文章主要介绍了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

大佬总结

以上是大佬教程为你收集整理的VB全部内容,希望文章能够帮你解决VB所遇到的程序开发问题。

如果觉得大佬教程网站内容还不错,欢迎将大佬教程推荐给程序员好友。

本图文内容来源于网友网络收集整理提供,作为学习参考使用,版权属于原作者。
如您有任何意见或建议可联系处理。小编QQ:384754419,请注明来意。
标签:vb