在Module(公共模块) :
Module Module1
Public connectionString As String
Public table As String
Public myinifile As String
Public server As String
Public user As String
Public pass As String
Public database As String
Public Function testsqlconnect(ByVal sqlserver As String, ByVal database As String, ByVal loginuser As String, ByVal pass As String) As Boolean
Try
Dim sqlconnect As New ADODB.Connection
sqlconnect.ConnectionString = "Provider=SQLOLEDB.1;Password=" & pass & ";Persist Security Info=True;User ID=" & loginuser & ";Initial Catalog=" & database & ";Data Source=" & sqlserver
sqlconnect.CommandTimeout = 10
sqlconnect.ConnectionTimeout = 10
sqlconnect.Open()
sqlconnect.Close()
testsqlconnect = True
Catch ex As Exception
testsqlconnect = False
End Try
End Function
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Int32
Public Function writeini(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Boolean
writeini = WritePrivateProfileString(lpApplicationName, lpKeyName, lpString, lpFileName)
End Function
Public Function GetPrivateProfileString(ByVal app As String, ByVal key As String, ByVal defaultvalue As String, ByVal inifile As String) As String '在运行该函数之前应该判断INI文件是否存在
Try
app = Trim(app)
key = Trim(key)
defaultvalue = Trim(defaultvalue)
inifile = Trim(inifile)
If Not System.IO.File.Exists(inifile) Then
Dim fs As System.IO.FileStream = System.IO.File.Create(inifile) '文件不存在就自动建立
fs.Close()
End If
Dim s As System.IO.StreamReader
Dim cLine As String
Dim bDone As Boolean = False
Dim value As String
s = New System.IO.StreamReader(inifile, System.Text.ASCIIEncoding.Default)
'On Error Resume Next 源程序带这个代码
cLine = s.ReadLine()
While Not bDone
If cLine Is Nothing Then
bDone = True
GetPrivateProfileString = defaultvalue
Exit While
Else
Select Case cLine
Case "[" & app & "]"
'value = cLine '得到字符串后,需要对字符串作进一步的处理
Dim cdone As Boolean = False
While Not cdone
cLine = s.ReadLine
If cLine Is Nothing Then
bDone = True
cdone = True
GetPrivateProfileString = defaultvalue
Exit While
Else
If cLine.Chars(0) = "[" And cLine.Chars(cLine.Length - 1) = "]" Then
bDone = True
cdone = True
GetPrivateProfileString = defaultvalue
Exit While
ElseIf Trim(cLine.Length) > key.Length Then
Dim i As Integer
Dim temp As String = ""
For i = 0 To key.Length - 1
temp = temp & cLine.Chars(i)
Next
temp = Trim(temp)
If temp = key Then
' For i = key.Length + 1 To cLine.Length - 1
' GetPrivateProfileString = GetPrivateProfileString & cLine.Chars(i)
GetPrivateProfileString = cLine.Substring(key.Length + 1)
' Next
bDone = True
cdone = True
End If
End If
End If
End While
Exit While
End Select
End If
cLine = s.ReadLine
End While
s.Close()
Catch ex As Exception
MsgBox("操作配置文件失败!")
End Try
End Function
End Module
在From2.vb板块中:
服务器名 | 控件textbox1 |
登陆名 | 控件textbox2 |
密码 | 控件textbox3 |
数据库 | 控件textbox4 |
测试连接 | 保存 | 关闭 |
Private Sub verdata()
TextBox1.Text = Trim(TextBox1.Text)
TextBox2.Text = Trim(TextBox2.Text)
TextBox3.Text = Trim(TextBox3.Text)
TextBox4.Text = Trim(TextBox4.Text)
server = TextBox1.Text
user = TextBox2.Text
pass = TextBox3.Text
database = TextBox4.Text
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
verdata()
If testsqlconnect(TextBox1.Text, TextBox4.Text, TextBox2.Text, TextBox3.Text) = True Then
MsgBox("连接成功")
Else MsgBox("连接失败")
End If
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
verdata()
savedata()
connectionString = "Provider=SQLOLEDB.1;Password=" & TextBox3.Text & ";Persist Security Info=True;User ID=" & TextBox2.Text & ";Initial Catalog=" & TextBox4.Text & ";Data Source=" & TextBox1.Text
MsgBox("保存成功")
End Sub
Private Sub savedata()
Dim temp As Boolean
temp = writeini("SQL", "server", server, myinifile)
temp = writeini("SQL", "database", database, myinifile)
temp = writeini("SQL", "user", user, myinifile)
temp = writeini("SQL", "pass", pass, myinifile)
End Sub
Private Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Loan
showdata()
End Sub
Private Sub showdata()
TextBox1.Text = server
TextBox2.Text = user
TextBox3.Text = pass
TextBox4.Text = database
End Sub
End Class
在from1.vb板块中:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
''Build a connection string
myinifile = Application.StartupPath & "/config.ini"
readini()
connectionString = ""
connectionString = "Provider=SQLOLEDB;"
connectionString += "Server=" & server & ";Database=" & database & ";"
connectionString += "User ID=" & user & ";Password=" & pass & ""
If testsqlconnect(server, database, user, pass) = False Then
MsgBox("数据库连接失败,请重新配置!")
Dim fm As New Form2
fm.ShowDialog()
End If
End Sub
Private Sub readini()
server = Trim(GetPrivateProfileString("SQL", "server", ".", myinifile))
user = Trim(GetPrivateProfileString("SQL", "user", "sa", myinifile))
pass = Trim(GetPrivateProfileString("SQL", "pass", "", myinifile))
database = Trim(GetPrivateProfileString("SQL", "database", "master", myinifile))
End Sub