中文加密解密的BASE64的类

更新时间:2022-03-18
浏览次数:1

<%

Class Base64


Private sBASE_64_CHARACTERS


sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"

sBASE_64_CHARACTERS = strUnicode2Ansi(sBASE_64_CHARACTERS)


Function strUnicodeLen(asContents)

'计算[url=http://www.bbcweb.cn]unicode字符串[/url]的Ansi编码的长度

    asContents1 = "a" & asContents

    len1 = Len(asContents1)

    k = 0

    For i = 1 To len1

        asc1 = Asc(Mid(asContents1, i, 1))

        If asc1 < 0 Then asc1 = 65536 + asc1

        If asc1 > 255 Then

            k = k + 2

        Else

            k = k + 1

        End If

    Next

    strUnicodeLen = k - 1

End Function


Function strUnicode2Ansi(asContents)

    '将Unicode编码的字符串,转换成[url=http://www.bbcweb.cn]Ansi编码[/url]的字符串

    strUnicode2Ansi = ""

    len1 = Len(asContents)

    For i = 1 To len1

        VarChar = Mid(asContents, i, 1)

        varasc = Asc(VarChar)

        If varasc < 0 Then varasc = varasc + 65536

        If varasc > 255 Then

           varHex = Hex(varasc)

           varlow = Left(varHex, 2)

           varhigh = Right(varHex, 2)

           strUnicode2Ansi = strUnicode2Ansi & ChrB("&H" & varlow) & ChrB("&H" & varhigh)

        Else

           strUnicode2Ansi = strUnicode2Ansi & ChrB(varasc)

        End If

     Next

End Function


Function strAnsi2Unicode(asContents)

    '将Ansi编码的字符串,转换成Unicode编码的字符串

    strAnsi2Unicode = ""

    len1 = LenB(asContents)

    If len1 = 0 Then Exit Function

    For i = 1 To len1

        VarChar = MidB(asContents, i, 1)

        varasc = AscB(VarChar)

        If varasc > 127 Then

           strAnsi2Unicode = strAnsi2Unicode & Chr(AscW(MidB(asContents, i + 1, 1) & VarChar))

           i = i + 1

        Else

           strAnsi2Unicode = strAnsi2Unicode & Chr(varasc)

        End If

    Next

End Function


Function Base64Encode(asContents)

    '将Ansi编码的字符串进行Base64编码

    'asContents应当是ANSI编码的字符串(二进制的字符串也可以)

    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

    Dim M4, len1, len2

    

    len1 = LenB(asContents)

    If len1 < 1 Then

       Base64Encode = ""

       Exit Function

    End If

    

    M3 = len1 Mod 3

    If M3 > 0 Then asContents = asContents & String(3 - M3, ChrB(0))

    '补足位数是为了便于计算

    

    If M3 > 0 Then

       len1 = len1 + (3 - M3)

       len2 = len1 - 3

    Else

       len2 = len1

    End If

    

    lsResult = ""

    

    For lnPosition = 1 To len2 Step 3

        lsGroup64 = ""

        lsGroupBinary = MidB(asContents, lnPosition, 3)

    

        Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3

        Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15

        Byte3 = AscB(MidB(lsGroupBinary, 3, 1))

    

        Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)

        Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)

        Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)

        Char4 = MidB(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1)

        lsGroup64 = Char1 & Char2 & Char3 & Char4

        

        lsResult = lsResult & lsGroup64

    Next

    

    '处理最后剩余的几个字符

    If M3 > 0 Then

        lsGroup64 = ""

        lsGroupBinary = MidB(asContents, len2 + 1, 3)

    

        Byte1 = AscB(MidB(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3

        Byte2 = AscB(MidB(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15

        Byte3 = AscB(MidB(lsGroupBinary, 3, 1))

    

        Char1 = MidB(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1)

        Char2 = MidB(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1)

        Char3 = MidB(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1)

    

        If M3 = 1 Then

           lsGroup64 = Char1 & Char2 & ChrB(61) & ChrB(61)   '用=号补足位数

        Else

           lsGroup64 = Char1 & Char2 & Char3 & ChrB(61)      '用=号补足位数

        End If

        

        lsResult = lsResult & lsGroup64

    End If

    

    Base64Encode = lsResult


End Function


Function Base64Decode(asContents)

    '将Base64编码字符串转换成Ansi编码的字符串

    'asContents应当也是ANSI编码的字符串(二进制的字符串也可以)

    Dim lsResult

    Dim lnPosition

    Dim lsGroup64, lsGroupBinary

    Dim Char1, Char2, Char3, Char4

    Dim Byte1, Byte2, Byte3

    Dim M4, len1, len2

    

    len1 = LenB(asContents)

    M4 = len1 Mod 4

    

    If len1 < 1 Or M4 > 0 Then

       '字符串长度应当是4的倍数

       Base64Decode = ""

       Exit Function

    End If

           

    '判断最后一位是不是 = 号

    '判断倒数第二位是不是 = 号

    '这里m4表示最后剩余的需要单独处理的字符个数

    If MidB(asContents, len1, 1) = ChrB(61) Then M4 = 3

    If MidB(asContents, len1 - 1, 1) = ChrB(61) Then M4 = 2

    

    If M4 = 0 Then

       len2 = len1

    Else

       len2 = len1 - 4

    End If

    

    For lnPosition = 1 To len2 Step 4

        lsGroupBinary = ""

        lsGroup64 = MidB(asContents, lnPosition, 4)

        Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1

        Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1

        Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1

        Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1

        Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)

        Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)

        Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))

        lsGroupBinary = Byte1 & Byte2 & Byte3

        

        lsResult = lsResult & lsGroupBinary

    Next

    

    '处理最后剩余的几个字符

    If M4 > 0 Then

        lsGroupBinary = ""

        lsGroup64 = MidB(asContents, len2 + 1, M4) & ChrB(65) 'chr(65)=A,转换成值为0

        If M4 = 2 Then                                        '补足4位,是为了便于计算

            lsGroup64 = lsGroup64 & ChrB(65)

        End If

        Char1 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 1, 1)) - 1

        Char2 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 2, 1)) - 1

        Char3 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 3, 1)) - 1

        Char4 = InStrB(sBASE_64_CHARACTERS, MidB(lsGroup64, 4, 1)) - 1

        Byte1 = ChrB(((Char2 And 48) \ 16) Or (Char1 * 4) And &HFF)

        Byte2 = lsGroupBinary & ChrB(((Char3 And 60) \ 4) Or (Char2 * 16) And &HFF)

        Byte3 = ChrB((((Char3 And 3) * 64) And &HFF) Or (Char4 And 63))

      

        If M4 = 2 Then

           lsGroupBinary = Byte1

        ElseIf M4 = 3 Then

           lsGroupBinary = Byte1 & Byte2

        End If

        

        lsResult = lsResult & lsGroupBinary

    End If

    

    Base64Decode = lsResult


