字符串转换的两个实用函数(Access VBA)
有的时候我们使用RC4来编码数据,但产生的字符串已经不是正常的字符串,在存储过程中会造成混乱,以致于无法用RC4来还原原来的数据。
解决问题办法就是将这个不正常的字符串进行转换后存储,取出时再转换回来。
两个函数如下:
附: 刘小军先生的RC4函数
附2:Access911.net 陈格(cg1)先生的代码(比之自己编写的转换函数更好)
http://access911.net/fixhtm/72FABE1E15DCEDF3.htm?tt=
解决问题办法就是将这个不正常的字符串进行转换后存储,取出时再转换回来。
两个函数如下:
1'将一个字符数组转换成以逗号分隔的数字字符串
2'作者:朱亦文
3'时间:2006.12.13
4Function 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)
16End Function
17
18'将以逗号分隔的数字字符串还原成一个字符数组
19'作者:朱亦文
20'时间:2006.12.13
21Function 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
34End Function
35
2'作者:朱亦文
3'时间:2006.12.13
4Function 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)
16End Function
17
18'将以逗号分隔的数字字符串还原成一个字符数组
19'作者:朱亦文
20'时间:2006.12.13
21Function 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
34End Function
35
附: 刘小军先生的RC4函数
1'conKey是加密时的密钥,可以自己更改
2Private Const conKey = "zy123456789"
3
4Public 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'
20Dim s(0 To 255) As Byte, K(0 To 255) As Byte, i As Long
21Dim j As Long, Temp As Byte, Y As Byte, t As Long, x As Long
22Dim Outp As String
23
24For i = 0 To 255
25 s(i) = i
26Next
27
28j = 1
29For i = 0 To 255
30 If j > Len(conKey) Then j = 1
31 K(i) = Asc(Mid(conKey, j, 1))
32 j = j + 1
33Next i
34
35j = 0
36For 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
41Next i
42
43i = 0
44j = 0
45For 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)
55Next
56 RC4 = Outp
57End Function
2Private Const conKey = "zy123456789"
3
4Public 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'
20Dim s(0 To 255) As Byte, K(0 To 255) As Byte, i As Long
21Dim j As Long, Temp As Byte, Y As Byte, t As Long, x As Long
22Dim Outp As String
23
24For i = 0 To 255
25 s(i) = i
26Next
27
28j = 1
29For i = 0 To 255
30 If j > Len(conKey) Then j = 1
31 K(i) = Asc(Mid(conKey, j, 1))
32 j = j + 1
33Next i
34
35j = 0
36For 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
41Next i
42
43i = 0
44j = 0
45For 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)
55Next
56 RC4 = Outp
57End 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
21Public 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
37StrToHex_Err:
38 '出错时直接返回零长度字符串
39 Debug.Print Err.Number & Err.Description
40 StrToHex = ""
41
42End 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'===========================================================
63Public Function HexToStr(ByVal Words As String) As String
64'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码
65'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢
66 Dim i As Long
67 Dim strResult As String
68On 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
78HexToStr_Err:
79 '出错时直接返回零长度字符串
80 Debug.Print Err.Number & Err.Description
81 HexToStr = ""
82
83End Function
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
21Public 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
37StrToHex_Err:
38 '出错时直接返回零长度字符串
39 Debug.Print Err.Number & Err.Description
40 StrToHex = ""
41
42End 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'===========================================================
63Public Function HexToStr(ByVal Words As String) As String
64'本函数在不改动 RC4 编码的基础上,对 RC4 的结果进行再编码
65'因此在效率上比将本编码直接加入 RC4 函数的方式稍慢
66 Dim i As Long
67 Dim strResult As String
68On 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
78HexToStr_Err:
79 '出错时直接返回零长度字符串
80 Debug.Print Err.Number & Err.Description
81 HexToStr = ""
82
83End Function