解决程序数据库连接字符串中IP地址重问题

不知大家用VB或其它程序开发数据库时是否遇到数据库连接问题，下面就来解决这个问题：

连接字符串问题，每次开发一个程序，由于数据库服务器，不是固定的IP地址，如果想把这个程序安装到不同的局域网中，需要在每台客户端

机器上都要安装客户程序，程序的连接字符串如：
 "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial Catalog=teach;Data

Source=(192.168.2.244)"
中的IP地址都需要重新设定，而每次启动程序时都需要重新设定这个主机IP,我们可以用下面的方法，使客户端程序安装运行后只进行一次，IP

地址设定，下面是程序说明：

程序的基本思想：
  说明：此程序用VB开发，关键要用到
   On Error GoTo E1
   以自动检测连接字符串是否正确，如正确则进入主程序，不正确则进入设置服务器IP地址模块。
  
  ****程序流程****
  程序启动，
  查找当前程序所在路径是否有连接字符串文件conn.txt
  如果有，
   读取conn.txt文件，
   连接数据库服务器，
   自动搜索服务器，延时等待
   如果连接正常，进入其它管理模块，正常使用...；
   如果连接失败
    进入设置IP地址模块
     用户设置服务器IP地址，
     保存IP地址信息在当前程序目录下文件名为conn.txt，
    设置IP地址模块结束
   转到：读取conn.txt文件
  如果无
   进入设置IP地址模块

  ****程序流程结束****

--------------------公共模块M1-----------------------
Public ConnPath As String'
Public ConnectionString As String

Public Sub StartConn()'此过程自动读取并判断连接字符串是否正确，不正确则转入IP地址设置模，
On Error GoTo E1
Dim DataBase As String

Dim Path As String
Dim FileNumber
M1.ConnPath = App.Path & "/conn.txt"
             FileNumber = FreeFile
             If Dir(M1.ConnPath) = "" Then
                   Open M1.ConnPath For Output As FileNumber
                   Close FileNumber
             End If
           
                    Open M1.ConnPath For Input As FileNumber
                    If Not EOF(FileNumber) Then
                            Input #FileNumber, M1.ConnectionString
                            Close FileNumber                           
                            '--------测试连接
                            Dim Cmd As New ADODB.Connection
                            Dim RSUser As New ADODB.Recordset
                            Cmd.ConnectionString = M1.ConnectionString
                            Cmd.CursorLocation = adUseClient
                            Cmd.Open
                            Cmd.Execute "select * from users where user_id=0"                             '--------
                            DE1.Conn1.ConnectionString = M1.ConnectionString
                           '---------测试连接结束
    -----测试连接字符串是否正确：正确则正常进入不程序，不正确会跳转到标号E1.
                    End If
                    Close FileNumber
            If M1.ConnectionString = "" Then
                            MsgBox "请设置服务器数据库!", vbInformation
                            FrmConn.Show 1'--------进入设置IP地址模块
                            If M1.ConnectionString = "" Then
                                    MsgBox "设置不成功!退出系统", vbInformation: End
                            End If
                            MsgBox "设置完毕!", vbInformation
            End If           
Exit Sub

E1:
 MsgBox "请设置服务器数据库!", vbInformation
 FrmConn.Show 1'--------进入设置IP地址模块
 If M1.ConnectionString = "" Then
             MsgBox "设置不成功!退出系统", vbInformation: End
   End If
  MsgBox "设置完毕!", vbInformation
End Sub
---------------------公共模块M1结束---------------------------------------
---------------------IP地址设置模块---------------------------------------
Option Explicit

Private Sub CmdCancel_Click()
M1.ConnectionString = ""
Unload Me
End Sub

Private Sub CmdOk_Click()
On Error GoTo E1
M1.ConnectionString = ""
If Trim(Me.TxtServer) = "" Then
        MsgBox "输入服务器名!", vbInformation: Me.TxtServer.SetFocus:  Exit Sub
End If
M1.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;User ID=sa;Initial

Catalog=teach;Data Source=" & Trim(Me.TxtServer)

Me.LblFindServer.Visible = True

DoEvents
'测试连接
Dim Cmd As New ADODB.Connection
Dim RSUser As New ADODB.Recordset
Cmd.ConnectionString = M1.ConnectionString
Cmd.CursorLocation = adUseClient
DoEvents
Cmd.Open
Cmd.Execute "select * from users where user_id=0"
 '--------

DE1.Conn1.ConnectionString = M1.ConnectionString '"Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security

Info=False;User ID=sa;Initial Catalog=teach;Data Source=" & Trim(Me.TxtServer)

Dim DataBase As String
Dim Path As String
Dim FileNumber
M1.ConnPath = App.Path & "/conn.txt"
FileNumber = FreeFile
Open M1.ConnPath For Output As FileNumber
Write #FileNumber, M1.ConnectionString
Close FileNumber
Me.LblFindServer.Visible = False
Unload Me
Exit Sub

E1:
        Me.LblFindServer.Visible = False
        MsgBox "当前局域网中服务器不存在错误!", vbInformation
End Sub

Private Sub TxtServer_GotFocus()
Me.TxtServer.SelStart = 0
Me.TxtServer.SelLength = Len(Me.TxtServer)
End Sub
----------------------------IP地址设置模块结束-------------------------------

********结束语：
 1.此程序可改变连接字符串，用在其它数据库上，程序思想很重要，只要程序设计思想理解了，就可以不用看我写的程序源码，自已

写出更完善的程序代码。在这里注重程序思想的理解上，因为读程序可以很累。
 2.此程序是放在主程序登陆之前，的程序，用以自动判断并保存数据库服务器地址。
 3.请着重放在此程序的思想方法上。