如何实现VB程序登录密码加密

　　其实密码就是对明文文本进行一一对应的变换，使这变成不可识别的密码文本，让非法使用者不能识别。

　　本程序是通过，输入登录密码，然后把用户密码加密保存到文本里。

　　首先，建立一个标准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中运行通过。