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