Option Explicit Private Sub cmdCancel_Click() MySql = "CANCEL" Unload Me End Sub Private Sub cmdOK_Click() LocalComputerName = txtComputerName LocalDataBaseName = txtDatabaseName LocalDatabaseLogin = txtDatabaselogin LocalDatabasePassword = txtDatabasePassword LocalDataBaseType = XTCombo(1).Text RemoteComputerName = NetComputerName RemoteDataBaseName = NetDatabaseName RemoteDatabaseLogin = NetDatabaselogin RemoteDatabasePassword = NetDatabasePassword XITONGSZ.XTSZ(7).Text = txtComputerName XITONGSZ.XTSZ(8).Text = txtDatabaseName XITONGSZ.XTCombo(1).ListIndex = XTCombo(1).ListIndex XITONGSZ.XTSZ(9).Text = NetComputerName XITONGSZ.XTSZ(10).Text = NetDatabaseName XITONGSZ.XTCombo(2).ListIndex = XTCombo(0).ListIndex ' SaveSetting APP_CATEGORY, App.Title, "本机服务器", LocalComputerName ' SaveSetting APP_CATEGORY, App.Title, "本机数据库", LocalDataBaseName ' SaveSetting APP_CATEGORY, App.Title, "本机数据库登录", LocalDatabaselogin ' SaveSetting APP_CATEGORY, App.Title, "本机数据库口令", LocalDatabasePassword ' SaveSetting APP_CATEGORY, App.Title, "数据库类型", LocalDataBaseType ' ' SaveSetting APP_CATEGORY, App.Title, "网络服务器", RemoteComputerName ' SaveSetting APP_CATEGORY, App.Title, "网络数据库", RemoteDataBaseName ' SaveSetting APP_CATEGORY, App.Title, "网络数据库登录", RemoteDatabaselogin ' SaveSetting APP_CATEGORY, App.Title, "网络数据库口令", RemoteDatabasePassword ' SaveSetting APP_CATEGORY, App.Title, "数据库类型", RemoteDataBaseType MySql = "OK" Unload Me End Sub Private Sub Command1_Click() On Error Resume Next Dim DataBaseConnectString As String Select Case XTCombo(1).Text Case "ACCESS" DataBaseConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & txtDatabaseName Case "SQL_2000" DataBaseConnectString = "Provider=SQLOLEDB.1;Password=" & txtDatabasePassword & ";Persist Security Info=True;User ID=" & txtDatabaselogin & ";Initial Catalog=" & txtDatabaseName & ";Data Source=" & txtComputerName Case "SQL_2008" DataBaseConnectString = "Provider=SQLNCLI10.1;Server=" & txtComputerName & ";Database=" & txtDatabaseName & ";Uid=" & txtDatabaselogin & "; Pwd=" & txtDatabasePassword & ";" Case "ORACLE" DataBaseConnectString = "Provider=MSDASQL.1;Password=gzsf;Persist Security Info=True;User ID=gzguest;Data Source=" & txtComputerName Case "SYBASE" Case Else DataBaseConnectString = "" End Select Err.Clear With RemoteCn .ConnectionString = DataBaseConnectString .CursorLocation = adUseClient .Mode = adModeReadWrite .ConnectionTimeout = 10 .Open End With If Err.Number Then Err.Clear MsgBox "数据库连接不成功!请检查!", vbOKOnly, "友情提示" Else MsgBox "数据库连接成功!祝贺您!", vbOKOnly, "友情提示" End If RemoteCn.Close End Sub Private Sub Command2_Click() On Error Resume Next Dim DataBaseConnectString As String Select Case XTCombo(0).Text Case "ACCESS" DataBaseConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & NetDatabaseName Case "SQL_2000" DataBaseConnectString = "Provider=SQLOLEDB.1;Password=" & NetDatabasePassword & ";Persist Security Info=True;User ID=" & NetDatabaselogin & ";Initial Catalog=" & NetDatabaseName & ";Data Source=" & NetComputerName Case "SQL_2008" DataBaseConnectString = "Provider=SQLNCLI10.1;Server=" & NetComputerName & ";Database=" & NetDatabaseName & ";Uid=" & NetDatabaselogin & "; Pwd=" & NetDatabasePassword & ";" Case "ORACLE" DataBaseConnectString = "Provider=MSDASQL.1;Password=gzsf;Persist Security Info=True;User ID=gzguest;Data Source=" & NetComputerName Case "SYBASE" Case Else DataBaseConnectString = "" End Select Err.Clear With RemoteCn .ConnectionString = DataBaseConnectString .CursorLocation = adUseClient .Mode = adModeReadWrite .ConnectionTimeout = 10 .Open End With If Err.Number Then Err.Clear MsgBox "数据库连接不成功!请检查!", vbOKOnly, "友情提示" Else MsgBox "数据库连接成功!祝贺您!", vbOKOnly, "友情提示" End If RemoteCn.Close End Sub Private Sub Form_Load() txtComputerName = LocalComputerName txtDatabaseName = LocalDataBaseName txtDatabaselogin = LocalDatabaseLogin txtDatabasePassword = LocalDatabasePassword XTCombo(1).Text = LocalDataBaseType NetComputerName = RemoteComputerName NetDatabaseName = RemoteDataBaseName NetDatabaselogin = RemoteDatabaseLogin NetDatabasePassword = RemoteDatabasePassword XTCombo(0).Text = RemoteDataBaseType End Sub Private Sub Text2_Change() End Sub
自SQL Server 2012开始,已经不支持通过链接服务器链接到SQL Server 2000。主要是SQL SERVER 2012/2014安装的是SQL Server Native Client 11.0。而SQL Server Native Client 11.0 does not support connections to SQL Server 2000 or earlier versions。