编程语言 程序设计交流站


Join the forum, it's quick and easy

编程语言 程序设计交流站
编程语言 程序设计交流站
Would you like to react to this message? Create an account in a few clicks or log in to continue.
编程语言 程序设计交流站

欢迎关顾本站,在这里你可以畅所欲言,提出你要解决的问题,各路高手会给你一个圆满的答复,另外有各种源代码、源程序等供你下载。vb vc c++ c# delphi 易语言 Java PASCAL VFP JS VBS Pascal SQL...>


您没有登录。 请登录注册

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

向下  留言 [第1页/共1页]

Admin

Admin
Admin

现在有些软件都设置密码登录,启动软件时要求使用者输入有效的密码。其实密码就是对明文文本进行一一对应的变换,使这变成不可识别的密码文本,让非法使用者不能识别。

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

首先,建立一个标准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

http://proj.my-rpg.com

返回页首  留言 [第1页/共1页]

您在这个论坛的权限:
不能在这个论坛回复主题