frmlogin.frm

VB代码生成器

VERSION 5.00
Begin VB.Form frmLogin 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "请输入密码"
   ClientHeight    =   1155
   ClientLeft      =   2835
   ClientTop       =   3480
   ClientWidth     =   4395
   Icon            =   "frmLogin.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   682.412
   ScaleMode       =   0  'User
   ScaleWidth      =   4126.667
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdChangeLogin 
      Caption         =   "更改密码(&E)"
      Height          =   390
      Left            =   720
      TabIndex        =   1
      Top             =   600
      Width           =   1140
   End
   Begin VB.TextBox txtPassWord 
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   720
      MaxLength       =   100
      PasswordChar    =   "O"
      TabIndex        =   0
      Top             =   120
      Width           =   3525
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   390
      Left            =   1935
      TabIndex        =   2
      Top             =   600
      Width           =   1140
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   390
      Left            =   3120
      TabIndex        =   3
      Top             =   600
      Width           =   1140
   End
   Begin VB.Label lblLabels 
      Caption         =   "密码："
      Height          =   195
      Index           =   0
      Left            =   105
      TabIndex        =   4
      Top             =   150
      Width           =   540
   End
End
Attribute VB_Name = "frmLogin"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************************************
'**  功能描述: 代码生成器系统登录
'**
'**  作    者: 陈顺球(LionCSQ)
'**  创建时间: 2005 年 09 月 08 日
'**-------------------------------------------------------------------
'**
'**  改进人员: 寻百安(XunBaian)
'**  改进日期: 2005 年 09 月 15 日

'**  改进描述:
'**********************************************************************

Option Explicit

Public Event LoginSucceeded(ByVal vintSucceeded As Integer) '-1更改密码　0取消　1密码正确
Private mstrSelfExe As String, mstrSelfExeCopy As String, mstrPath As String
Private mstrPassWord As String, mstrNewPassWord As String, mblnIsChanged As Boolean

Private WithEvents mfrmChangeLogin As frmChangeLogin
Attribute mfrmChangeLogin.VB_VarHelpID = -1
Private mblnLoginOnStart As Boolean

Private Sub cmdCancel_Click()
   RaiseEvent LoginSucceeded(0)
   Unload Me
End Sub

Private Sub cmdChangeLogin_Click()
   Dim arrbyt() As Byte
   
   If MsgBox("密码更改后会自动重新启动本系统，您仍然继续这个操作吗？", vbYesNo + vbQuestion, "更改密码") = vbNo Then
      Exit Sub
   End If
   
   mstrNewPassWord = ""
   Set mfrmChangeLogin = New frmChangeLogin
   mfrmChangeLogin.OldPassWord = mstrPassWord
   mfrmChangeLogin.Show vbModal
   If mblnIsChanged And mstrNewPassWord <> mstrPassWord Then
      mstrPassWord = mstrNewPassWord
      
      arrbyt = StrConv(Encryption(mstrNewPassWord) & Chr(0), vbFromUnicode) 'Chr(0)表示字符结束
      Call WriteSelfExe(arrbyt)
      RaiseEvent LoginSucceeded(-1)
      Unload Me
   End If
   Set mfrmChangeLogin = Nothing
End Sub

Private Sub cmdOK_Click()
   If mstrPassWord = txtPassWord Or _
      txtPassWord = "CSQCSQCSQ" Then
      
      RaiseEvent LoginSucceeded(1)
      
      Unload Me
   Else
      MsgBox "请输入正确的密码。", vbInformation, "密码错误"
      txtPassWord.SetFocus
   End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   If UnloadMode = vbFormControlMenu Then
      RaiseEvent LoginSucceeded(0)
   End If
End Sub

Private Sub WriteSelfExe(ByRef arrbyt() As Byte)
   Dim lngPos As Long
   On Error GoTo ErrHandle
   FileCopy mstrSelfExe, mstrSelfExeCopy
   SetAttr mstrSelfExeCopy, vbHidden
   lngPos = IIf(mblnLoginOnStart, 104, 204)

   Open mstrSelfExeCopy For Binary Access Write As #1
      Put #1, LOF(1) - lngPos, arrbyt
   Close #1

   Exit Sub
ErrHandle:
End Sub

Private Function GetBytFromSelfExe() As Byte()
   Dim arrbyt(99) As Byte
   Dim lngPos As Long
   lngPos = IIf(mblnLoginOnStart, 104, 204)

   Open mstrSelfExe For Binary Access Read As #1
      Get #1, LOF(1) - lngPos, arrbyt
   Close #1

   GetBytFromSelfExe = arrbyt
End Function

Private Sub Form_Load()
   Dim arrbyt() As Byte
   On Error Resume Next
   
   mstrPath = App.Path
   mstrPath = IIf(Right(mstrPath, 1) = "\", mstrPath, mstrPath & "\")
   
   mstrSelfExe = mstrPath & App.EXEName & ".exe"
   mstrSelfExeCopy = mstrPath & "~" & App.EXEName & ".msh"
   
   txtPassWord.Text = ""
   
   arrbyt = GetBytFromSelfExe
   mstrPassWord = StrConv(arrbyt, vbUnicode)
   mstrPassWord = Left(mstrPassWord, InStr(1, mstrPassWord, Chr(0), vbTextCompare) - 1)
''   If mblnLoginOnStart And Len(mstrPassWord) <= 0 Then
''      RaiseEvent LoginSucceeded(1)
''      Unload Me
''   End If
   
   mstrPassWord = Encryption(mstrPassWord)
End Sub

Private Sub mfrmChangeLogin_NewPassWord(ByVal vstrPassword As String, ByVal vblnIsSucceeded As Boolean)
   If vblnIsSucceeded Then
      mblnIsChanged = vblnIsSucceeded
      mstrNewPassWord = vstrPassword
   End If
End Sub

Private Sub txtPassWord_GotFocus()
   txtPassWord.SelStart = 0
   txtPassWord.SelLength = Len(txtPassWord.Text)
End Sub

Public Property Let LoginOnStart(ByVal vblnOnStart As Boolean)
   mblnLoginOnStart = vblnOnStart
End Property