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

[huq520]

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

怎么提示有错误啊

[huq520]

登陆框如图

[cbm6666]

'给你一段代码参考

'引用 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

[hupeng213]

测试过了,没问题

[junki]

你到底是什么错误，在哪里出错了？

[huq520]

我做的那个登陆框 有个frame框架 怎么把那个框架删了就没有错误 还是要重新添加什么代码啊 ？？谢谢

[cbm6666]

'返回的字符中会含有 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

[hudielxin]

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