字符串转换的两个实用函数(Access VBA)
有的时候我们使用RC4来编码数据,但产生的字符串已经不是正常的字符串,在存储过程中会造成混乱,以致于无法用RC4来还原原来的数据。
解决问题办法就是将这个不正常的字符串进行转换后存储,取出时再转换回来。
两个函数如下:
附: 刘小军先生的RC4函数
附2:Access911.net 陈格(cg1)先生的代码(比之自己编写的转换函数更好)
http://access911.net/fixhtm/72FABE1E15DCEDF3.htm?tt=
解决问题办法就是将这个不正常的字符串进行转换后存储,取出时再转换回来。
两个函数如下:
1
'将一个字符数组转换成以逗号分隔的数字字符串
2
'作者:朱亦文
3
'时间:2006.12.13
4
Function String2Num(ByVal s As String) As String
5
If s = "" Then Exit Function
6
7
Dim i As Integer, l As Integer
8
Dim ByteGB() As Byte
9
10
ByteGB = s
11
l = UBound(ByteGB)
12
For i = 0 To l
13
String2Num = String2Num & "," & ByteGB(i)
14
Next
15
String2Num = Mid(String2Num, 2)
16
End Function
17
18
'将以逗号分隔的数字字符串还原成一个字符数组
19
'作者:朱亦文
20
'时间:2006.12.13
21
Function Num2String(ByVal s As String) As String
22
If s = "" Then Exit Function
23
24
Dim aCh, i As Integer, l As Integer
25
26
aCh = Split(s, ",")
27
l = UBound(aCh)
28
ReDim ByteGB(l) As Byte
29
30
For i = 0 To l
31
ByteGB(i) = CInt(aCh(i))
32
Next
33
Num2String = ByteGB
34
End Function
35
'将一个字符数组转换成以逗号分隔的数字字符串2
'作者:朱亦文3
'时间:2006.12.134
Function String2Num(ByVal s As String) As String5
If s = "" Then Exit Function6
7
Dim i As Integer, l As Integer8
Dim ByteGB() As Byte9
10
ByteGB = s11
l = UBound(ByteGB)12
For i = 0 To l13
String2Num = String2Num & "," & ByteGB(i)14
Next15
String2Num = Mid(String2Num, 2)16
End Function17

18
'将以逗号分隔的数字字符串还原成一个字符数组19
'作者:朱亦文20
'时间:2006.12.1321
Function Num2String(ByVal s As String) As String22
If s = "" Then Exit Function23
24
Dim aCh, i As Integer, l As Integer25
26
aCh = Split(s, ",")27
l = UBound(aCh)28
ReDim ByteGB(l) As Byte29
30
For i = 0 To l31
ByteGB(i) = CInt(aCh(i))32
Next33
Num2String = ByteGB34
End Function35

附: 刘小军先生的RC4函数
1
'conKey是加密时的密钥,可以自己更改
2
Private Const conKey = "zy123456789"
3
4
Public Function RC4(strInp As String) As String
5
'=================================
6
'RC4加密函数
7
'=================================
8
'修改:刘小军(Alex) 2002-3-22
9
'适用于使用UNICODE的双字节ACCESS,测试证明支持中英文混合的文本加密
10
'=================================
11
'参数:
12
' strInp 需要加密或解密的字符串
13
'=================================
14
'
15
'这是修改过的RC4加密方法,主要更改是把密钥固定在程序中了
16
'使用方法:
17
' RC4("345G4")得到"345G4"加密之后的字符串
18
' RC4(RC4("345G4"))可以将加密后的字符串还原为"345G4"
19
'
20
Dim s(0 To 255) As Byte, K(0 To 255) As Byte, i As Long
21
Dim j As Long, Temp As Byte, Y As Byte, t As Long, x As Long
22
Dim Outp As String
23
24
For i = 0 To 255
25
s(i) = i
26
Next
27
28
j = 1
29
For i = 0 To 255
30
If j > Len(conKey) Then j = 1
31
K(i) = Asc(Mid(conKey, j, 1))
32
j = j + 1
33
Next i
34
35
j = 0
36
For i = 0 To 255
37
j = (j + s(i) + K(i)) Mod 256
38
Temp = s(i)
39
s(i) = s(j)
40
s(j) = Temp
41
Next i
42
43
i = 0
44
j = 0
45
For x = 1 To Len(strInp)
46
i = (i + 1) Mod 256
47
j = (j + s(i)) Mod 256
48
Temp = s(i)
49
s(i) = s(j)
50
s(j) = Temp
51
t = (s(i) + (s(j) Mod 256)) Mod 256
52
Y = s(t)
53
54
Outp = Outp & ChrW(AscW(Mid(strInp, x, 1)) Xor Y)
55
Next
56
RC4 = Outp
57
End Function
'conKey是加密时的密钥,可以自己更改2
Private Const conKey = "zy123456789"3

