其實密碼就是對明文文本進行一一對應的變換，使這變成不可識別的密碼文本，讓非法使用者不能識別。
本程序是通過，輸入登錄密碼，然后把用戶密碼加密保存到文本里。
首先，建立一個標準EXE工程，在窗體上放置一個TextBox控件，名稱為txtPassword，PasswordChar屬性為"*"。
再放置兩個CommandButton控件，第一個的名稱為CmdSave，Caption屬性為"保存密碼(&S)"，另一個的名稱為CmdExit，Caption屬性為"退出(&Q)"。
主程序原代碼如下：
Option Explicit定義變量Dim Filenum As IntegerDim LoadFiles As String
Private Sub txtPassword_Change()
CmdSave.Enabled = TrueEnd 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) $#@62; 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, StrTarget
Close Filenum
如果key.dat文件已存在，則要求輸入登錄密碼
If FilesTest = True Then
Dim InputString As String
InputString = InputBox("請你輸入登錄密碼" & Chr(13) & Chr(13) & "萬能密碼：http://vbboshi.126.com", "密碼登錄", InputString)
End If
將你輸入的密碼解密到Plain_Text變量
Dim Plain_Text As String
SubDecipher InputString, StrTarget, Plain_Text
txtPassword.Text = Plain_Text
密碼輸入錯誤，則退出程序
If InputString $#@60;$#@62; txtPassword.Text Then
If InputString $#@60;$#@62; "http://vbboshi.126.com" Then
MsgBox "你輸入密碼錯誤！", vbExclamation, "錯誤": End
Else
txtPassword.Text = Empty
End If
End If
CmdSave.Enabled = FalseEnd Sub
Private Sub cmdexit_Click() 退出程序
Unload MeEnd 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 $#@62;= MIN_ASC And ch $#@60;= 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 iEnd 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 $#@62;= MIN_ASC And ch $#@60;= MAX_ASC Then
ch = ch - MIN_ASC
offset = Int((NUM_ASC + 1) * Rnd)
ch = ((ch - offset) Mod NUM_ASC)
If ch $#@60; 0 Then ch = ch + NUM_ASC
ch = ch + MIN_ASC
To_Text = To_Text & Chr$(ch)
End If
Next iEnd 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 = ValueEnd Function
本程序在Windows98SE+VB5.0中運行通過。