本页主题: Base64和MD5加密 打印 | 加为IE收藏 | 复制链接 | 收藏主题 | 上一主题 | 下一主题

haimin350
级别: 侠客


精华: 1
发帖: 110
威望: 174 点
VB币: 997 个
贡献值: 0 点
在线时间:10(小时)
注册时间:2008-03-22
最后登录:2008-08-07

 Base64和MD5加密



Base64加解密和MD5加密
附件: 加解密.rar (7 K) 下载次数:50
本帖最近评分记录:
  • 金钱:+3(masteryam) 辛苦了
  • 金钱:+5(masteryam) 辛苦了
  • 威望:+5(masteryam) 原创内容-感谢您的付出!
  • 想要源码的给点思路
    想要思路的给点源码
    kovb@qq.com
    Posted: 2008-04-22 07:15 | [楼 主]
    haimin350
    级别: 侠客


    精华: 1
    发帖: 110
    威望: 174 点
    VB币: 997 个
    贡献值: 0 点
    在线时间:10(小时)
    注册时间:2008-03-22
    最后登录:2008-08-07

     

    在网上搜到了精简版的base64加解密,以下是原文

    上次因为要编写自动登录邮箱的程序,需要Base64编码,但是我看了几种版本的VB下Base64编码的程序,发现要么就是太冗长,要么就是不支持中文,要么根本不能用,于是我想求人不如求己,便仔细研究了一下Base64编码原理,然后编写了这段程序,在电脑上调试通过,可以顺利进行Base64编码/解码,速度也快。现在拿出来分享给大家,希望对大家有所帮助。若有Bug请与我联系:hzh932@gmail.com

    程序模块:

    Option Explicit
    Private Const cstBase64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Private arrBase64() As String
    '作者:同济黄正 引用请注明出处:http://hz932.ys168.com
    '00100001 00100001 00100001            --源码
    '00001000 00010010 00000100 00100001    --Base64码

    Public Function Base64Encode(strSource As String) As String
    On Error Resume Next
    '适用于中、英文的Base64编码/解码VB6超精简版 作者:同济黄正 引用请注明出处:http://hz932.ys168.com
    If UBound(arrBase64) = -1 Then
        arrBase64 = Split(StrConv(cstBase64, vbUnicode), vbNullChar)
    End If
    Dim arrB() As Byte, bTmp(2)  As Byte, bT As Byte
    Dim I As Long, J As Long
    arrB = StrConv(strSource, vbFromUnicode)

    J = UBound(arrB)
    For I = 0 To J Step 3
        Erase bTmp
        bTmp(0) = arrB(I + 0)
        bTmp(1) = arrB(I + 1)
        bTmp(2) = arrB(I + 2)
       
        bT = (bTmp(0) And 252) / 4
        Base64Encode = Base64Encode & arrBase64(bT)
       
        bT = (bTmp(0) And 3) * 16
        bT = bT + bTmp(1) \ 16
        Base64Encode = Base64Encode & arrBase64(bT)
       
        bT = (bTmp(1) And 15) * 4
        bT = bT + bTmp(2) \ 64
        If I + 1 <= J Then
            Base64Encode = Base64Encode & arrBase64(bT)
        Else
            Base64Encode = Base64Encode & "="
        End If
       
        bT = bTmp(2) And 63
        If I + 2 <= J Then
            Base64Encode = Base64Encode & arrBase64(bT)
        Else
            Base64Encode = Base64Encode & "="
        End If
    Next
    End Function

    Public Function Base64Decode(strEncoded As String) As String
    '适用于中、英文的Base64编码/解码VB6超精简版 作者:同济黄正 引用请注明出处:http://hz932.ys168.com
    On Error Resume Next
    Dim arrB() As Byte, bTmp(3)  As Byte, bT, bRet() As Byte
    Dim I As Long, J As Long
    arrB = StrConv(strEncoded, vbFromUnicode)
    J = InStr(strEncoded & "=", "=") - 2
    ReDim bRet(J - J \ 4 - 1)
    For I = 0 To J Step 4
        Erase bTmp
        bTmp(0) = (InStr(cstBase64, Chr(arrB(I))) - 1) And 63
        bTmp(1) = (InStr(cstBase64, Chr(arrB(I + 1))) - 1) And 63
        bTmp(2) = (InStr(cstBase64, Chr(arrB(I + 2))) - 1) And 63
        bTmp(3) = (InStr(cstBase64, Chr(arrB(I + 3))) - 1) And 63
       
        bT = bTmp(0) * 2 ^ 18 + bTmp(1) * 2 ^ 12 + bTmp(2) * 2 ^ 6 + bTmp(3)
       
        bRet((I \ 4) * 3) = bT \ 65536
        bRet((I \ 4) * 3 + 1) = (bT And 65280) \ 256
        bRet((I \ 4) * 3 + 2) = bT And 255
    Next
    Base64Decode = StrConv(bRet, vbUnicode)
    End Function

    该文章转载自网络大本营:http://www.xrss.cn/Dev/VB/200783016258.Html
    想要源码的给点思路
    想要思路的给点源码
    kovb@qq.com
    Posted: 2008-05-11 17:55 | 1 楼
    eiuv
    级别: 新手上路


    精华: 0
    发帖: 13
    威望: 24 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:0(小时)
    注册时间:2008-06-14
    最后登录:2008-06-14

     

    正想找这个看看
    Posted: 2008-06-14 17:22 | 2 楼
    eiuv
    级别: 新手上路


    精华: 0
    发帖: 13
    威望: 24 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:0(小时)
    注册时间:2008-06-14
    最后登录:2008-06-14

     

    不知道怎么用呀
    Posted: 2008-06-14 17:25 | 3 楼
    verinn
    级别: 新手上路


    精华: 0
    发帖: 1
    威望: 2 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:0(小时)
    注册时间:2008-07-05
    最后登录:2008-07-05

     

    下载下来试试看
    Posted: 2008-07-05 21:15 | 4 楼
    now1000
    我是a'Gao
    级别: 论坛版主


    精华: 0
    发帖: 126
    威望: 137 点
    VB币: 47 个
    贡献值: 0 点
    在线时间:12(小时)
    注册时间:2008-06-21
    最后登录:2008-10-07

     

    晕了
    许多事情都是注定的!
    Posted: 2008-07-23 15:52 | 5 楼
    students1
    级别: 新手上路


    精华: 0
    发帖: 19
    威望: 20 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:2(小时)
    注册时间:2008-07-24
    最后登录:2008-10-08

     

    good~下載學習
    Posted: 2008-07-24 22:56 | 6 楼
    students1
    级别: 新手上路


    精华: 0
    发帖: 19
    威望: 20 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:2(小时)
    注册时间:2008-07-24
    最后登录:2008-10-08

     

    good~下載學習
    Posted: 2008-09-11 00:37 | 7 楼
    students1
    级别: 新手上路


    精华: 0
    发帖: 19
    威望: 20 点
    VB币: 0 个
    贡献值: 0 点
    在线时间:2(小时)
    注册时间:2008-07-24
    最后登录:2008-10-08

     

    图片:
    Click Here To EnLarge
    图片:
    Click Here To EnLarge
    Posted: 2008-09-11 01:34 | 8 楼
    帖子浏览记录 版块浏览记录
    VB家园 » 『VB原创作品&源程序』



    中华人民共和国信息产业部许可证编号:粤ICP备08023639号 
    Powered by PHPWind v6.0 Certificate Code © 2003-07 PHPWind.com Corporation