www.pudn.com > DataCollectionSystem.rar > frmUserID.frm, change:2003-09-12,size:21838b


VERSION 5.00 
Begin VB.Form frmUserID  
   BorderStyle     =   3  'Fixed Dialog 
   Caption         =   "用户密码设置" 
   ClientHeight    =   4230 
   ClientLeft      =   45 
   ClientTop       =   330 
   ClientWidth     =   7950 
   ControlBox      =   0   'False 
   BeginProperty Font  
      Name            =   "Verdana" 
      Size            =   8.25 
      Charset         =   0 
      Weight          =   400 
      Underline       =   0   'False 
      Italic          =   0   'False 
      Strikethrough   =   0   'False 
   EndProperty 
   LinkTopic       =   "Form1" 
   MaxButton       =   0   'False 
   MinButton       =   0   'False 
   ScaleHeight     =   4230 
   ScaleWidth      =   7950 
   ShowInTaskbar   =   0   'False 
   StartUpPosition =   2  'CenterScreen 
   Begin VB.Frame frameDelete  
      Caption         =   "删除用户" 
      Height          =   1575 
      Left            =   5040 
      TabIndex        =   11 
      Top             =   0 
      Width           =   2775 
      Begin VB.CommandButton cmdDeleteUserID  
         Caption         =   "删除用户" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   375 
         Left            =   720 
         TabIndex        =   13 
         Top             =   1080 
         Width           =   1815 
      End 
      Begin VB.Image imgDeleteUserID  
         Height          =   465 
         Left            =   120 
         Picture         =   "frmUserID.frx":0000 
         Stretch         =   -1  'True 
         Top             =   480 
         Width           =   450 
      End 
      Begin VB.Label imgDeleteUserIDCap  
         Caption         =   "你可以单击下面的按钮来删除这个用户." 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   375 
         Left            =   720 
         TabIndex        =   12 
         Top             =   480 
         Width           =   1935 
      End 
   End 
   Begin VB.CommandButton cmdCancel  
      Caption         =   "取消(&C)" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   5040 
      TabIndex        =   10 
      Top             =   3720 
      Width           =   1335 
   End 
   Begin VB.CommandButton cmdOK  
      Caption         =   "确定(&O)" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   375 
      Left            =   6480 
      TabIndex        =   9 
      Top             =   3720 
      Width           =   1335 
   End 
   Begin VB.Frame frameLogin  
      Caption         =   "登录信息" 
      BeginProperty Font  
         Name            =   "宋体" 
         Size            =   9 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Height          =   4095 
      Left            =   120 
      TabIndex        =   0 
      Top             =   0 
      Width           =   4695 
      Begin VB.CheckBox chkRemove  
         Caption         =   "删除记录时要求确认" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   255 
         Left            =   1920 
         TabIndex        =   16 
         Top             =   3720 
         Width           =   2055 
      End 
      Begin VB.CheckBox chkPassword  
         Caption         =   "不显示密码框" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   255 
         Left            =   1920 
         TabIndex        =   15 
         Top             =   3360 
         Width           =   1455 
      End 
      Begin VB.CheckBox chkDisplay  
         Caption         =   "在登录列表框中显示这个用户" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   255 
         Left            =   1920 
         TabIndex        =   8 
         Top             =   3000 
         Width           =   2655 
      End 
      Begin VB.TextBox txtMasterPassword2  
         Height          =   285 
         IMEMode         =   3  'DISABLE 
         Left            =   1920 
         PasswordChar    =   "*" 
         TabIndex        =   6 
         Top             =   2040 
         Width           =   2535 
      End 
      Begin VB.TextBox txtMasterPassword1  
         Height          =   285 
         IMEMode         =   3  'DISABLE 
         Left            =   1920 
         PasswordChar    =   "*" 
         TabIndex        =   5 
         Top             =   1560 
         Width           =   2535 
      End 
      Begin VB.TextBox txtUserID  
         Height          =   285 
         Left            =   1920 
         TabIndex        =   4 
         Top             =   1080 
         Width           =   2535 
      End 
      Begin VB.Label lblOptionsCap  
         AutoSize        =   -1  'True 
         Caption         =   "选项:" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   700 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00800000& 
         Height          =   180 
         Left            =   240 
         TabIndex        =   17 
         Top             =   3000 
         Width           =   495 
      End 
      Begin VB.Label lblLogInCap  
         AutoSize        =   -1  'True 
         Caption         =   "除了用户名,下面所有的值都是大小写敏感的。" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   180 
         Left            =   840 
         TabIndex        =   14 
         Top             =   480 
         Width           =   3780 
      End 
      Begin VB.Image imgLoginInformation  
         Height          =   480 
         Left            =   240 
         Picture         =   "frmUserID.frx":0C4A 
         Top             =   480 
         Width           =   435 
      End 
      Begin VB.Image imgQnA  
         Height          =   450 
         Left            =   120 
         Picture         =   "frmUserID.frx":1814 
         Stretch         =   -1  'True 
         Top             =   2520 
         Width           =   570 
      End 
      Begin VB.Label lblQnACap  
         Caption         =   "通过设置下面的选项,可以按照用户的想法进行定制。" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   400 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         Height          =   375 
         Left            =   840 
         TabIndex        =   7 
         Top             =   2520 
         Width           =   3735 
      End 
      Begin VB.Label lblMasterPassword2Cap  
         AutoSize        =   -1  'True 
         Caption         =   "密码确认:" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   700 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00800000& 
         Height          =   180 
         Left            =   240 
         TabIndex        =   3 
         Top             =   1995 
         Width           =   885 
      End 
      Begin VB.Label lblMasterPassword1Cap  
         AutoSize        =   -1  'True 
         Caption         =   "密码:" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   700 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00800000& 
         Height          =   180 
         Left            =   240 
         TabIndex        =   2 
         Top             =   1485 
         Width           =   495 
      End 
      Begin VB.Label lblUserIDCap  
         AutoSize        =   -1  'True 
         Caption         =   "用户名:" 
         BeginProperty Font  
            Name            =   "宋体" 
            Size            =   9 
            Charset         =   0 
            Weight          =   700 
            Underline       =   0   'False 
            Italic          =   0   'False 
            Strikethrough   =   0   'False 
         EndProperty 
         ForeColor       =   &H00800000& 
         Height          =   180 
         Left            =   240 
         TabIndex        =   1 
         Top             =   1080 
         Width           =   690 
      End 
   End 
