密码操作.frm

一个客车售票系统

VERSION 5.00
Begin VB.Form 密码 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "密码修改"
   ClientHeight    =   2535
   ClientLeft      =   5055
   ClientTop       =   3975
   ClientWidth     =   6150
   ControlBox      =   0   'False
   FillStyle       =   0  'Solid
   Icon            =   "密码操作.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   ScaleHeight     =   2535
   ScaleWidth      =   6150
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   2010
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   330
      Width           =   2895
   End
   Begin VB.TextBox Text3 
      Alignment       =   1  'Right Justify
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   2010
      PasswordChar    =   "*"
      TabIndex        =   7
      Top             =   1440
      Width           =   2895
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   345
      IMEMode         =   3  'DISABLE
      Left            =   2010
      PasswordChar    =   "*"
      TabIndex        =   6
      Top             =   885
      Width           =   2895
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取  消"
      Height          =   345
      Left            =   4650
      TabIndex        =   2
      Top             =   1950
      Width           =   1245
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确   认"
      Height          =   345
      Left            =   3360
      TabIndex        =   1
      Top             =   1950
      Width           =   1245
   End
   Begin VB.Label Label3 
      Caption         =   "确 认 密 码："
      Height          =   255
      Left            =   570
      TabIndex        =   5
      Top             =   1530
      Width           =   1245
   End
   Begin VB.Label Label2 
      Caption         =   "请输入新密码："
      Height          =   345
      Left            =   570
      TabIndex        =   4
      Top             =   960
      Width           =   1305
   End
   Begin VB.Label Label1 
      Caption         =   "请输入原密码："
      Height          =   375
      Left            =   570
      TabIndex        =   3
      Top             =   360
      Width           =   1395
   End
End
Attribute VB_Name = "密码"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const REG_SZ = 1
'Const YaoWei = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Dim Total As Integer, M As String
Private Sub Form_Load()
Dim strString As String
On Error GoTo A1
   M = GetString(HKEY_CURRENT_USER, "RegData\AA", "")
'   Debug.Print M
   Exit Sub
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
End Sub
Private Sub Command1_Click()
    Dim strString As String
    If Text2.Text = "" Then
      strString = ""
       Else
      strString = Text2.Text
    End If
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
    工作选项.Enabled = True
   Unload Me
End Sub
Private Sub Command2_Click()
  工作选项.Enabled = True
  Unload Me
End Sub
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim strString As String
On Error GoTo A1
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    RegQueryValueEx hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize
    strBuf = String(lDataBufSize, Chr$(0))
    RegQueryValueEx hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize
    RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
    Exit Function
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
    Text1.Text = ""
    Text1.SetFocus
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    RegOpenKey hKey, strPath, Ret
    GetString = RegQueryStringValue(Ret, strValue)
    RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
    Dim Ret
    RegCreateKey hKey, strPath, Ret
    RegSetValue Ret, strValue, REG_SZ, strData, Len(strData)
    RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    RegCreateKey hKey, strPath, Ret
    RegDeleteValue Ret, strValue
    RegDeleteKey Ret, strPath
    RegCloseKey Ret
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim X As Integer
If KeyAscii = 13 Then
  If Text1 <> M Then
   Total = Total + 1
     If Total > 2 Then
      X = MsgBox("您不能做密码修改 ！", vbExclamation, "提示信息")
      If X = 1 Then
       工作选项.Enabled = True
       Unload Me
       Exit Sub
      End If
     End If
   MsgBox "您的密码不正确，请重新输入密码 ！", vbExclamation, "提示信息"
   Text1 = ""
 Else
 Text2.SetFocus
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
 Text3.SetFocus
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
Dim X As Integer
If KeyAscii = 13 Then
  If Text3 = Text2 Then
    Command1.SetFocus
      Else
   X = MsgBox(" 请重新输入新密码 ！   ", vbExclamation, "提示信息")
  If X = 1 Then
    Text2 = "": Text3 = ""
    Text2.SetFocus
  End If
  End If
End If
End Sub