修改口令.frm

通过计算机自动化管理

VERSION 5.00
Begin VB.Form 修改口令1 
   Caption         =   "系统口令修改"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox Text3 
      Height          =   495
      IMEMode         =   3  'DISABLE
      Left            =   1800
      PasswordChar    =   "*"
      TabIndex        =   6
      Text            =   "Text3"
      Top             =   1680
      Width           =   2055
   End
   Begin VB.CommandButton Command1 
      Caption         =   "保存"
      Height          =   375
      Left            =   3240
      TabIndex        =   5
      Top             =   2520
      Width           =   1095
   End
   Begin VB.TextBox Text2 
      Height          =   495
      IMEMode         =   3  'DISABLE
      Left            =   1800
      PasswordChar    =   "*"
      TabIndex        =   4
      Text            =   "Text2"
      Top             =   960
      Width           =   2055
   End
   Begin VB.TextBox Text1 
      Height          =   495
      IMEMode         =   3  'DISABLE
      Left            =   1800
      PasswordChar    =   "*"
      TabIndex        =   3
      Text            =   "Text1"
      Top             =   240
      Width           =   2055
   End
   Begin VB.Label Label3 
      Caption         =   "确定新口令："
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   1800
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "输入新口令："
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   1080
      Width           =   1335
   End
   Begin VB.Label Label1 
      Caption         =   "输入原口令："
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   1335
   End
End
Attribute VB_Name = "修改口令1"
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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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
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 FindWindow Lib "User32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal X As Long, _
 ByVal hWndInsterAfter As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim hWndl As Long
Const REG_SZ = 1
Const HKEY_CURRENT_USER = &H80000001
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
Dim Total As Integer, M As String
Dim pwd As String
Public Falg As Integer
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim strString As String
    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)
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
Private 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 Command1_Click()
On Error GoTo error
If Text2.Text = "" Then
Unload Me
Else
If Text2.Text <> Text3.Text Then
MsgBox "口令输入不一致 ！", vbExclamation, "提示信息"
Text2.SetFocus
Else
pwd = Text3.Text
SaveString HKEY_CURRENT_USER, "RegData", "AA", pwd
MsgBox "口令修改成功 ！", vbExclamation, "提示信息"
Unload Me
End If
End If
error:
Unload Me
End Sub

Private Sub Form_Load()
Text2.Visible = False
Text3.Visible = False
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Label2.Visible = False
Label3.Visible = False
Command1.Enabled = False
Dim strString As String
On Error GoTo A1
  Falg = 0
  hWndl = FindWindow("Shell_traywnd", "")
  M = GetString(HKEY_CURRENT_USER, "RegData\AA", "")
  Exit Sub
A1:
    'strString = "1234"
    strString = pwd
    SaveString HKEY_CURRENT_USER, "RegData", "AA", strString
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
        MsgBox "对不起，您无权修改口令 ！        ", vbExclamation, "提示信息"
        Open App.Path + "\" + "Screen.txt" For Input As #1
        Input #1, apiRECT.Right
        Close #1
        Unload Me
        End
     End If
   MsgBox "您的密码不正确，请重新输入密码 ！", vbExclamation, "提示信息"
   Text1 = ""
 Else
DoEvents
Falg = 1
Text1.Text = ""
Text1.Visible = False
Label1.Visible = False
Text2.Visible = True
Text3.Visible = True
Label2.Visible = True
Label3.Visible = True
Command1.Enabled = True
End If
End If
End Sub