给出几个vb对字符串加密,然后可以解密还原的代码吧,急用

ysotn 2004-04-12 11:35:20
着急啊
...全文
198 6 打赏 收藏 举报
写回复
6 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
dazui 2004-07-10
up
  • 打赏
  • 举报
回复
华芸智森 2004-04-12

'加密 txtText.Text = Crypt(txtText.Text, txtPassword.Text)
'解密 txtText.Text = DeCrypt(txtText.Text, txtPassword.Text)

Public SetupUser As SetupMax
Public FolderSetup(1 To 3) As String

'加
Public Function Crypt(texti, salasana) As String

On Error Resume Next
For T = 1 To Len(salasana)
sana = Asc(Mid(salasana, T, 1))
X1 = X1 + sana
Next
X1 = Int((X1 * 0.1) / 6)
salasana = X1
G = 0
For TT = 1 To Len(texti)
sana = Asc(Mid(texti, TT, 1))
G = G + 1
If G = 6 Then G = 0
X1 = 0
If G = 0 Then X1 = sana - (salasana - 2)

If G = 1 Then X1 = sana + (salasana - 5)

If G = 2 Then X1 = sana - (salasana - 4)

If G = 3 Then X1 = sana + (salasana - 2)

If G = 4 Then X1 = sana - (salasana - 3)

If G = 5 Then X1 = sana + (salasana - 5)
X1 = X1 + G
Crypted = Crypted & Chr(X1)
Next
Crypt = Crypted
End Function

'解
Public Function DeCrypt(texti, salasana) As String

On Error Resume Next

For T = 1 To Len(salasana)
sana = Asc(Mid(salasana, T, 1))
X1 = X1 + sana
Next

X1 = Int((X1 * 0.1) / 6)
salasana = X1
G = 0

For TT = 1 To Len(texti)
sana = Asc(Mid(texti, TT, 1))
G = G + 1

If G = 6 Then G = 0
X1 = 0

If G = 0 Then X1 = sana + (salasana - 2)

If G = 1 Then X1 = sana - (salasana - 5)

If G = 2 Then X1 = sana + (salasana - 4)

If G = 3 Then X1 = sana - (salasana - 2)

If G = 4 Then X1 = sana + (salasana - 3)

If G = 5 Then X1 = sana - (salasana - 5)
X1 = X1 - G
DeCrypted = DeCrypted & Chr(X1)
Next


DeCrypt = DeCrypted
End Function
  • 打赏
  • 举报
回复
ysotn 2004-04-12
我先试试
  • 打赏
  • 举报
回复
这个记不得是谁的了 ^_^ 反正能用就行


Option Explicit
Const MIN_ASC = 32 ' Space.
Const MAX_ASC = 126 ' ~.
Const NUM_ASC = MAX_ASC - MIN_ASC + 1

'***************************************************
' Encipher the text using the pasword.
' 此函数的作用为加密字符串
' from_text:欲加密的字符串
' PassWord:密匙
'***************************************************
Public Function strEncrypt(ByVal from_text As String, ByVal password As String) As String
Dim offset As Long
Dim str_len As Integer
Dim I As Integer
Dim ch As Integer

' Initialize the random number generator.
offset = NumericPassword(password)
Rnd -1
Randomize offset

' Encipher the string.
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
strEncrypt = strEncrypt & Chr$(ch)
End If
Next I
End Function

' Encipher the text using the pasword.
Public Function DeStrEncrypt(ByVal from_text As String, ByVal password As String) As String

Dim offset As Long
Dim str_len As Integer
Dim I As Integer
Dim ch As Integer

' Initialize the random number generator.
offset = NumericPassword(password)
Rnd -1
Randomize offset

' Encipher the string.
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
DeStrEncrypt = DeStrEncrypt & Chr$(ch)
End If
Next I
End Function
  • 打赏
  • 举报
回复
记得好像是斑竹的

'字符串加密、解密函数

Public Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)'password为密钥,from_text为原始文本,to_text为加密后文本
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

Public Sub Decipher(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



Public 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
  • 打赏
  • 举报
回复
cpio 2004-04-12
著名的RSA算法啊,可以加密,解密
  • 打赏
  • 举报
回复
发帖
VB基础类
加入

7607

社区成员

VB 基础类
社区管理员
  • VB基础类社区
申请成为版主
帖子事件
创建了帖子
2004-04-12 11:35
社区公告
暂无公告