首先，建立一个标准EXE工程，在窗体上放置一个TextBox控件，名称为txtPassword，PasswordChar属性为
再放置两个CommandButton控件，第一个的名称为CmdSave，Caption属性为保存密码(&S)，另一个的名称为CmdExit，Caption属性为退出(&Q)
主程序原代码如下： Option Explicit '定义变量 Dim Filenum As Integer Dim LoadFiles As String Private Sub txtPassword_Change() CmdSave.Enabled = True End Sub Private Sub CmdSave_Click() '保存密码 '当密码输入为空时，则提示信息
If txtPassword.Text = Empty Then MsgBox 请你输入要更改的密码
, vbExclamation, Me.Caption Exit Sub End If '将你输入的密码加密到 Cipher_Text 的变量里 Dim Cipher_Text As String SubCipher txtPassword.Text, txtPassword.Text, Cipher_Text '保存到文件并加密 Filenum = FreeFile Open LoadFiles For Random As Filenum '把 Cipher_Text 的变量写入文件里 Put #Filenum, 1, Cipher_Text Close Filenum CmdSave.Enabled = False End Sub Private Sub Form_Load() On Error Resume Next '密码信息文件的路径 LoadFiles = App.Path & IIf(Len(App.Path) > 3, \key.dat, key.dat) Dim FilesTest As Boolean '检验 key.dat 文件是否存在 If Dir(LoadFiles, vbHidden) = Empty Then FilesTest = False Else FilesTest = True End If Filenum = FreeFile '提供一个尚未使用的文件号 '读取密码文件，把文件的信息赋值给 StrTarget 变量 Dim StrTarget As String Open LoadFiles For Random As Filenum Get #Filenum, 1, StrTarget Close Filenum '如果 key.dat 文件已存在，则要求输入登录密码 If FilesTest = True Then Dim InputString As String InputString = InputBox(请你输入登录密码 & Chr(13) & Chr(13) & 万能密码：http://www.vbeden.com, 密码登录, InputString) End If '将你输入的密码解密到 Plain_Text 变量 Dim Plain_Text As String SubDecipher InputString, StrTarget, Plain_Text txtPassword.Text = Plain_Text '密码输入错误，则退出程序 If InputString <> txtPassword.Text Then If InputString <> http://www.vbeden.com Then MsgBox 你输入密码错误
, vbExclamation, 错误: End Else txtPassword.Text = Empty End If End If CmdSave.Enabled = False End Sub Private Sub cmdexit_Click() '退出程序 Unload Me End Sub '加密子程序 Private Sub SubCipher(ByVal Password As String, ByVal From_Text As String, To_Text As String) Const MIN_ASC = 32 ' Space. Const MAX_ASC = 126 ' ~. Const NUM_ASC = MAX_ASC - MIN_ASC + 1 Dim offset As Long Dim Str_len As Integer Dim i As Integer Dim ch As Integer '得到了加密的数字 offset = NumericPassword(Password) Rnd -1 '对随机数生成器做初始化的动作 Randomize offset Str_len = Len(From_Text) For i = 1 To Str_len ch = Asc(Mid$(From_Text, i, 1)) If ch >= MIN_ASC And ch <= MAX_ASC Then ch = ch - MIN_ASC offset = Int((NUM_ASC + 1) Rnd) ch = ((ch + offset) Mod NUM_ASC) ch = ch + MIN_ASC To_Text = To_Text & Chr$(ch) End If Next i End Sub '解密子程序 Private Sub SubDecipher(ByVal Password As String, ByVal From_Text As String, To_Text As String) Const MIN_ASC = 32 ' Space. Const MAX_ASC = 126 ' ~. Const NUM_ASC = MAX_ASC - MIN_ASC + 1 Dim offset As Long Dim Str_len As Integer Dim i As Integer Dim ch As Integer offset = NumericPassword(Password) Rnd -1 Randomize offset Str_len = Len(From_Text) For i = 1 To Str_len ch = Asc(Mid$(From_Text, i, 1)) If ch >= MIN_ASC And ch <= MAX_ASC Then ch = ch - MIN_ASC offset = Int((NUM_ASC + 1) Rnd) ch = ((ch - offset) Mod NUM_ASC) If ch < 0 Then ch = ch + NUM_ASC ch = ch + MIN_ASC To_Text = To_Text & Chr$(ch) End If Next i End Sub '将你输入的每个字符转换成密码数字 Private Function NumericPassword(ByVal Password As String) As Long Dim Value As Long Dim ch As Long Dim Shift1 As Long Dim Shift2 As Long Dim i As Integer Dim Str_len As Integer '得到字符串内字符的数目 Str_len = Len(Password) '给每个字符转换成密码数字 For i = 1 To Str_len ch = Asc(Mid$(Password, i, 1)) Value = Value Xor (ch 2 ^ Shift1) Value = Value Xor (ch 2 ^ Shift2) Shift1 = (Shift1 + 7) Mod 19 Shift2 = (Shift2 + 13) Mod 23 Next i NumericPassword = Value End Function