End 
Attribute VB_Name = "frmUserID" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
 
Public Sub chkLog_Click() 
If chkLog.Value = 0 Then 
    chkLogAll.Enabled = False 
    chkEncrypt.Enabled = False 
    txtLogFile.Enabled = False 
    txtLogFile.BackColor = NoActive 
    cmdViewLog.Enabled = False 
 
ElseIf chkLog.Value = 1 Then 
    chkLogAll.Enabled = True 
    chkEncrypt.Enabled = True 
    txtLogFile.Enabled = True 
    txtLogFile.BackColor = Active 
    cmdViewLog.Enabled = True 
 
End If 
 
End Sub 
 
Private Sub cmdCancel_Click() 
     
    Screen.MousePointer = 11 
    If cmdOk.Caption = "创建" Then 
        txtUserID.Text = "" 
     
    ElseIf cmdOk.Caption = "确定" Then 
        Dim OptionStringC As String 
        txtMasterPassword1.Text = MasterPassword 
        txtMasterPassword2.Text = MasterPassword 
'        txtQuestion.Text = decrypt(GetSetting(MainTitle, UserRegSection, txtQuestion.Tag), Key1 & Mid$(txtQuestion.Tag, 3, 1) & Mid$(txtQuestion.Tag, 5, 1)) 
'        txtAnswer.Text = decrypt(GetSetting(MainTitle, UserRegSection, txtAnswer.Tag), Key1 & Mid$(txtAnswer.Tag, 3, 1) & Mid$(txtAnswer.Tag, 5, 1)) 
'        OptionStringC = decrypt(GetSetting(MainTitle, UserRegSection, frameLog.Tag), Key1 & Mid$(frameLog.Tag, 3, 1) & Mid$(frameLog.Tag, 5, 1)) 
        chkDisplay.Value = Left$(OptionStringC, 1) 
        chkPassword.Value = Mid$(OptionStringC, 2, 1) 
        chkRemove.Value = Mid$(OptionStringC, 3, 1) 
        chkLog.Value = Mid$(OptionStringC, 4, 1) 
        chkLogAll.Value = Mid$(OptionStringC, 5, 1) 
        chkEncrypt.Value = Mid$(OptionStringC, 6, 1) 
        If Len(OptionString) > 6 Then txtLogFile.Text = Mid$(OptionString, 7) 
        chkLog_Click 
    End If 
    Screen.MousePointer = 0 
    frmUserID.Hide 
     
