密码修改.frm

财务管理系统！ 经过本人操作可以使用！

VERSION 5.00
Begin VB.Form 密码修改 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户名和密码修改"
   ClientHeight    =   2805
   ClientLeft      =   10320
   ClientTop       =   9525
   ClientWidth     =   6885
   ControlBox      =   0   'False
   Icon            =   "密码修改.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2805
   ScaleWidth      =   6885
   Begin VB.TextBox Text4 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   4440
      PasswordChar    =   "*"
      TabIndex        =   10
      Top             =   1620
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "取   消"
      Height          =   345
      Left            =   4980
      TabIndex        =   8
      Top             =   2250
      Width           =   1455
   End
   Begin VB.TextBox Text3 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1320
      PasswordChar    =   "*"
      TabIndex        =   7
      Top             =   1650
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确     认"
      Enabled         =   0   'False
      Height          =   345
      Left            =   3480
      TabIndex        =   4
      Top             =   2250
      Width           =   1455
   End
   Begin VB.TextBox Text2 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   4440
      PasswordChar    =   "*"
      TabIndex        =   3
      Top             =   1080
      Width           =   1695
   End
   Begin VB.TextBox Text1 
      Alignment       =   1  'Right Justify
      Height          =   300
      IMEMode         =   3  'DISABLE
      Left            =   1320
      PasswordChar    =   "*"
      TabIndex        =   2
      Top             =   1080
      Width           =   1695
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "新用户名："
      Height          =   180
      Left            =   3330
      TabIndex        =   9
      Top             =   1140
      Width           =   900
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      BorderWidth     =   2
      X1              =   -60
      X2              =   7290
      Y1              =   780
      Y2              =   780
   End
   Begin VB.Image Image1 
      Height          =   480
      Left            =   6120
      Picture         =   "密码修改.frx":0442
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Label5 
      AutoSize        =   -1  'True
      Caption         =   "新密码："
      Height          =   180
      Left            =   3330
      TabIndex        =   6
      Top             =   1680
      Width           =   720
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "用户名和密码修改"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   525
      Left            =   1290
      TabIndex        =   5
      Top             =   90
      Width           =   4320
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "原密码："
      Height          =   180
      Left            =   330
      TabIndex        =   1
      Top             =   1680
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "原用户名："
      Height          =   180
      Left            =   330
      TabIndex        =   0
      Top             =   1140
      Width           =   900
   End
End
Attribute VB_Name = "密码修改"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'API函数声明
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
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Dim Total As Integer, Uname As String, Pass As String
Private Sub Form_Load()
Dim strString As String
Dim RetVal As Long
On Error GoTo A1
Me.Left = (主程序.Width - Me.Width) / 2
Me.Top = (主程序.Height - Me.Height) / 3
  Uname = GetString(HKEY_CURRENT_USER, "RegData\UserName", "")
  Pass = GetString(HKEY_CURRENT_USER, "RegData\PassWord", "")
  Exit Sub
A1:
    strString = " "
    SaveString HKEY_CURRENT_USER, "RegData", "UserName", strString
    SaveString HKEY_CURRENT_USER, "RegData", "PassWord", strString
End Sub
Private Sub Command1_Click()
  If Text2 <> "" Then
    SaveString HKEY_CURRENT_USER, "RegData", "UserName", Text2
    Else
    SaveString HKEY_CURRENT_USER, "RegData", "UserName", Uname
  End If
  If Text4 <> "" Then
    SaveString HKEY_CURRENT_USER, "RegData", "PassWord", Text4
    Else
    SaveString HKEY_CURRENT_USER, "RegData", "PassWord", Pass
  End If
    Unload Me
End Sub
Private Sub Command2_Click()
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
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
  If Text1 <> Uname Then
   Total = Total + 1
     If Total > 2 Then
        MsgBox "用户名错，对不起，您无权使用本系统 ！        ", vbExclamation, "提示信息"
        Unload Me
        End
     End If
   MsgBox "您的用户名不正确，请重新输入用户名 ！", vbExclamation, "提示信息"
   Text1 = ""
 Else
 Text2 = ""
 Text2.SetFocus
 Total = 0
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)
If KeyAscii = 13 Then
  If Text3 <> Pass Then
   Total = Total + 1
     If Total > 2 Then
        MsgBox "密码错，对不起，您无权使用本系统 ！        ", vbExclamation, "提示信息"
        Unload Me
        End
     End If
   MsgBox "您的用密码不正确，请重新输入密码 ！", vbExclamation, "提示信息"
   Text3 = ""
   Text3.SetFocus
 Else
Text4 = ""
Text4.SetFocus
End If
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
 Command1.Enabled = True
 Command1.SetFocus
End If
End Sub