4
Public Function RC4(strInp As String) As String5
'=================================6
'RC4加密函数7
'=================================8
'修改:刘小军(Alex) 2002-3-229
'适用于使用UNICODE的双字节ACCESS,测试证明支持中英文混合的文本加密10
'=================================11
'参数:12
' strInp 需要加密或解密的字符串13
'=================================14
'15
'这是修改过的RC4加密方法,主要更改是把密钥固定在程序中了16
'使用方法:17
' RC4("345G4")得到"345G4"加密之后的字符串18
' RC4(RC4("345G4"))可以将加密后的字符串还原为"345G4"19
'20
Dim s(0 To 255) As Byte, K(0 To 255) As Byte, i As Long21
Dim j As Long, Temp As Byte, Y As Byte, t As Long, x As Long22
Dim Outp As String23

24
For i = 0 To 25525
s(i) = i26
Next27

28
j = 129
For i = 0 To 25530
If j > Len(conKey) Then j = 131
K(i) = Asc(Mid(conKey, j, 1))32
j = j + 133
Next i34

35
j = 036
For i = 0 To 25537
j = (j + s(i) + K(i)) Mod 25638
Temp = s(i)39
s(i) = s(j)40
s(j) = Temp41
Next i42

43
i = 044
j = 045
For x = 1 To Len(strInp)46
i = (i + 1) Mod 25647
j = (j + s(i)) Mod 25648
Temp = s(i)49
s(i) = s(j)50
s(j) = Temp51
t = (s(i) + (s(j) Mod 256)) Mod 25652
Y = s(t)53
54
Outp = Outp & ChrW(AscW(Mid(strInp, x, 1)) Xor Y)55
Next56
RC4 = Outp57
End Function附2:Access911.net 陈格(cg1)先生的代码(比之自己编写的转换函数更好)
http://access911.net/fixhtm/72FABE1E15DCEDF3.htm?tt=
1
'===========================================================
2
' 过程及函数名: StrToHex
3
' 版本号 : 1.0
4
' 说明 : 本函数作用:将普通字符串编码为16进制字符串
5
' 引用 : --
6
' 输入参数 : Words 文本,需编码的字符串
7
' 输出值 : --
8
' 返回值 : String 文本,编码后的16进制字符串
9
' 出错时返回 "" (零长度字符串)
10
' 调用演示 : StrToHex "哈哈哈"
11
' (或请直接看 test 过程。)
12
' 最后修改日期: 2006-12-13 16:22:00
13
' 示例地址 : http://access911.net/?kbid;72FABE1E15DCEDF3
14
' 作者 : cg1
15
' 网站 : http://access911.net
16
' 电子邮件 : access911@gmail.com
17
' 版权 : 作者保留一切权力,
18
' 请在公布本代码时将本段说明一起公布,谢谢!
19
'===========================================================
20
21
Public Function StrToHex(ByVal Words As String) As String
22
'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码
23
'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢
24
Dim i As Long
25
Dim strResult As String
26
On Error GoTo StrToHex_Err
27
28
For i = 1 To LenB(Words)
29
strResult = strResult & Right("00" & CStr(Hex(AscB(MidB(Words, i, 1)))), 2)
30
Next
31
32
StrToHex = LCase(strResult)
33
34
35
36
Exit Function
37
StrToHex_Err:
38
'出错时直接返回零长度字符串
39
Debug.Print Err.Number & Err.Description
40
StrToHex = ""
41
42
End Function
43
44
'===========================================================
45
' 过程及函数名: HexToStr
46
' 版本号 : 1.0
47
' 说明 : 本函数作用:将16进制字符串解码为普通字符串
48
' 引用 : --
49
' 输入参数 : Words 文本,需解码的字符串
50
' 输出值 : --
51
' 返回值 : String 文本,解码后的普通文本
52
' 出错时返回 "" (零长度字符串)
53
' 调用演示 : HexToStr "312d7a41fcf4b8803d991d929d25d1c8e249e562153efe1dc65b"
54
' (或请直接看 test 过程。)
55
' 最后修改日期: 2006-12-13 16:22:00
56
' 示例地址 : http://access911.net/?kbid;72FABE1E15DCEDF3
57
' 作者 : cg1
58
' 网站 : http://access911.net
59
' 电子邮件 : access911@gmail.com
60
' 版权 : 作者保留一切权力,
61
' 请在公布本代码时将本段说明一起公布,谢谢!
62
'===========================================================
63
Public Function HexToStr(ByVal Words As String) As String
64
'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码
65
'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢
66
Dim i As Long
67
Dim strResult As String
68
On Error GoTo HexToStr_Err
69
70
For i = 1 To Len(Words) Step 2
71
strResult = strResult & ChrB(CLng("&H" & Mid(Words, i, 2)))
72
Next
73
74
HexToStr = strResult
75
76
77
Exit Function
78
HexToStr_Err:
79
'出错时直接返回零长度字符串
80
Debug.Print Err.Number & Err.Description
81
HexToStr = ""
82
83
End Function
'===========================================================2
' 过程及函数名: StrToHex3
' 版本号 : 1.04
' 说明 : 本函数作用:将普通字符串编码为16进制字符串5
' 引用 : --6
' 输入参数 : Words 文本,需编码的字符串7
' 输出值 : --8
' 返回值 : String 文本,编码后的16进制字符串9
' 出错时返回 "" (零长度字符串)10
' 调用演示 : StrToHex "哈哈哈"11
' (或请直接看 test 过程。)12
' 最后修改日期: 2006-12-13 16:22:0013
' 示例地址 : http://access911.net/?kbid;72FABE1E15DCEDF314
' 作者 : cg115
' 网站 : http://access911.net16
' 电子邮件 : access911@gmail.com17
' 版权 : 作者保留一切权力,18
' 请在公布本代码时将本段说明一起公布,谢谢!19
'===========================================================20

