调试代码如下:
Option Explicit
Public Function GetConnectionString(Optional forceshow As Boolean = False) As String
Dim svr, usr, pas, nt As String
Dim l As Long
Dim myconn As ADODB.Connection
Set myconn = New ADODB.Connection
svr = GetSetting("appME", "s", "server", "")
If svr = "" Then GoTo ShowExit
nt = GetSetting("appME", "s", "nt", "")
usr = GetSetting("appME", "s", "user", "")
pas = GetSetting("appME", "s", "password", "")
If forceshow Then GoTo ShowExit
If CStr(nt) = "1" Then
myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
Else
myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
End If
myconn.ConnectionTimeout = 5
On Error GoTo CE
myconn.Open
myconn.Close
Exit Function
CE:
MsgBox Err.Description, vbExclamation, "连接错误"
lblinfo.Caption = "请重新填写."
ShowExit:
Me.Server.Text = svr
If CStr(nt) = "1" Then
optWinNTAuth.Value = True
Else
optSSAuth.Value = True
Me.user.Text = usr
Me.pass.Text = pass
End If
Me.Show vbModal
If optWinNTAuth.Value = True Then
GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
Else
GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
End If
Unload Me
End FunctionPrivate Sub cmdConnect_Click()
Dim myconn As ADODB.Connection
Set myconn = New ADODB.Connection
If optWinNTAuth.Value = True Then
myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
Else
myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
End If
myconn.ConnectionTimeout = 5
lblinfo.Caption = "正在测试连接......"
On Error GoTo CE
myconn.Open
lblinfo.Caption = "测试成功"
Me.Refresh
myconn.Close
If optWinNTAuth.Value = True Then
SaveSetting "appME", "s", "nt", 1
Else
SaveSetting "appME", "s", "nt", 0
End If
SaveSetting "appME", "s", "server", Server
SaveSetting "appME", "s", "user", user
SaveSetting "appME", "s", "password", pass
Me.Hide
Exit Sub
CE:
MsgBox Err.Description, vbExclamation, "连接错误"
lblinfo.Caption = "请重新填写."
End SubPrivate Sub cmdDisconnect_Click()
Unload Me
End
End SubPrivate Sub Form_Load()
optWinNTAuth.Value = True
End SubPrivate Sub optSSAuth_Click()
If optWinNTAuth.Value = True Then
user.Enabled = False
pass.Enabled = False
lblUserName.Enabled = False
lblPassword.Enabled = False
Else
user.Enabled = True
pass.Enabled = True
lblUserName.Enabled = True
lblPassword.Enabled = True
End If
End SubPrivate Sub optWinNTAuth_Click()
If optWinNTAuth.Value = True Then
user.Enabled = False
pass.Enabled = False
lblUserName.Enabled = False
lblPassword.Enabled = False
Else
user.Enabled = True
pass.Enabled = True
lblUserName.Enabled = True
lblPassword.Enabled = True
End If
End SubPrivate Sub pass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End SubPrivate Sub Server_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End SubPrivate Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{tab}"
End Sub
Option Explicit
Public Function GetConnectionString(Optional forceshow As Boolean = False) As String
Dim svr, usr, pas, nt As String
Dim l As Long
Dim myconn As ADODB.Connection
Set myconn = New ADODB.Connection
svr = GetSetting("appME", "s", "server", "")
If svr = "" Then GoTo ShowExit
nt = GetSetting("appME", "s", "nt", "")
usr = GetSetting("appME", "s", "user", "")
pas = GetSetting("appME", "s", "password", "")
If forceshow Then GoTo ShowExit
If CStr(nt) = "1" Then
myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + svr
Else
myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + usr + ";Password=" + pas + ";Initial Catalog=yygldb;Data Source=" + svr
End If
myconn.ConnectionTimeout = 5
On Error GoTo CE
myconn.Open
myconn.Close
Exit Function
CE:
MsgBox Err.Description, vbExclamation, "连接错误"
lblinfo.Caption = "请重新填写."
ShowExit:
Me.Server.Text = svr
If CStr(nt) = "1" Then
optWinNTAuth.Value = True
Else
optSSAuth.Value = True
Me.user.Text = usr
Me.pass.Text = pass
End If
Me.Show vbModal
If optWinNTAuth.Value = True Then
GetConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
Else
GetConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
End If
Unload Me
End FunctionPrivate Sub cmdConnect_Click()
Dim myconn As ADODB.Connection
Set myconn = New ADODB.Connection
If optWinNTAuth.Value = True Then
myconn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=yygldb;Data Source=" + Server
Else
myconn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" + user + ";Password=" + pass + ";Initial Catalog=yygldb;Data Source=" + Server
End If
myconn.ConnectionTimeout = 5
lblinfo.Caption = "正在测试连接......"
On Error GoTo CE
myconn.Open
lblinfo.Caption = "测试成功"
Me.Refresh
myconn.Close
If optWinNTAuth.Value = True Then
SaveSetting "appME", "s", "nt", 1
Else
SaveSetting "appME", "s", "nt", 0
End If
SaveSetting "appME", "s", "server", Server
SaveSetting "appME", "s", "user", user
SaveSetting "appME", "s", "password", pass
Me.Hide
Exit Sub
CE:
MsgBox Err.Description, vbExclamation, "连接错误"
lblinfo.Caption = "请重新填写."
End SubPrivate Sub cmdDisconnect_Click()
Unload Me
End
End SubPrivate Sub Form_Load()
optWinNTAuth.Value = True
End SubPrivate Sub optSSAuth_Click()
If optWinNTAuth.Value = True Then
user.Enabled = False
pass.Enabled = False
lblUserName.Enabled = False
lblPassword.Enabled = False
Else
user.Enabled = True
pass.Enabled = True
lblUserName.Enabled = True
lblPassword.Enabled = True
End If
End SubPrivate Sub optWinNTAuth_Click()
If optWinNTAuth.Value = True Then
user.Enabled = False
pass.Enabled = False
lblUserName.Enabled = False
lblPassword.Enabled = False
Else
user.Enabled = True
pass.Enabled = True
lblUserName.Enabled = True
lblPassword.Enabled = True
End If
End SubPrivate Sub pass_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End SubPrivate Sub Server_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
End If
End SubPrivate Sub user_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then SendKeys "{tab}"
End Sub
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货