加密函数：

<%const sbase_64_characters = "abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz0123456789+/"
function base64encode(byval ascontents)
dim lnposition
dim lsresult
dim char1
dim char2
dim char3
dim char4
dim byte1
dim byte2
dim byte3
dim savebits1
dim savebits2
dim lsgroupbinary
dim lsgroup64
if len(ascontents) mod 3 > 0 then ascontents = ascontents & string(3 - (len(ascontents) mod 3), " ")
lsresult = ""
for lnposition = 1 to len(ascontents) step 3
lsgroup64 = ""
lsgroupbinary = mid(ascontents, lnposition, 3)
byte1 = asc(mid(lsgroupbinary, 1, 1)): savebits1 = byte1 and 3
byte2 = asc(mid(lsgroupbinary, 2, 1)): savebits2 = byte2 and 15
byte3 = asc(mid(lsgroupbinary, 3, 1))
char1 = mid(sbase_64_characters, ((byte1 and 252) \ 4) + 1, 1)
char2 = mid(sbase_64_characters, (((byte2 and 240) \ 16) or (savebits1 * 16) and &hff) + 1, 1)
char3 = mid(sbase_64_characters, (((byte3 and 192) \ 64) or (savebits2 * 4) and &hff) + 1, 1)
char4 = mid(sbase_64_characters, (byte3 and 63) + 1, 1)
lsgroup64 = char1 & char2 & char3 & char4
lsresult = lsresult + lsgroup64
next
base64encode = lsresult
end function
response.write base64encode("abck")
%>