End Function


End Class

%>[/size]


调用方法:

以下是代码:


Dim clsBase64

Set clsBase64 = New Base64


str = "[url=http://www.bbcweb.cn]测试[/url]"

Response.write("编码前:" & str)

str = Base64.Base64Encode(str) '编码

Response.write("编码后:" & str)

str = Base64.Base64Decode(str) '解码

Response.write("解码后:" & str)


Set clsBase64 = Nothing


最新发布
基于SPRINGBOOT开发的JAVA车辆派车管理系统
thinkphp6实现微信V3服务商支付接口
初探温湿度监控系统
再谈MYSQL8.0保存微信表情昵称失败
网站定位方法
重组汽车管理系统
汽车派遣小程序增加用车单撤销
中文加密解密的BASE64的类
Window.Open详解
企业网站防止网页病毒和木马技巧
热门阅读
单位车辆管理系统解决方案

2022年汽车维修管理系统免费V1.0试用

免费汽车维修管理系统,配件出入库管理,维修单据录入和打印,客户管理,财务管理

车辆派车小程序基础版发布

打开手机微信小程序搜索“派车堂”或扫太阳码码进入小程序

保存到数据库前替换空格/回车

在没使用框架的小项目中,很多函数需要自己处理。数据入库部分是很重要的一环,防止SQL注入要过滤很多字符。 If Not IsNull(fString) Then fString = trim(fString) 'fString = replace(fString, ";", ";") '分号过滤 fString = replace(fString, "--", "——") '--过滤 fString = replace(fString, "%20", "") '特殊字符过滤 fString = replace(fString, "==", "") '==过滤 'fString = replace(fString, ">", ">") 'fString = replace(fString, "<", "<") fString = Replace(fString, CHR(32), " ") ' fString = Replace(fString, CHR(9), " ") ' fString = Replace(fString, CHR(34), """) fString = Replace(fString, CHR(39), "'") '单引号过滤 fString = Replace(fString, CHR(13), "") fString = Replace(fString, CHR(10) & CHR(10), "</P><P>") fString = Replace(fString, CHR(10), "<BR>") changechr = fString End If End Function

工厂生产订单管理系统

电脑,微信小程序都能访问,系统支持自动核算成本,业绩统计,订单拆分下单

车辆维修(汽修)系统使用手册

汽车维修子系统使用手册说明文档

sqlserver重置自增ID列从1开始

在测试程序过程中删除数据,表需要重置自增ID列从1开始

供应链(报单)订单管理系统V1上线

支持电脑下单,手机小程序下单,订单持久化保存在服务器不丢失,报单分单给不同供货商,数据图形化统计,数据导出,微信扫码分享订单详情

利用MySQL加密函数保护Web网站的敏感数据

假如你正在运行使用MySQL的Web应用程序,那么你把密码或者其他敏感信息保存在应用程序里的机会就很大。

汽车派遣小程序增加用车单撤销

此时由于申请单处于待审批状态,车辆锁住中,其他人员不能申请该辆车,造成时间上的浪费。

微信扫以下二维码添加好友咨询