21
Public Function StrToHex(ByVal Words As String) As String22
'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码23
'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢24
Dim i As Long25
Dim strResult As String26
On Error GoTo StrToHex_Err27
28
For i = 1 To LenB(Words)29
strResult = strResult & Right("00" & CStr(Hex(AscB(MidB(Words, i, 1)))), 2)30
Next31
32
StrToHex = LCase(strResult)33
34
35
36
Exit Function37
StrToHex_Err:38
'出错时直接返回零长度字符串39
Debug.Print Err.Number & Err.Description40
StrToHex = ""41
42
End Function43

44
'===========================================================45
' 过程及函数名: HexToStr46
' 版本号 : 1.047
' 说明 : 本函数作用:将16进制字符串解码为普通字符串48
' 引用 : --49
' 输入参数 : Words 文本,需解码的字符串50
' 输出值 : --51
' 返回值 : String 文本,解码后的普通文本52
' 出错时返回 "" (零长度字符串)53
' 调用演示 : HexToStr "312d7a41fcf4b8803d991d929d25d1c8e249e562153efe1dc65b"54
' (或请直接看 test 过程。)55
' 最后修改日期: 2006-12-13 16:22:0056
' 示例地址 : http://access911.net/?kbid;72FABE1E15DCEDF357
' 作者 : cg158
' 网站 : http://access911.net59
' 电子邮件 : access911@gmail.com60
' 版权 : 作者保留一切权力,61
' 请在公布本代码时将本段说明一起公布,谢谢!62
'===========================================================63
Public Function HexToStr(ByVal Words As String) As String64
'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码65
'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢66
Dim i As Long67
Dim strResult As String68
On Error GoTo HexToStr_Err69
70
For i = 1 To Len(Words) Step 271
strResult = strResult & ChrB(CLng("&H" & Mid(Words, i, 2)))72
Next73
74
HexToStr = strResult75
76
77
Exit Function78
HexToStr_Err:79
'出错时直接返回零长度字符串80
Debug.Print Err.Number & Err.Description81
HexToStr = ""82
83
End Function

浙公网安备 33010602011771号