实例介绍
【实例简介】
【实例截图】
【核心代码】
VERSION 5.00
Begin VB.Form FrmLogin
BorderStyle = 1 'Fixed Single
Caption = "管理员登录"
ClientHeight = 8790
ClientLeft = 45
ClientTop = 375
ClientWidth = 12660
BeginProperty Font
Name = "微软雅黑"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "FrmLogin.frx":0000
LinkTopic = "FrmLogin"
MaxButton = 0 'False
ScaleHeight = 8790
ScaleWidth = 12660
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox SAVE
Height = 420
Left = 11640
TabIndex = 22
Top = 5760
Width = 1575
End
Begin VB.Frame Frame1
BorderStyle = 0 'None
Height = 4695
Left = 5400
TabIndex = 2
Top = 1440
Visible = 0 'False
Width = 5535
Begin VB.CommandButton CmdOK
Caption = "确定"
Height = 375
Left = 3000
TabIndex = 9
Top = 3000
Width = 1095
End
Begin VB.TextBox Textmm
Height = 420
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 5
Top = 2280
Width = 2535
End
Begin VB.TextBox Textmima
Height = 420
IMEMode = 3 'DISABLE
Left = 1680
PasswordChar = "*"
TabIndex = 4
Top = 1680
Width = 2535
End
Begin VB.TextBox Textyongfu
Height = 420
Left = 1680
MaxLength = 8
TabIndex = 3
Top = 1035
Width = 2535
End
Begin VB.Label Label10
BackStyle = 0 'Transparent
Caption = "请设定管理员账号与密码："
BeginProperty Font
Name = "微软雅黑"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 600
TabIndex = 17
Top = 480
Width = 3615
End
Begin VB.Label Label9
BackStyle = 0 'Transparent
Caption = "欢迎使用孟坤校园铃声系统！"
BeginProperty Font
Name = "微软雅黑"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 16
Top = 120
Width = 4575
End
Begin VB.Label Label6
BackStyle = 0 'Transparent
BeginProperty Font
Name = "微软雅黑"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 255
Left = 360
TabIndex = 12
Top = 2760
Width = 4335
End
Begin VB.Label Label5
BackStyle = 0 'Transparent
BeginProperty Font
Name = "微软雅黑"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 4320
TabIndex = 11
ToolTipText = "密码强度"
Top = 1800
Width = 300
End
Begin VB.Label LabNone
BackStyle = 0 'Transparent
Caption = "不设定管理员，直接登录"
BeginProperty Font
Name = "微软雅黑"
Size = 9
Charset = 134
Weight = 400
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 360
MouseIcon = "FrmLogin.frx":1A3A2
MousePointer = 99 'Custom
TabIndex = 10
Top = 3120
Width = 2175
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "密码确认："
Height = 495
Left = 360
TabIndex = 8
Top = 2280
Width = 1335
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "管理员密码："
Height = 495
Left = 240
TabIndex = 7
Top = 1680
Width = 1455
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "管理员账号："
Height = 495
Left = 240
TabIndex = 6
Top = 1080
Width = 1335
End
Begin VB.Image Image2
Height = 4665
Left = -120
Picture = "FrmLogin.frx":1A4F4
Stretch = -1 'True
Top = -240
Width = 5385
End
End
Begin VB.Timer Timer1
Interval = 1000
Left = 7080
Top = 1800
End
Begin VB.CheckBox CheckRem
Caption = "记住密码"
Height = 300
Left = 1320
TabIndex = 19
TabStop = 0 'False
Top = 2280
Width = 1215
End
Begin VB.TextBox TxtPass
Height = 420
IMEMode = 3 'DISABLE
Left = 1320
PasswordChar = "*"
TabIndex = 1
Top = 1560
Width = 2415
End
Begin VB.ComboBox Combo1
Height = 420
Left = 1320
TabIndex = 0
Top = 960
Width = 2415
End
Begin VB.CommandButton CmdLogin
Caption = "登录"
Height = 375
Left = 2760
TabIndex = 15
Top = 2280
Width = 975
End
Begin VB.Label LabTitle
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "孟坤智能校园铃声系统-登录"
BeginProperty Font
Name = "微软雅黑"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 855
Left = 0
TabIndex = 21
Top = 240
Width = 4875
End
Begin VB.Label Label8
BackStyle = 0 'Transparent
Caption = "密码："
ForeColor = &H00000000&
Height = 495
Left = 600
TabIndex = 14
Top = 1560
Width = 975
End
Begin VB.Label Label7
BackStyle = 0 'Transparent
Caption = "账号："
ForeColor = &H00000000&
Height = 495
Left = 600
TabIndex = 13
Top = 960
Width = 735
End
Begin VB.Label Label11
Alignment = 2 'Center
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 375
Left = 0
TabIndex = 18
Top = 1920
Width = 5055
End
Begin VB.Label LabTime
BackStyle = 0 'Transparent
BeginProperty Font
Name = "微软雅黑"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 600
TabIndex = 20
ToolTipText = "系统时间"
Top = 2880
Width = 5175
End
Begin VB.Image Image1
Height = 4935
Left = 0
Stretch = -1 'True
Top = 0
Width = 5655
End
End
Attribute VB_Name = "FrmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim UserName As String
Dim UserPassword As String
Dim PasswordRem As String
Private Sub CmdOK_Click()
Dim success As Long
Dim cipher_text As String '实行加密
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer '实行加密
If Textyongfu.Text = "" Then
Label6.Caption = "提示：请设定用户名！"
Textyongfu.SetFocus
Exit Sub
End If
If Textmima.Text = "" Then
Label6.Caption = "提示:你还没有设定密码！"
Textmima.SetFocus
Exit Sub
End If
If Textmima.Text <> Textmm.Text Then
Label6.Caption = "提示：两次输入的密码不一致！"
Textmima.SetFocus
Exit Sub
End If
offset = NumericPassword(741104) '实行加密
Rnd -1
Randomize offset
str_len = Len(Textmima.Text)
For i = 1 To str_len
ch = Asc(Mid$(Textmima.Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC 1) * Rnd)
ch = ((ch offset) Mod NUM_ASC)
ch = ch MIN_ASC
cipher_text = cipher_text & Chr$(ch)
End If
Next i '实行加密
success = WritePrivateProfileString("登录信息", "用户名", Textyongfu.Text, App.Path & "\数据\密文\数据.ini")
success = WritePrivateProfileString("登录信息", "密码", cipher_text, App.Path & "\数据\密文\数据.ini")
UserName = Textyongfu.Text
UserPassword = cipher_text
TxtPass.Text = ""
Combo1.Text = UserName
Frame1.Visible = False
MsgBox "您需要重新登录！"
End Sub
Private Sub CmdLogin_Click()
On Error Resume Next
Dim success As Long
Dim plain_text As String '解密
Dim cipher_text As String '实行加密
Const MIN_ASC = 32
Const MAX_ASC = 126
Const NUM_ASC = MAX_ASC - MIN_ASC 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
Dim ret As Long
If Combo1.Text = "" Then
Label11.Caption = "帐户不能为空,请核对帐户信息！"
Combo1.SetFocus
Exit Sub
End If
If TxtPass.Text = "" Then
Label11.Caption = "密码不能为空,请核对帐户信息！"
TxtPass.SetFocus
Exit Sub
End If
If CheckRem.value = 1 Then
offset = NumericPassword(53110) '实行加密
Rnd -1
Randomize offset
str_len = Len(TxtPass.Text)
For i = 1 To str_len
ch = Asc(Mid$(TxtPass.Text, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC 1) * Rnd)
ch = ((ch offset) Mod NUM_ASC)
ch = ch MIN_ASC
cipher_text = cipher_text & Chr$(ch)
End If
Next i '实行加密
success = WritePrivateProfileString("登录信息", "记住密码", cipher_text, App.Path & "\数据\密文\数据.ini")
Else
success = WritePrivateProfileString("登录信息", "记住密码", "0", App.Path & "\数据\密文\数据.ini")
End If
offset = NumericPassword(741104) '密文密码
Rnd -1
Randomize offset
str_len = Len(UserPassword)
For i = 1 To str_len
ch = Asc(Mid$(UserPassword, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch NUM_ASC
ch = ch MIN_ASC
plain_text = plain_text & Chr$(ch)
End If
Next i '解密
SAVE.Text = UserName
If Combo1.Text <> SAVE.Text Then '登录失败
Label11.Caption = "对不起，无此用户或者密码不正确,请重新输入！"
TxtPass.Text = ""
Combo1.SetFocus
Exit Sub
End If
SAVE.Text = plain_text
If TxtPass.Text <> SAVE.Text Then
Label11.Caption = "对不起，无此用户或者密码不正确,请重新输入！"
TxtPass.Text = ""
Combo1.SetFocus
Exit Sub
End If
IsLogin = "1"
FrmMain.锁定系统.Enabled = True
Call ShowTip("尊敬的管理员" & UserName, "您已成功登录校园铃声系统!", 4)
Unload Me
End Sub
Private Sub Form_Activate()
If Combo1.Text <> "" Then
If CheckRem.value = 0 Then
TxtPass.SetFocus
Else
End If
End If
If Frame1.Visible = True Then
Textyongfu.SetFocus
End If
End Sub
Private Sub Form_Load()
On Error Resume Next
MsgBox "您需要登陆才能执行该操作！"
Dim success As Long
Dim plain_text As String '解密
Const MIN_ASC = 32
Const MAX_ASC = 126
Const NUM_ASC = MAX_ASC - MIN_ASC 1
Dim offset As Long
Dim str_len As Integer
Dim i As Integer
Dim ch As Integer
Dim ret As Long
Dim buff As String
Me.Height = 4110
Me.Width = 4875
LabTime.Caption = "现在是:" Format(Date, "yyyy年mm月dd日") " " WeekdayName(Weekday(Now)) " " Format(Time, "hh:mm:ss")
Frame1.Visible = False
If Dir(App.Path & "\数据\校园信息\登录.BMP", vbNormal) <> "" Then '加载界面图
Image1.Picture = LoadPicture(App.Path & "\数据\校园信息\登录.BMP")
End If
If Dir(App.Path & "\数据\密文\数据.ini", vbNormal) <> "" Then
buff = String(255, 0) '记住密码的处理
ret = GetPrivateProfileString("登录信息", "记住密码", "0", buff, 256, App.Path & "\数据\密文\数据.ini")
PasswordRem = buff
If Val(PasswordRem) = 0 Then
CheckRem.value = 0
Else
CheckRem.value = 1
offset = NumericPassword(53110)
Rnd -1
Randomize offset
str_len = Len(PasswordRem)
For i = 1 To str_len
ch = Asc(Mid$(PasswordRem, i, 1))
If ch >= MIN_ASC And ch <= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch < 0 Then ch = ch NUM_ASC
ch = ch MIN_ASC
plain_text = plain_text & Chr$(ch)
End If
Next i
TxtPass = plain_text
End If
buff = String(255, 0)
ret = GetPrivateProfileString("登录信息", "用户名", "", buff, 256, App.Path & "\数据\密文\数据.ini")
UserName = buff
Combo1.Text = UserName
buff = String(255, 0)
ret = GetPrivateProfileString("登录信息", "密码", "", buff, 256, App.Path & "\数据\密文\数据.ini")
UserPassword = buff
Else '如果初次使用
Frame1.Visible = True
Frame1.Left = -50
Frame1.Top = -85
End If
buff = String(255, 0)
ret = GetPrivateProfileString("学校信息", "登录文字", "孟坤智能校园铃声系统-登录", buff, 256, App.Path & "\数据\校园信息\数据.ini")
LabTitle.Caption = buff
Me.Caption = LabTitle.Caption
End Sub
Private Sub Form_Resize() '自动调节大小
Image1.Width = Me.Width
Image1.Height = Me.Height
End Sub
Private Sub LabNone_Click() '不设定管理员
Dim success As Long
If MsgBox("如果您不设置管理员密码，别人将可以轻而易举的修改铃声信息，并造成很多麻烦，是否继续？", 289, "提示") = vbCancel Then
Exit Sub
Else
success = WritePrivateProfileString("登录信息", "密码", "0", App.Path & "\数据\密文\数据.ini")
success = WritePrivateProfileString("登录信息", "用户名", "", App.Path & "\数据\密文\数据.ini")
FrmMain.锁定系统.Enabled = False
IsLogin = "2"
FrmMain.Show
Unload Me
End If
End Sub
Private Sub LabTime_Click()
'MsgBox plain_text
End Sub
Private Sub Textmima_Change()
Dim LenStr As String
Dim i As Long
Dim m As Integer
Dim t As Integer
Dim PassStr As String
If Textyongfu.Text = "" Then
Label6.Caption = "提示：请设定用户名！"
End If
PassStr = Textmima.Text '密码强度检测
LenStr = PassStr
For i = 1 To Len(LenStr) '判断是否包函字母
m = Asc(Mid$(PassStr, i, 1))
If (m >= 65 And m <= 90) Or (m >= 97 And m <= 122) Then
t = t 1 '强度加1
Exit For
End If
Next
For i = 1 To Len(LenStr) '判断是否包函数字
m = Asc(Mid$(PassStr, i, 1))
If m >= 48 And m <= 57 Then t = t 1: Exit For '强度加1
Next
For i = 1 To Len(LenStr) '判断是否包函特殊字符
m = Asc(Mid$(PassStr, i, 1))
If (m >= 32 And m <= 47) Or (m >= 58 And m <= 64) Then t = t 1: Exit For '强度加1
Next
If Len(LenStr) < 6 Then '密码长度小于6,弱
t = 1
ElseIf Len(LenStr) >= 10 And Len(LenStr) <= 15 Then '密码长度10~15,只包函一种字符,强度中
If t = 1 Then t = 2
ElseIf Len(LenStr) > 15 Then '密码长度大于15,强
t = 3
End If
Label5.BackStyle = 1
Select Case t
Case 1
Label5.BackColor = vbRed '红色
Label5.Caption = "弱"
Case 2
Label5.BackColor = vbYellow '黄色
Label5.Caption = "中"
Case 3
Label5.BackColor = vbGreen '绿色
Label5.Caption = "强"
End Select
End Sub
Private Sub Textmm_Change()
If Textmima.Text = "" Then
Label6.Caption = "提示:你还没有设定初始密码！"
Textmima.SetFocus
Exit Sub
End If
If Label5.Caption = "弱" Then
Label6.Caption = "提示：初始密码强度太低！"
Else
Label6.Caption = ""
End If
End Sub
Private Function NumericPassword(ByVal password As String) As Long '密码加密模块
Dim value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
str_len = Len(password)
For i = 1 To str_len ' Add the next letter.
ch = Asc(Mid$(password, i, 1))
value = value Xor (ch * 2 ^ shift1)
value = value Xor (ch * 2 ^ shift2) ' Change the shift offsets.
shift1 = (shift1 7) Mod 19
shift2 = (shift2 13) Mod 23
Next i
NumericPassword = value
End Function
Private Sub Timer1_Timer()
LabTime.Caption = "现在是:" Format(Date, "yyyy年mm月dd日") " " WeekdayName(Weekday(Now)) " " Format(Time, "hh:mm:ss")
End Sub
好例子网口号：伸出你的我的手 — 分享！
网友评论
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
支持(0) 盖楼(回复)