登陆框的代码问题清高手指教

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long

Public OK As Boolean
Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long

    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        txtUserName.Text = Left$(sBuffer, lSize)
    Else
        txtUserName.Text = vbNullString
    End If
End Sub

Private Sub Cmd_Cancel_Click()
    OK = False
    Me.Hide
End Sub

Private Sub Cmd_OK_Click()
    'ToDo: 创建测试密码是否正确
    '检查正确密码
    If txtPassword.Text = "" Then
        OK = True
        Me.Hide
    Else
        MsgBox "密码错误，再试一次！", , "登录"
        txtPassword.SetFocus
        txtPassword.SelStart = 0
        txtPassword.SelLength = Len(txtPassword.Text)
    End If
End Sub

Private Sub lblLabels_Click(Index As Integer)

End Sub

怎么提示有错误啊 --------------------编程问答-------------------- 测试过了,没问题

--------------------编程问答-------------------- 你到底是什么错误，在哪里出错了？ --------------------编程问答-------------------- 我做的那个登陆框  有个frame框架  怎么把那个框架删了就没有错误  还是要重新添加什么代码啊？？谢谢 --------------------编程问答-------------------- '返回的字符中会含有 chr(0) 而你并没有做处理
'你这个代码并没检测Password的正确性,总之你这个代码就是只为了得知系统用户名.
'得知系统用户名,就用 txtUserName.Text = Environ("username") '一行就可以啦

Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
Public OK As Boolean
Private Sub Form_Load()
   Dim sBuffer$
   sBuffer = String(255, Chr$(0))
   GetUserName sBuffer, 1024
   txtUserName.Text = sBuffer
   'txtUserName.Text = Environ("username") '一行就可以啦,何必用到GetUserName的API
End Sub

Private Sub Cmd_Cancel_Click()
   OK = False
   Me.Hide
End Sub

Private Sub Cmd_OK_Click()
   'ToDo: 创建测试密码是否正确
   '检查正确密码
   If txtPassword.Text = "" Then
       OK = True
       MsgBox "登录成功"
       Me.Hide
   Else
       MsgBox "密码错误，再试一次！", , "登录"
       txtPassword.SetFocus
       txtPassword.SelStart = 0
       txtPassword.SelLength = Len(txtPassword.Text)
   End If
End Sub

--------------------编程问答--------------------

登陆框如图 --------------------编程问答-------------------- '给你一段代码参考

'引用 Microsoft ActiveX Data Objects 2.5 Library(调用 Msado15.dll)
'添加 Text1  Text2   Command1
'在同路径app.path下放 cbm666.mdb 含cbmpass表,当然你必需改为你自己的数据库名与表名.

'**** 请注意!! 数据库:cbm666.mdb 表:cbmpass 要改为你自己的,并把它放在程序同路径下
'字段是 usernm 与 passw 与 level 都是字元型 (三个字段:用户名,密码,等级)

Option Explicit
Public conn As New ADODB.Connection '定义数据连接字符串
Public rs As New ADODB.Recordset '定义记录集
Dim i%, db$, errpass%, appdisk$, password$, levelb$
Dim finduser As Boolean

Private Sub Form_Load()
   appdisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
   db = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & appdisk & "cbm666.mdb"
   conn.CursorLocation = adUseClient
   conn.Open db '打开数据库连接
   rs.Open "cbmpass", conn, adOpenKeyset, adLockPessimistic '打开记录集
   Command1.Caption = "登录"
   Text1.Text = "": Text2.Text = "": Text2.PasswordChar = "*"
End Sub

Private Sub Form_Activate()
   Text1.SetFocus
End Sub

Private Sub Form_Unload(Cancel As Integer)
   rs.Close: conn.Close
   Set rs = Nothing: Set conn = Nothing: Set Form1 = Nothing
   End
End Sub

Private Sub Command1_Click()
   If SearchData(Text1.Text) Then
      MsgBox "登录成功! 您的等级是:" & rs.Fields("level"), vbOKOnly, "密码登录"
      Unload Me
   Else
      errpass = errpass + 1
      If errpass >= 3 Then
         MsgBox "对不起,您没有任何权限登录使用本系统", vbCritical, "密码登录"
         Unload Me
      Else
         MsgBox "用户名或密码错误,请重新输入", vbCritical, "密码登录"
         Text1.SetFocus
      End If
   End If
End Sub

Function SearchData(Schstr$) As Boolean
   SearchData = False
   rs.MoveFirst
   rs.Find "usernm = " & Chr(39) & Schstr & Chr(39)
   If Not rs.EOF Then SearchData = True
End Function

--------------------编程问答-------------------- 这样只要用户名正确就能进入了，searchdata()里面应该是Text2.txt

补充：VB ,  基础类

登陆框的代码问题 清高手指教

登陆框的代码问题清高手指教