End Sub 
 
Private Sub cmdDeleteUserID_Click() 
     
    Title = "删除这个用户" 
    Msg = "警告: 你正准备删除用户" & UserID & ". " & Chr$(13) & Chr$(10) 
    Msg = Msg & "删除这个用户将删除这个用户的所有数据." & Chr$(13) & Chr$(10) 
    Msg = Msg & "你确定删除这个用户吗?" 
    DgDef = MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 
 
    Response = MsgBox(Msg, DgDef, Title) 
    If Response = IDYES Then 
        GoTo DelUserID 
    Else 
        Exit Sub 
    End If 
     
DelUserID: 
    tmpString2 = "" 
    For currentChr = 1 To Len(Index) Step 6 
        tmpString = Mid$(Index, currentChr, 6) 
        If tmpString = UserRegSection Then GoTo DontAdd2Index 
        tmpString2 = tmpString2 & tmpString 
DontAdd2Index: 
    Next 
 
    If Len(tmpString2) = 0 Then Index = "/NEWRUN/" Else Index = tmpString2 
    SaveSetting MainTitle, "Settings", "Index", crypt(Index, Key1 & Key2) 
    DeleteSetting MainTitle, UserRegSection 
    Unload frmMain 
    txtUserID.Text = "" 
    frmUserID.Hide 
         
End Sub 
 
Private Sub cmdOK_Click() 
 
    If cmdOk.Caption = "创建" Then 
        If Len(Trim(txtUserID.Text)) = 0 Then 
            MsgBox "请输入一个用户名!", 48, "非法的用户名" 
            txtUserID.SetFocus 
            Exit Sub 
        End If 
         
        If Index = "/NEWRUN/" Then GoTo NoUserIDCheck 
        tmpString = IsValidUserID(Trim(LCase$(txtUserID.Text))) 
        If Not tmpString = "" Then 
            MsgBox "你选择的用户名已经存在. 请选择另外一个.", 48, "非法的用户名" 
            txtUserID.SelStart = 0 
            txtUserID.SelLength = Len(txtUserID.Text) 
            txtUserID.SetFocus 
            Exit Sub 
        End If 
