VERSION 5.00Begin 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 EndEndAttribute VB_Name = "FrmLogin"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalseOption ExplicitDim UserName As StringDim UserPassword As StringDim PasswordRem As StringPrivate Sub CmdOK_Click()Dim success As LongDim cipher_text As String '实行加密Const MIN_ASC = 32 ' Space.Const MAX_ASC = 126 ' ~.Const NUM_ASC = MAX_ASC - MIN_ASC 1Dim offset As LongDim str_len As IntegerDim i As IntegerDim ch As Integer '实行加密If Textyongfu.Text = "" Then Label6.Caption = "提示：请设定用户名！" Textyongfu.SetFocus Exit Sub End IfIf Textmima.Text = "" Then Label6.Caption = "提示:你还没有设定密码！" Textmima.SetFocus Exit Sub End IfIf 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.TextUserPassword = cipher_textTxtPass.Text = ""Combo1.Text = UserNameFrame1.Visible = FalseMsgBox "您需要重新登录！"End SubPrivate Sub CmdLogin_Click()On Error Resume NextDim success As LongDim plain_text As String '解密Dim cipher_text As String '实行加密Const MIN_ASC = 32Const MAX_ASC = 126Const NUM_ASC = MAX_ASC - MIN_ASC 1Dim offset As LongDim str_len As IntegerDim i As IntegerDim ch As IntegerDim ret As LongIf Combo1.Text = "" ThenLabel11.Caption = "帐户不能为空,请核对帐户信息！"Combo1.SetFocusExit SubEnd IfIf TxtPass.Text = "" ThenLabel11.Caption = "密码不能为空,请核对帐户信息！"TxtPass.SetFocusExit SubEnd IfIf 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")Elsesuccess = 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 = UserNameIf Combo1.Text <> SAVE.Text Then '登录失败 Label11.Caption = "对不起，无此用户或者密码不正确,请重新输入！" TxtPass.Text = "" Combo1.SetFocus Exit Sub End IfSAVE.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 MeEnd SubPrivate 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 IfEnd SubPrivate Sub Form_Load()On Error Resume NextMsgBox "您需要登陆才能执行该操作！"Dim success As LongDim plain_text As String '解密Const MIN_ASC = 32Const MAX_ASC = 126Const NUM_ASC = MAX_ASC - MIN_ASC 1Dim offset As LongDim str_len As IntegerDim i As IntegerDim ch As IntegerDim ret As LongDim buff As StringMe.Height = 4110Me.Width = 4875LabTime.Caption = "现在是:" Format(Date, "yyyy年mm月dd日") " " WeekdayName(Weekday(Now)) " " Format(Time, "hh:mm:ss")Frame1.Visible = FalseIf Dir(App.Path & "\数据\校园信息\登录.BMP", vbNormal) <> "" Then'加载界面图Image1.Picture = LoadPicture(App.Path & "\数据\校园信息\登录.BMP")End IfIf 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 = buffElse '如果初次使用Frame1.Visible = TrueFrame1.Left = -50Frame1.Top = -85End If buff = String(255, 0) ret = GetPrivateProfileString("学校信息", "登录文字", "孟坤智能校园铃声系统-登录", buff, 256, App.Path & "\数据\校园信息\数据.ini") LabTitle.Caption = buff Me.Caption = LabTitle.CaptionEnd SubPrivate Sub Form_Resize()'自动调节大小Image1.Width = Me.WidthImage1.Height = Me.HeightEnd SubPrivate Sub LabNone_Click() '不设定管理员Dim success As LongIf MsgBox("如果您不设置管理员密码，别人将可以轻而易举的修改铃声信息，并造成很多麻烦，是否继续？", 289, "提示") = vbCancel ThenExit SubElsesuccess = WritePrivateProfileString("登录信息", "密码", "0", App.Path & "\数据\密文\数据.ini")success = WritePrivateProfileString("登录信息", "用户名", "", App.Path & "\数据\密文\数据.ini")FrmMain.锁定系统.Enabled = FalseIsLogin = "2"FrmMain.ShowUnload MeEnd IfEnd SubPrivate Sub LabTime_Click()'MsgBox plain_textEnd SubPrivate 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 SelectEnd SubPrivate Sub Textmm_Change()If Textmima.Text = "" Then Label6.Caption = "提示:你还没有设定初始密码！" Textmima.SetFocus Exit SubEnd IfIf Label5.Caption = "弱" ThenLabel6.Caption = "提示：初始密码强度太低！"ElseLabel6.Caption = ""End IfEnd SubPrivate Function NumericPassword(ByVal password As String) As Long '密码加密模块Dim value As LongDim ch As LongDim shift1 As LongDim shift2 As LongDim i As IntegerDim 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 = valueEnd FunctionPrivate Sub Timer1_Timer()LabTime.Caption = "现在是:" Format(Date, "yyyy年mm月dd日") " " WeekdayName(Weekday(Now)) " " Format(Time, "hh:mm:ss")End Sub
评论