遍好了后调试总“连接到数据库出错”,没弄清楚到底是哪里有问题,数据库是用ACCESS转换的SQL数据库,请大虾们多多指点。 VB代码如下:
Option Explicit
Private Sub Command1_Click() If ConenctToDatabase And VerifyUser Then On Error Resume Next If LoginStat = 0 Then Form2.Show DoEvents Unload Me ElseIf LoginStat = 1 Then Dim i As Long For i = Forms.Count - 1 To 0 Step -1 Unload Forms(i) Next i Form2.Show DoEvents End If LoginStat = 2 End If End Sub
Private Function ConenctToDatabase() As Boolean On Error GoTo ErrorHandler Dim DBName As String, ServerAdd As String, UserName As String, UserPwd As String ServerAdd = "192.168.0.1" DBName = "bbb" UserName = "sa" UserPwd = "" Set AdoCon = New ADODB.Connection AdoCon.ConnectionTimeout = 10 AdoCon.CursorLocation = adUseClient AdoCon.ConnectionString = "uid=" & UserName & ";pwd=" & UserPwd & _ ";driver={SQL Server};server=" & ServerAdd & _ ";database=" & DBName & ";dsn=''" AdoCon.Open ConenctToDatabase = True Exit Function ErrorHandler: MsgBox "连接到数据库出错", vbCritical, "出现错误" Exit Function End Function
Private Function VerifyUser() As Boolean On Error GoTo ErrorHandler Dim strSQL As String strSQL = "SELECT * FROM UserInfo WHERE UserName='" & Text(0) _ & "' AND UserPwd='" & Text(1) & "'" Set RsAdo = New ADODB.Recordset RsAdo.Open strSQL, AdoCon, adOpenStatic, adLockReadOnly If RsAdo.EOF Then MsgBox "用户名或密码错误,请重新输入!", vbCritical, "用户登录" Text(0).SetFocus Exit Function End If UserName = RsAdo("UserType") CloseRsAdo VerifyUser = True Exit Function ErrorHandler: MsgBox "验证用户信息出错", vbCritical, "出现错误" Exit Function End Function
Private Sub Form_Load() If App.PrevInstance Then End End Sub
Private Sub Form_Unload(Cancel As Integer) On Error Resume Next If Forms.Count = 1 Then If MsgBox("您确定要退出本系统吗?", vbInformation + vbYesNo, "退出系统") = vbYes Then AdoCon.Close End Else: Cancel = 1 End If End If End Sub
Private Sub text_GotFocus(Index As Integer) Text(Index).SelStart = 0 Text(Index).SelLength = Len(Text(Index)) End Sub
Private Sub Command2_Click() Unload Me End Sub