NoUserIDCheck: 
    End If 
     
        If Len(Trim(txtMasterPassword1.Text)) = 0 Then 
            MsgBox "请输入一个口令以便保护你的数据.", 48, MainTitle 
            txtMasterPassword1.SelStart = 0 
            txtMasterPassword1.SelLength = Len(txtMasterPassword1.Text) 
            txtMasterPassword1.SetFocus 
            Exit Sub 
        End If 
         
        If Not Trim(txtMasterPassword1.Text) = Trim(txtMasterPassword2.Text) Then 
            MsgBox "Please make sure that you've confirmed your Master Password correctly!", 48, "Master Password NOT confirmed" 
            txtMasterPassword2.SelStart = 0 
            txtMasterPassword2.SelLength = Len(txtMasterPassword2.Text) 
            txtMasterPassword2.SetFocus 
            Exit Sub 
        End If 
         
        If Len(Trim(txtMasterPassword1.Text)) < 6 Then 
            MsgBox "Master Password should consist of 6 characters at least.", 48, "Invalid Master Password" 
            txtMasterPassword1.SelStart = 0 
            txtMasterPassword1.SelLength = Len(txtMasterPassword1.Text) 
            txtMasterPassword1.SetFocus 
            Exit Sub 
        End If 
         
        If Len(Trim(txtQuestion.Text)) = 0 Then 
            MsgBox "Incomplete information.", 48, MainTitle 
            txtQuestion.SelStart = 0 
            txtQuestion.SelLength = Len(txtQuestion.Text) 
            txtQuestion.SetFocus 
            Exit Sub 
        End If 
         
        If Len(Trim(txtAnswer.Text)) = 0 Then 
            MsgBox "Incomplete information.", 48, MainTitle 
            txtAnswer.SelStart = 0 
            txtAnswer.SelLength = Len(txtAnswer.Text) 
            txtAnswer.SetFocus 
            Exit Sub ' 
        End If 
         
        If Len(Trim(txtLogFile.Text)) = 0 And chkLog.Value = 1 Then 
            MsgBox "Please enter the path of your Log File." & Chr$(13) & Chr$(10) & "For example c:\logfile.txt", 48, "Access Loging" 
            txtLogFile.SetFocus 
            Exit Sub 
        End If 
         
        Screen.MousePointer = 11 
        Dim OptionsString As String 
        If cmdOk.Caption = "&Create" Then 
             
            UserID = Trim(LCase$(txtUserID.Text))       ' User ID is Not case sensitive 
            MasterPassword = Trim(txtMasterPassword1.Text) 
            txtUserID.Text = UserID 
            txtMasterPassword1.Text = MasterPassword 
            txtMasterPassword2.Text = MasterPassword 
            txtQuestion.Text = Trim(txtQuestion.Text) 
            txtAnswer.Text = Trim(txtAnswer.Text) 
            txtLogFile.Text = Trim(txtLogFile.Text) 
             
            OptionsString = chkDisplay.Value & chkPassword.Value & chkRemove.Value & chkLog.Value & chkLogAll.Value & chkEncrypt.Value & txtLogFile.Text 
            UserIndex = txtUserID.Tag & txtMasterPassword1.Tag & frameLog.Tag & txtQuestion.Tag & txtAnswer.Tag 
            UserKeyword = Left$(UserID, 1) & Mid$(UserRegSection, 5, 2) & MasterPassword 
            UserIDKeyword = Left$(UserRegSection, 2) & Right$(txtUserID.Tag, 2) & Key1 
            MasterPasswordKeyword = Mid$(UserRegSection, 3, 1) & Left$(UserID, 1) & Left$(MasterPassword, Len(MasterPassword) - 5) & Right$(MasterPassword, 1) & Right$(txtMasterPassword1.Tag, 1) & Right$(UserID, 1) 
            ItemIndex = "" 
            ItemCount = 0 
             
            ' Save in Registry 
            SaveSetting MainTitle, UserRegSection, txtUserID.Tag, crypt(UserID, UserIDKeyword) 
            SaveSetting MainTitle, UserRegSection, txtMasterPassword1.Tag, crypt(MasterPassword, MasterPasswordKeyword) 
            SaveSetting MainTitle, UserRegSection, txtQuestion.Tag, crypt(txtQuestion.Text, Key1 & Mid$(txtQuestion.Tag, 3, 1) & Mid$(txtQuestion.Tag, 5, 1)) 
            SaveSetting MainTitle, UserRegSection, txtAnswer.Tag, crypt(txtAnswer.Text, Key1 & Mid$(txtAnswer.Tag, 3, 1) & Mid$(txtAnswer.Tag, 5, 1)) 
            SaveSetting MainTitle, UserRegSection, frameLog.Tag, crypt(OptionsString, Key1 & Mid$(frameLog.Tag, 3, 1) & Mid$(frameLog.Tag, 5, 1)) 
            SaveSetting MainTitle, UserRegSection, "Index", crypt(UserIndex, Key2 & UserRegSection) 
            SaveSetting MainTitle, UserRegSection, "Item", "" 
             
            If Index = "/NEWRUN/" Then Index = UserRegSection Else Index = Index & UserRegSection 
            SaveSetting MainTitle, "Settings", "Index", crypt(Index, Key1 & Key2) 
            Screen.MousePointer = 0 
            MsgBox "The User ID " & UserID & " was successfuly registered.", 64, MainTitle 
             
             
        ElseIf cmdOk.Caption = "&Okay" Then 
             
            txtQuestion.Text = Trim(txtQuestion.Text) 
            txtAnswer.Text = Trim(txtAnswer.Text) 
            txtLogFile.Text = Trim(txtLogFile.Text) 
            OptionsString = chkDisplay.Value & chkPassword.Value & chkRemove.Value & chkLog.Value & chkLogAll.Value & chkEncrypt.Value & txtLogFile.Text 
            SaveSetting MainTitle, UserRegSection, txtQuestion.Tag, crypt(txtQuestion.Text, Key1 & Mid$(txtQuestion.Tag, 3, 1) & Mid$(txtQuestion.Tag, 5, 1)) 
            SaveSetting MainTitle, UserRegSection, txtAnswer.Tag, crypt(txtAnswer.Text, Key1 & Mid$(txtAnswer.Tag, 3, 1) & Mid$(txtAnswer.Tag, 5, 1)) 
            SaveSetting MainTitle, UserRegSection, frameLog.Tag, crypt(OptionsString, Key1 & Mid$(frameLog.Tag, 3, 1) & Mid$(frameLog.Tag, 5, 1)) 
               
            If Not Trim(txtMasterPassword1.Text) = MasterPassword Then 
                ' User changed the Master Password; all the stored data should be decrypted and 
                ' encrypted again with the new UserKeyword! 
                Dim oldUserKeyword As String 
                Dim sKey As String 
                Dim curConverKey As Long 
                 
                oldUserKeyword = UserKeyword 
                MasterPassword = Trim(txtMasterPassword1.Text) 
                UserKeyword = Left$(UserID, 1) & Mid$(UserRegSection, 5, 2) & MasterPassword 
                MasterPasswordKeyword = Mid$(UserRegSection, 3, 1) & Left$(UserID, 1) & Left$(MasterPassword, Len(MasterPassword) - 5) & Right$(MasterPassword, 1) & Right$(txtMasterPassword1.Tag, 1) & Right$(UserID, 1) 
                 
                For curConverKey = 1 To Len(ItemIndex) Step 8 
                    sKey = Mid$(ItemIndex, curConverKey, 8) 
                    'regString = decrypt(GetSetting(MainTitle, UserRegSection, sKey), oldUserKeyword & Mid$(sKey, 3, 1) & Mid$(sKey, 5, 1)) 
                    SaveSetting MainTitle, UserRegSection, Mid$(ItemIndex, curConverKey, 8), crypt(regString, UserKeyword & Mid$(sKey, 3, 1) & Mid$(sKey, 5, 1)) 
                Next 
                SaveSetting MainTitle, UserRegSection, "Item", crypt(ItemIndex, UserKeyword) 
                SaveSetting MainTitle, UserRegSection, Mid$(UserIndex, 9, 8), crypt(MasterPassword, MasterPasswordKeyword) 
                 
            End If 
             
        End If 
         
        Screen.MousePointer = 0 
        frmUserID.Hide 
          
End Sub