<%''''加密解密

' Functions to provide encoding/decoding of strings with Base64.
'
' Encoding: myEncodedString = base64_encode( inputString )
' Decoding: myDecodedString = base64_decode( encodedInputString )
'
' Programmed by Markus Hartsmar for ShameDesigns in 2002.
' Email me at: mark@shamedesigns.com
' Visit our website at: http://www.shamedesigns.com/
'

Dim Base64Chars
Base64Chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" & _
"abcdefghijklmnopqrstuvwxyz" & _
"0123456789" & _
"+/"

' Functions for encoding string to Base64
Public Function base64_encode( byVal strIn )
Dim c1, c2, c3, w1, w2, w3, w4, n, strOut
For n = 1 To Len( strIn ) Step 3
c1 = Asc( Mid( strIn, n, 1 ) )
c2 = Asc( Mid( strIn, n + 1, 1 ) + Chr(0) )
c3 = Asc( Mid( strIn, n + 2, 1 ) + Chr(0) )
w1 = Int( c1 / 4 ) : w2 = ( c1 And 3 ) * 16 + Int( c2 / 16 )
If Len( strIn ) >= n + 1 Then
w3 = ( c2 And 15 ) * 4 + Int( c3 / 64 )
Else
w3 = -1
End If
If Len( strIn ) >= n + 2 Then
w4 = c3 And 63
Else
w4 = -1
End If
strOut = strOut + mimeencode( w1 ) + mimeencode( w2 ) + _
mimeencode( w3 ) + mimeencode( w4 )
Next
base64_encode = strOut
End Function

Private Function mimeencode( byVal intIn )
If intIn >= 0 Then
mimeencode = Mid( Base64Chars, intIn + 1, 1 )
Else
mimeencode = ""
End If
End Function

' Function to decode string from Base64
Public Function base64_decode( byVal strIn )
Dim w1, w2, w3, w4, n, strOut
For n = 1 To Len( strIn ) Step 4
w1 = mimedecode( Mid( strIn, n, 1 ) )
w2 = mimedecode( Mid( strIn, n + 1, 1 ) )
w3 = mimedecode( Mid( strIn, n + 2, 1 ) )
w4 = mimedecode( Mid( strIn, n + 3, 1 ) )
If w2 >= 0 Then _
strOut = strOut + _
Chr( ( ( w1 * 4 + Int( w2 / 16 ) ) And 255 ) )
If w3 >= 0 Then _
strOut = strOut + _
Chr( ( ( w2 * 16 + Int( w3 / 4 ) ) And 255 ) )
If w4 >= 0 Then _
strOut = strOut + _
Chr( ( ( w3 * 64 + w4 ) And 255 ) )
Next
base64_decode = strOut
End Function

Private Function mimedecode( byVal strIn )
If Len( strIn ) = 0 Then
mimedecode = -1 : Exit Function
Else
mimedecode = InStr( Base64Chars, strIn ) - 1
End If
End Function

%>

不能加密中文，对此做了一点修改，可以加密任何字符了，效率非常高

<%
OPTION EXPLICIT
const BASE_64_MAP_INIT = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
dim newline
dim Base64EncMap(63)
dim Base64DecMap(127)
'初始化函数
PUBLIC SUB initCodecs()
' 初始化变量
newline = "<P>" & chr(13) & chr(10)
dim max, idx
max = len(BASE_64_MAP_INIT)
for idx = 0 to max - 1
Base64EncMap(idx) = mid(BASE_64_MAP_INIT, idx + 1, 1)
next
for idx = 0 to max - 1
Base64DecMap(ASC(Base64EncMap(idx))) = idx
next
END SUB
'Base64加密函数
PUBLIC FUNCTION base64Encode(plain)
if len(plain) = 0 then
base64Encode = ""
exit function
end if
plain=enasc(plain)
dim ret, ndx, by3, first, second, third
by3 = (len(plain) \ 3) * 3
ndx = 1
do while ndx <= by3
first = asc(mid(plain, ndx+0, 1))
second = asc(mid(plain, ndx+1, 1))
third = asc(mid(plain, ndx+2, 1))
ret = ret & Base64EncMap( (first \ 4) AND 63 )
ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )
ret = ret & Base64EncMap( ((second * 4) AND 60) + ((third \ 64) AND 3 ) )
ret = ret & Base64EncMap( third AND 63)
ndx = ndx + 3
loop
if by3 < len(plain) then
first = asc(mid(plain, ndx+0, 1))
ret = ret & Base64EncMap( (first \ 4) AND 63 )
if (len(plain) MOD 3 ) = 2 then
second = asc(mid(plain, ndx+1, 1))
ret = ret & Base64EncMap( ((first * 16) AND 48) + ((second \ 16) AND 15 ) )
ret = ret & Base64EncMap( ((second * 4) AND 60) )
else
ret = ret & Base64EncMap( (first * 16) AND 48)
ret = ret '& "="
end if
ret = ret '& "="
end if
base64Encode = ret
END FUNCTION
'Base64解密函数
PUBLIC FUNCTION base64Decode(scrambled)
if len(scrambled) = 0 then
base64Decode = ""
exit function
end if
dim realLen
realLen = len(scrambled)
do while mid(scrambled, realLen, 1) = "="
realLen = realLen - 1
loop
dim ret, ndx, by4, first, second, third, fourth
ret = ""
by4 = (realLen \ 4) * 4
ndx = 1
do while ndx <= by4
first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))
second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))
third = Base64DecMap(asc(mid(scrambled, ndx+2, 1)))
fourth = Base64DecMap(asc(mid(scrambled, ndx+3, 1)))
ret = ret & chr( ((first * 4) AND 255) + ((second \ 16) AND 3))
ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))
ret = ret & chr( ((third * 64) AND 255) + (fourth AND 63))
ndx = ndx + 4
loop
if ndx < realLen then
first = Base64DecMap(asc(mid(scrambled, ndx+0, 1)))
second = Base64DecMap(asc(mid(scrambled, ndx+1, 1)))
ret = ret & chr( ((first * 4) AND 255) + ((second \ 16) AND 3))
if realLen MOD 4 = 3 then
third = Base64DecMap(asc(mid(scrambled,ndx+2,1)))
ret = ret & chr( ((second * 16) AND 255) + ((third \ 4) AND 15))
end if
end if
base64Decode = deasc(ret)
END FUNCTION

function enasc(str)
dim str_len,i,str_a,str_b,str_res
str_len=len(str)
if str_len<>0 then
for i=1 to str_len
str_a=mid(str,i,1)
str_b=ASC(str_a)
str_res=str_res & "," & str_b
next
end if
enasc=str_res
end function

function deasc(str)
dim str_len,i,str_a,str_b,str_res,str_v
str_len=len(str)
if str_len<>0 then
str_v=split(str,",")
for i=1 to ubound(str_v)
str_a=chr(str_v(i))
str_res=str_res & str_a
next
end if
deasc=str_res
end function

' 初始化
call initCodecs
' 测试代码
' dim inp, encode
' inp = "中国"
' response.write "加密前为:" & inp & newline
' encode = base64Encode(inp)
' response.write "加密后为:" & encode & newline
' response.write "解密后为:" & base64Decode(encode) & newline

%>