服务器的配置(VB.net代码)

来源:互联网 发布:数联铭品 大数据 编辑:程序博客网 时间:2024/06/03 15:31

在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板块中:     

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

原创粉丝点击