简单的cookie加密类(Base64编码)
1.
2.<%
3.
4.Class clsCookieX
5.
6. Private ErrMsg,bHasErr
7. Private sBASE_64_CHARACTERS
8.
9. Private Sub Class_Initialize()
10. ErrMsg="":bHasErr=False
11. '打乱的字母表，可以用excel来打乱，这样才能做到加密的效果！
12. sBASE_64_CHARACTERS = "J50Xu1]rf8Gq2agbUSzIMjltP6ZOdnAyVCiNo4TYH3w7vmKRQ[Dk9xWphFELcsBe"
13. sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
14. End Sub
15. Private Sub Class_Terminate()
16.
17. End Sub
18.
19. Private Sub AddErr(s)
20. ErrMsg=ErrMsg&"Cookie操作出错信息 - "&s&HTML_BR
21. bHasErr=True
22. End Sub
23. Public Function GetErr()
24. GetErr=ErrMsg
25. End Function
26. Public Sub ErrClear()
27. ErrMsg=""
28. bHasErr=False
29. End Sub
30. Public Property Get HasErr()
31. HasErr=bHasErr
32. End Property
33.
34. Public Property Let Item(k,v)
35. Response.Cookies(k)=strAnsi2Unicode(Base64encode(strUnicode2Ansi(v)))
36. End Property
37. Public Default Property Get Item(k)
38. Item=strAnsi2Unicode(Base64decode(strUnicode2Ansi(Request.Cookies(k))))
39. End Property
40.
41. Function strUnicodeLen(asContents)
42. Dim len1, k, i, Asc1, asContents1
43. '计算unicode字符串的Ansi编码的长度
44. asContents1 = "a" & asContents
45. len1 = Len(asContents1)
46. k = 0
47. For i = 1 To len1
48. Asc1 = Asc(Mid(asContents1, i, 1))
49. If Asc1 < 0 Then Asc1 = 65536 + Asc1
50. If Asc1 > 255 Then
51. k = k + 2
52. Else
53. k = k + 1
54. End If
55. Next
56. strUnicodeLen = k - 1
57. End Function
58.
59. Function strUnicode2Ansi(asContents)
60. Dim len1, k, i, Asc1, varchar, varasc, varhex, varlow, varhigh
61. '将Unicode编码的字符串，转换成Ansi编码的字符串
62. strUnicode2Ansi = ""
63. len1 = Len(asContents)
64. For i = 1 To len1
65. varchar = Mid(asContents, i, 1)
66. varasc = Asc(varchar)
67. If varasc < 0 Then varasc = varasc + 65536
68. If varasc > 255 Then
69. varhex = Hex(varasc)
70. varlow = Left(varhex, 2)
71. varhigh = Right(varhex, 2)
72. strUnicode2Ansi = strUnicode2Ansi & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
73. Else
74. strUnicode2Ansi = strUnicode2Ansi & ChrB(varasc)
75. End If
76. Next
77. End Function
78.
79. Function strAnsi2Unicode(asContents)
80. Dim len1, k, i, Asc1, varchar, varasc, varhex, varlow, varhigh
81. '将Ansi编码的字符串，转换成Unicode编码的字符串
82. strAnsi2Unicode = ""
83. len1 = LenB(asContents)
84. If len1 = 0 Then Exit Function
85. For i = 1 To len1
86. varchar = MidB(asContents, i, 1)
87. varasc = AscB(varchar)
88. If varasc > 127 Then
89. strAnsi2Unicode = strAnsi2Unicode & Chr(AscW(MidB(asContents, i + 1, 1) & varchar))
90. i = i + 1
91. Else
92. strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
93. End If
94. Next
95. End Function
96.
97. Function Base64encode(asContents)
98. '将Ansi编码的字符串进行Base64编码
99. 'asContents应当是ANSI编码的字符串（二进制的字符串也可以）
100. Dim lnPosition
101. Dim lsResult
102. Dim Char1
103. Dim Char2
104. Dim Char3
105. Dim Char4
106. Dim Byte1
107. Dim Byte2
108. Dim Byte3
109. Dim SaveBits1
110. Dim SaveBits2
111. Dim lsGroupBinary
112. Dim lsGroup64
113. Dim M3, len1, len2
114.
115. len1 = LenB(asContents)
116. If len1 < 1 Then
117. Base64encode = ""
118. Exit Function
119. End If
120.
121. M3 = len1 Mod 3
122. If M3 > 0 Then asContents = asContents & String(3 - M3, ChrB(0))
123. '补足位数是为了便于计算
124.
125. If M3 > 0 Then
126. len1 = len1 + (3 - M3)
127. len2 = len1 - 3
128. Else
129. len2 = len1
130. End If
131.
132. lsResult = ""
133.
134. For lnPosition = 1 To len2 Step 3
135. lsGroup64 = ""
136. lsGroupBinary = MidB(asContents, lnPosition, 3)
137.
138. Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
139. Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
140. Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
141.
142. Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
143. Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
144. Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
145. Char4 = MidB(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
146. lsGroup64 = Char1 & Char2 & Char3 & Char4
147.
148. lsResult = lsResult & lsGroup64
149. Next
150.
151. '处理最后剩余的几个字符
152. If M3 > 0 Then
153. lsGroup64 = ""
154. lsGroupBinary = MidB(asContents, len2 + 1, 3)
155.
156. Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
157. Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
158. Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
159.
160. Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
161. Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
162. Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
163.
164. If M3 = 1 Then
165. lsGroup64 = Char1 & Char2 & ChrB(64) & ChrB(64) '用=号补足位数
166. Else
167. lsGroup64 = Char1 & Char2 & Char3 & ChrB(64) '用=号补足位数
168. End If
169.
170. lsResult = lsResult & lsGroup64
171. End If
172.
173. Base64encode = lsResult
174.
175. End Function
176.
177.
178. Function Base64decode(asContents)
179. '将Base64编码字符串转换成Ansi编码的字符串
180. 'asContents应当也是ANSI编码的字符串（二进制的字符串也可以）
181. Dim lsResult
182. Dim lnPosition
183. Dim lsGroup64, lsGroupBinary
184. Dim Char1, Char2, Char3, Char4
185. Dim Byte1, Byte2, Byte3
186. Dim M4, len1, len2
187.
188. len1 = LenB(asContents)
189. M4 = len1 Mod 4
190.
191. If len1 < 1 Or M4 > 0 Then
192. '字符串长度应当是4的倍数
193. Base64decode = ""
194. Exit Function
195. End If
196.
197. '判断最后一位是不是 = 号
198. '判断倒数第二位是不是 = 号
199. '这里m4表示最后剩余的需要单独处理的字符个数
200. If MidB(asContents, len1, 1) = ChrB(64) Then M4 = 3
201. If MidB(asContents, len1 - 1, 1) = ChrB(64) Then M4 = 2
202.
203. If M4 = 0 Then
204. len2 = len1
205. Else
206. len2 = len1 - 4
207. End If
208.
209. For lnPosition = 1 To len2 Step 4
210. lsGroupBinary = ""
211. lsGroup64 = MidB(asContents, lnPosition, 4)
212. Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1
213. Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1
214. Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1
215. Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1
216. Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
217. Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
218. Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
219. lsGroupBinary = Byte1 & Byte2 & Byte3
220.
221. lsResult = lsResult & lsGroupBinary
222. Next
223.
224. '处理最后剩余的几个字符
225. If M4 > 0 Then
226. lsGroupBinary = ""
227. lsGroup64 = MidB(asContents, len2 + 1, M4) & ChrB(65) 'chr(65)=A，转换成值为0
228. If M4 = 2 Then '补足4位，是为了便于计算
229. lsGroup64 = lsGroup64 & ChrB(65)
230. End If
231. Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1
232. Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1
233. Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1
234. Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1
235. Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
236. Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
237. Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
238.
239. If M4 = 2 Then
240. lsGroupBinary = Byte1
241. ElseIf M4 = 3 Then
242. lsGroupBinary = Byte1 & Byte2
243. End If
244.
245. lsResult = lsResult & lsGroupBinary
246. End If
247.
248. Base64decode = lsResult
249.
250. End Function
251.
252.End Class
253.
254.Dim c
255.Set c=New clsCookieX
256.c("mytest")="简体中文abc123"
257.Response.Write c("mytest")
258.
259.Response.Write "<hr>"
260.
261.Response.Write Server.HTMLEncode(Request.ServerVariables("ALL_RAW"))
262.
263.%>
264.
2.<%
3.
4.Class clsCookieX
5.
6. Private ErrMsg,bHasErr
7. Private sBASE_64_CHARACTERS
8.
9. Private Sub Class_Initialize()
10. ErrMsg="":bHasErr=False
11. '打乱的字母表，可以用excel来打乱，这样才能做到加密的效果！
12. sBASE_64_CHARACTERS = "J50Xu1]rf8Gq2agbUSzIMjltP6ZOdnAyVCiNo4TYH3w7vmKRQ[Dk9xWphFELcsBe"
13. sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)
14. End Sub
15. Private Sub Class_Terminate()
16.
17. End Sub
18.
19. Private Sub AddErr(s)
20. ErrMsg=ErrMsg&"Cookie操作出错信息 - "&s&HTML_BR
21. bHasErr=True
22. End Sub
23. Public Function GetErr()
24. GetErr=ErrMsg
25. End Function
26. Public Sub ErrClear()
27. ErrMsg=""
28. bHasErr=False
29. End Sub
30. Public Property Get HasErr()
31. HasErr=bHasErr
32. End Property
33.
34. Public Property Let Item(k,v)
35. Response.Cookies(k)=strAnsi2Unicode(Base64encode(strUnicode2Ansi(v)))
36. End Property
37. Public Default Property Get Item(k)
38. Item=strAnsi2Unicode(Base64decode(strUnicode2Ansi(Request.Cookies(k))))
39. End Property
40.
41. Function strUnicodeLen(asContents)
42. Dim len1, k, i, Asc1, asContents1
43. '计算unicode字符串的Ansi编码的长度
44. asContents1 = "a" & asContents
45. len1 = Len(asContents1)
46. k = 0
47. For i = 1 To len1
48. Asc1 = Asc(Mid(asContents1, i, 1))
49. If Asc1 < 0 Then Asc1 = 65536 + Asc1
50. If Asc1 > 255 Then
51. k = k + 2
52. Else
53. k = k + 1
54. End If
55. Next
56. strUnicodeLen = k - 1
57. End Function
58.
59. Function strUnicode2Ansi(asContents)
60. Dim len1, k, i, Asc1, varchar, varasc, varhex, varlow, varhigh
61. '将Unicode编码的字符串，转换成Ansi编码的字符串
62. strUnicode2Ansi = ""
63. len1 = Len(asContents)
64. For i = 1 To len1
65. varchar = Mid(asContents, i, 1)
66. varasc = Asc(varchar)
67. If varasc < 0 Then varasc = varasc + 65536
68. If varasc > 255 Then
69. varhex = Hex(varasc)
70. varlow = Left(varhex, 2)
71. varhigh = Right(varhex, 2)
72. strUnicode2Ansi = strUnicode2Ansi & ChrB("&H" & varlow) & ChrB("&H" & varhigh)
73. Else
74. strUnicode2Ansi = strUnicode2Ansi & ChrB(varasc)
75. End If
76. Next
77. End Function
78.
79. Function strAnsi2Unicode(asContents)
80. Dim len1, k, i, Asc1, varchar, varasc, varhex, varlow, varhigh
81. '将Ansi编码的字符串，转换成Unicode编码的字符串
82. strAnsi2Unicode = ""
83. len1 = LenB(asContents)
84. If len1 = 0 Then Exit Function
85. For i = 1 To len1
86. varchar = MidB(asContents, i, 1)
87. varasc = AscB(varchar)
88. If varasc > 127 Then
89. strAnsi2Unicode = strAnsi2Unicode & Chr(AscW(MidB(asContents, i + 1, 1) & varchar))
90. i = i + 1
91. Else
92. strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)
93. End If
94. Next
95. End Function
96.
97. Function Base64encode(asContents)
98. '将Ansi编码的字符串进行Base64编码
99. 'asContents应当是ANSI编码的字符串（二进制的字符串也可以）
100. Dim lnPosition
101. Dim lsResult
102. Dim Char1
103. Dim Char2
104. Dim Char3
105. Dim Char4
106. Dim Byte1
107. Dim Byte2
108. Dim Byte3
109. Dim SaveBits1
110. Dim SaveBits2
111. Dim lsGroupBinary
112. Dim lsGroup64
113. Dim M3, len1, len2
114.
115. len1 = LenB(asContents)
116. If len1 < 1 Then
117. Base64encode = ""
118. Exit Function
119. End If
120.
121. M3 = len1 Mod 3
122. If M3 > 0 Then asContents = asContents & String(3 - M3, ChrB(0))
123. '补足位数是为了便于计算
124.
125. If M3 > 0 Then
126. len1 = len1 + (3 - M3)
127. len2 = len1 - 3
128. Else
129. len2 = len1
130. End If
131.
132. lsResult = ""
133.
134. For lnPosition = 1 To len2 Step 3
135. lsGroup64 = ""
136. lsGroupBinary = MidB(asContents, lnPosition, 3)
137.
138. Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
139. Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
140. Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
141.
142. Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
143. Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
144. Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
145. Char4 = MidB(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)
146. lsGroup64 = Char1 & Char2 & Char3 & Char4
147.
148. lsResult = lsResult & lsGroup64
149. Next
150.
151. '处理最后剩余的几个字符
152. If M3 > 0 Then
153. lsGroup64 = ""
154. lsGroupBinary = MidB(asContents, len2 + 1, 3)
155.
156. Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3
157. Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15
158. Byte3 = AscB(MidB(lsGroupBinary, 3, 1))
159.
160. Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)
161. Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)
162. Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)
163.
164. If M3 = 1 Then
165. lsGroup64 = Char1 & Char2 & ChrB(64) & ChrB(64) '用=号补足位数
166. Else
167. lsGroup64 = Char1 & Char2 & Char3 & ChrB(64) '用=号补足位数
168. End If
169.
170. lsResult = lsResult & lsGroup64
171. End If
172.
173. Base64encode = lsResult
174.
175. End Function
176.
177.
178. Function Base64decode(asContents)
179. '将Base64编码字符串转换成Ansi编码的字符串
180. 'asContents应当也是ANSI编码的字符串（二进制的字符串也可以）
181. Dim lsResult
182. Dim lnPosition
183. Dim lsGroup64, lsGroupBinary
184. Dim Char1, Char2, Char3, Char4
185. Dim Byte1, Byte2, Byte3
186. Dim M4, len1, len2
187.
188. len1 = LenB(asContents)
189. M4 = len1 Mod 4
190.
191. If len1 < 1 Or M4 > 0 Then
192. '字符串长度应当是4的倍数
193. Base64decode = ""
194. Exit Function
195. End If
196.
197. '判断最后一位是不是 = 号
198. '判断倒数第二位是不是 = 号
199. '这里m4表示最后剩余的需要单独处理的字符个数
200. If MidB(asContents, len1, 1) = ChrB(64) Then M4 = 3
201. If MidB(asContents, len1 - 1, 1) = ChrB(64) Then M4 = 2
202.
203. If M4 = 0 Then
204. len2 = len1
205. Else
206. len2 = len1 - 4
207. End If
208.
209. For lnPosition = 1 To len2 Step 4
210. lsGroupBinary = ""
211. lsGroup64 = MidB(asContents, lnPosition, 4)
212. Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1
213. Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1
214. Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1
215. Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1
216. Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
217. Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
218. Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
219. lsGroupBinary = Byte1 & Byte2 & Byte3
220.
221. lsResult = lsResult & lsGroupBinary
222. Next
223.
224. '处理最后剩余的几个字符
225. If M4 > 0 Then
226. lsGroupBinary = ""
227. lsGroup64 = MidB(asContents, len2 + 1, M4) & ChrB(65) 'chr(65)=A，转换成值为0
228. If M4 = 2 Then '补足4位，是为了便于计算
229. lsGroup64 = lsGroup64 & ChrB(65)
230. End If
231. Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1
232. Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1
233. Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1
234. Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1
235. Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)
236. Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)
237. Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))
238.
239. If M4 = 2 Then
240. lsGroupBinary = Byte1
241. ElseIf M4 = 3 Then
242. lsGroupBinary = Byte1 & Byte2
243. End If
244.
245. lsResult = lsResult & lsGroupBinary
246. End If
247.
248. Base64decode = lsResult
249.
250. End Function
251.
252.End Class
253.
254.Dim c
255.Set c=New clsCookieX
256.c("mytest")="简体中文abc123"
257.Response.Write c("mytest")
258.
259.Response.Write "<hr>"
260.
261.Response.Write Server.HTMLEncode(Request.ServerVariables("ALL_RAW"))
262.
263.%>
264.
