password.frm

个人财务计算的好工具

VERSION 5.00
Begin VB.Form pass 
   Caption         =   "合法身份验证"
   ClientHeight    =   3105
   ClientLeft      =   3630
   ClientTop       =   3600
   ClientWidth     =   4650
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3105
   ScaleWidth      =   4650
   Begin VB.TextBox Text1 
      Height          =   390
      IMEMode         =   3  'DISABLE
      Left            =   1965
      PasswordChar    =   "*"
      TabIndex        =   5
      Top             =   555
      Width           =   2040
   End
   Begin VB.CommandButton Command3 
      Caption         =   "我不知道密码"
      Height          =   300
      Left            =   3120
      TabIndex        =   4
      Top             =   2385
      Width           =   1455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "换个新密码"
      Height          =   300
      Left            =   1770
      TabIndex        =   3
      Top             =   2385
      Width           =   1095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "好象是这个吧"
      Height          =   300
      Left            =   180
      TabIndex        =   2
      Top             =   2400
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   375
      IMEMode         =   3  'DISABLE
      Left            =   1995
      PasswordChar    =   "*"
      TabIndex        =   0
      Top             =   1380
      Width           =   2055
   End
   Begin VB.Label Label2 
      Alignment       =   1  'Right Justify
      AutoSize        =   -1  'True
      Caption         =   "再输入一次llllllll:"
      Height          =   180
      Left            =   315
      TabIndex        =   6
      Top             =   1470
      Width           =   1620
   End
   Begin VB.Label Label1 
      Caption         =   "请输入新密码:"
      Height          =   255
      Left            =   705
      TabIndex        =   1
      Top             =   525
      Width           =   1170
   End
End
Attribute VB_Name = "pass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'本程序进行密码校验.
'在调用前需要声明窗体类型的对象变量.如:
'Public run As Form
'Set run = Form1  'form1为密码通过后要启动的窗体
'pass.Show        'pass为本程序窗体
'ok.ini为密码保存文件需要同本程序在同一目录中.
Option Explicit
'输入的明文转换为密码
Public Sub zh(mw As String)
Dim i As Integer, cd As Integer, word(8)
cd = Len(mw)
If cd > 8 Then cd = 8 '密码最多8位
For i = 0 To cd - 1 '每一个字符转为ASCII码,换算后再转为字符
    word(i) = Mid(mw, i + 1, 1)
    word(i) = Asc(word(i)) + (i + 1) * 9
    If word(i) > 126 Then
       word(i) = word(i) - 127 + 32 '控制在127-32中
    End If
    word(i) = Chr(word(i))
Next i
mw = ""
For i = 0 To cd - 1
mw = mw + word(i) '合并后完成转换
Next i
End Sub

Public Function pass(ww As String) As Boolean
Call zh(ww)
Dim mm As String, y As Byte
mm = App.Path + "\ok.ini"
'If Dir(mm) <> "ok.ini" Then
'  y = MsgBox("你删除或将保存密码的文件改了名,原名为""ok.ini""", 16, "失败")
'  End
'Else
Open mm For Input As #1
If Not EOF(1) Then '如果OK.INI为空则密码为假
Input #1, mm
Else
pass = False
Close #1
Exit Function
End If
Close #1
If mm = ww Then
   pass = True
   
Else
   pass = False
End If
If IsEmpty(mm) Then pass = False
'End If
End Function


Private Sub Command1_Click()
Dim test As Integer
Static i As Integer
i = i + 1
If pass(Text2.Text) = True Then
Unload Me
        run.Show 'run为PASS后显示的窗体
Else
Select Case i
Case 1 To 2
test = MsgBox("密码不是这样的哟,再想想...", 16, "不对")
Case 3 To 4
test = MsgBox("你不会真给忘了吧?", 16, "不对")
End Select
End If
If i = 5 Then
   test = MsgBox("你这个混合物!", 16, "*&^%$")
   Unload Me
   Unload run
 
   End
End If
End Sub

Private Sub Command2_Click()
Dim y As Byte
If pass(Text2.Text) = True Then
Label3.Visible = False
Label1.Visible = True
Text1.Visible = True
Text1.Text = ""
Text2.Text = ""
Label2.Caption = "再输一次,可别忘了:"
Command1.Enabled = False
Command3.Caption = "启用新密码"
Command2.Enabled = False
Else
y = MsgBox("您得先输入正确的密码才行!", 16, "无权更改")
End If
End Sub



Private Sub Command3_Click()
Dim y As Integer, mw As String
If Command3.Caption <> "启用新密码" Then
    Unload Me
    Unload run
End
Else
    If Mid(Text1.Text, 1, 8) = Mid(Text2.Text, 1, 8) Then
        mw = Mid(Text1.Text, 1, 8)
        Call zh(mw)
        SetAttr App.Path + "\ok.ini", vbArchive
        Open App.Path + "\ok.ini" For Output As #1
        Write #1, mw
        Close #1
        SetAttr App.Path + "\ok.ini", vbReadOnly + vbHidden
        y = MsgBox("新密码已经生效,您要牢牢记住哟!", 64, "更正成功")
        run.Show 'run为PASS后显示的窗体
     Else
        y = MsgBox("您两次输入的密码怎么不一样？", 16, "更新密码错误")
        Text1.Text = ""
        Text2.Text = ""
     End If
End If

End Sub

Private Sub Command4_Click()
Dim mypath As String, myname As String
mypath = "c:\"  ' 指定路径。
myname = Dir(mypath, vbDirectory)   ' 找寻第一项。
Do While myname <> ""   ' 开始循环。
    ' 跳过当前的目录及上层目录。
    If myname <> "." And myname <> ".." Then
        ' 使用位比较来确定 MyName 代表一目录。
        If (GetAttr(mypath & myname) And vbDirectory) = vbDirectory Then

Debug.Print myname  ' 如果它是一个目录，将其名称显示出来。
        End If
    End If
    myname = Dir    ' 查找下一个目录。
Loop
End Sub

Private Sub Form_Load()
Label1.Visible = False
Text1.Visible = False
Label2.Caption = "请输入密码:"
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
End Sub