设为首页收藏本站Access中国
开启辅助访问 切换到宽版

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步，快速开始

Office中国论坛/Access中国论坛»论坛首页 › Access 资料区 › Access源码 › HackVBASpeed 之进制转换,之二进制转十六进制. 极限速度
返回列表 发新帖
查看: 2422|回复: 5
打印 上一主题 下一主题

[模块/函数] HackVBASpeed 之进制转换,之二进制转十六进制. 极限速度

[复制链接]
wang1999
跳转到指定楼层
1#
发表于 2015-8-25 18:53:20 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 wang1999 于 2015-8-25 19:05 编辑

这是我刚开始学VBA时写的, 结构清晰, 看着清爽. 还算不错. 只是性能方面，现在看来不敢恭维。
  1. Public Function BinToHex(ByVal Bin As String) As String
  2.     Dim i As Long
  3.     i = Len(Bin) Mod 4
  4.     If i <> 0 Then  '按每组4个二进制字符配齐
  5.         Bin = String(4 - i, "0") & Bin
  6.     End If
  7.     For i = 1 To Len(Bin) Step 4
  8.         Select Case Mid$(Bin, i, 4)
  9.         Case "0000": BinToHex = BinToHex & "0"
  10.         Case "0001": BinToHex = BinToHex & "1"
  11.         Case "0010": BinToHex = BinToHex & "2"
  12.         Case "0011": BinToHex = BinToHex & "3"
  13.         Case "0100": BinToHex = BinToHex & "4"
  14.         Case "0101": BinToHex = BinToHex & "5"
  15.         Case "0110": BinToHex = BinToHex & "6"
  16.         Case "0111": BinToHex = BinToHex & "7"
  17.         Case "1000": BinToHex = BinToHex & "8"
  18.         Case "1001": BinToHex = BinToHex & "9"
  19.         Case "1010": BinToHex = BinToHex & "A"
  20.         Case "1011": BinToHex = BinToHex & "B"
  21.         Case "1100": BinToHex = BinToHex & "C"
  22.         Case "1101": BinToHex = BinToHex & "D"
  23.         Case "1110": BinToHex = BinToHex & "E"
  24.         Case "1111": BinToHex = BinToHex & "F"
  25.         End Select
  26.     Next
  27. End Function
复制代码


下面这个是我的VBA最终版,带错误检查, 带占位符的. 测后速度 191967.953

Public Function BinToHexV5(BinString As String, Optional ByVal Places As Long = 8) As String
    Dim i As Long, lLen As Long
    Static sacurBinStr(1 To 8) As Currency, aiRetStr(1 To 8) As Integer, sai0Str(1 To 8) As Integer
   
    '//1.初始化
    '初始化字符串=8个"0"    '判断语句不作比较时, Integer 比 long 要快
    If sai0Str(1) Then Else sai0Str(1) = 48: sai0Str(2) = 48: sai0Str(3) = 48: sai0Str(4) = 48: sai0Str(5) = 48: sai0Str(6) = 48: sai0Str(7) = 48: sai0Str(8) = 48
    CopyMem16 aiRetStr(1), sai0Str(1)
    '参数检查
    lLen = LenB(BinString)      '后面复制时单位为字节, 所以为 LenB
    If lLen > 64& Then Err.Raise erCom + 3, "BinToHex", "参数过长": Exit Function
    If lLen = 0& Then Err.Raise erCom + 4, "BinToHex", "空参数": Exit Function
    i = (lLen + 7&) \ 8&    '取得 BinString 的16进制最高位的位置
    If Places < 1& Or Places > 8& Then Places = i      '超出范围时, 重定占位长度
    '复制 参数(BinString)到数组; VarPtr(sacurBinStr(8)) - lLen + 8: 字节对齐;
    sacurBinStr(9 - i) = 1351100504368.7472@   '="0000", 将 BinString 按4位一组在高位补齐前导"0"字符串
    MoveMemoryPtr2Ptr VarPtr(sacurBinStr(8)) - lLen + 8, BinString, lLen
   
    '//2.转换数据. 遍历字符串, 从高位开始转换;     '处理 Places, 如果设置长度过小或过大, 则输出实际位数
    For i = 9 - i To 8
        Select Case sacurBinStr(i)
        Case 1351100504368.7472@    '0000
            aiRetStr(i) = 48   ' "0"
        Case 1379248002039.8128@    '0001
            aiRetStr(i) = 49   ' "1"
        Case 1351100933865.4768@    '0010
            aiRetStr(i) = 50   ' "2"
        Case 1379248431536.5424@    '0011
            aiRetStr(i) = 51   ' "3"
        Case 1351100504375.3008@    '0100
            aiRetStr(i) = 52   ' "4"
        Case 1379248002046.3664@    '0101
            aiRetStr(i) = 53   ' "5"
        Case 1351100933872.0304@    '0110
            aiRetStr(i) = 54   ' "6"
        Case 1379248431543.096@    '0111
            aiRetStr(i) = 55   ' "7"
        Case 1351100504368.7473@    '1000
            aiRetStr(i) = 56   ' "8"
        Case 1379248002039.8129@    '1001
            aiRetStr(i) = 57   ' "9"
        Case 1351100933865.4769@    '1010
            aiRetStr(i) = 65   ' "A"
        Case 1379248431536.5425@    '1011
            aiRetStr(i) = 66   ' "B"
        Case 1351100504375.3009@    '1100
            aiRetStr(i) = 67   ' "C"
        Case 1379248002046.3665@    '1101
            aiRetStr(i) = 68   ' "D"
        Case 1351100933872.0305@    '1110
            aiRetStr(i) = 69   ' "E"
        Case 1379248431543.0961@    '1111
            aiRetStr(i) = 70   ' "F"
        Case Else
            Err.Raise erCom + 5, "BinToHexV5", "类型不符合":  Exit Function
        End Select
    Next
    '返回数据
    BinToHexV5 = SysAllocStringLen(aiRetStr(1), Places)
End Function


分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
回复

使用道具 举报

wang1999
2#
 楼主| 发表于 2015-8-25 19:11:11 | 只看该作者
这个是重写, 速度十万次 172686.836 微秒,  是一楼的5倍速
不含调用开销为:
843,929
172,077
671,852
0.20389965
4.90437329
  1. Public Function BinToHexV3(BinString As String) As String
  2.     Dim i As Long, lLen As Long
  3.     Static sacurData(7) As Currency, sData(7) As Integer
  4.    
  5.     '//1.初始化
  6.     lLen = LenB(BinString)
  7.     If lLen <= 64& Then Else Err.Raise erCom + 3, "BinToDecN1", "参数过长": Exit Function
  8.     If lLen <> 0& Then Else Err.Raise erCom + 4, "BinToDecN1", "空参数": Exit Function
  9.     '复制二进制字符串到数组; (64& - lLen) Mod 8&: 字节对齐
  10.     sacurData(0) = 1351100504368.7472@      '字符串: 0000
  11.     MoveMemoryPtr2Ptr VarPtr(sacurData(0)) + (64& - lLen) Mod 8&, BinString, lLen
  12.    
  13.     '//2.转换数据. 遍历字符串, 从未尾(低位)开始转换
  14.     lLen = (lLen - 2) \ 8
  15.     For i = lLen To 0 Step -1
  16.         Select Case sacurData(i)
  17.         Case 1351100504368.7472@    '0000
  18.             sData(i) = 48   ' "0"
  19.         Case 1379248002039.8128@    '0001
  20.             sData(i) = 49   ' "1"
  21.         Case 1351100933865.4768@    '0010
  22.             sData(i) = 50   ' "2"
  23.         Case 1379248431536.5424@    '0011
  24.             sData(i) = 51   ' "3"
  25.         Case 1351100504375.3008@    '0100
  26.             sData(i) = 52   ' "4"
  27.         Case 1379248002046.3664@    '0101
  28.             sData(i) = 53   ' "5"
  29.         Case 1351100933872.0304@    '0110
  30.             sData(i) = 54   ' "6"
  31.         Case 1379248431543.096@    '0111
  32.             sData(i) = 55   ' "7"
  33.         Case 1351100504368.7473@    '1000
  34.             sData(i) = 56   ' "8"
  35.         Case 1379248002039.8129@    '1001
  36.             sData(i) = 57   ' "9"
  37.         Case 1351100933865.4769@    '1010
  38.             sData(i) = 65   ' "A"
  39.         Case 1379248431536.5425@    '1011
  40.             sData(i) = 66   ' "B"
  41.         Case 1351100504375.3009@    '1100
  42.             sData(i) = 67   ' "C"
  43.         Case 1379248002046.3665@    '1101
  44.             sData(i) = 68   ' "D"
  45.         Case 1351100933872.0305@    '1110
  46.             sData(i) = 69   ' "E"
  47.         Case 1379248431543.0961@    '1111
  48.             sData(i) = 70   ' "F"
  49.         Case Else:
  50.             Debug.Assert False  '错误
  51.         End Select
  52.     Next
  53.    
  54.     BinToHexV3 = SysAllocStringByteLen(ByVal SafeArrayDataPtr(sData), (lLen + 1) * 2)
  55. End Function
复制代码


回复 支持 反对

使用道具 举报

wang1999
3#
 楼主| 发表于 2015-8-25 19:30:44 | 只看该作者
再后来又用C重写了一个API. TLB调用,
速度对比一楼发现提升了70倍.
数据如下
测试代码开销函数开销　实际开销　　时间比　
VBA
C
VBA
C
VBA
C
差值
函数1/函数2
函数2/函数1
610
610
844,539
12,609
843,929
11,999
831,930
0.01421772
70.334764

VBA下执行转换仅0.012微秒

后来反汇编跟进, 原来VBA中一句代码的执行,后台VBE执行的指令尼玛有上百条. 怪不得VBA这么方便. VBE在后台辛勤把活干.

不过也牺牲了性能. 如果都带这样提升近百倍, 你们说这每年电费要省多少.(尤其现在好多网页还有手机上的APP, 性能方面做得真垃圾, 我估计他们都是利用现成的直接拼装)


回复 支持 反对

使用道具 举报

tmtony

点击这里给我发消息
4#
发表于 2015-8-26 10:19:15 | 只看该作者
赞一个！很好的对比文章
回复 支持 反对

使用道具 举报

t小宝

点击这里给我发消息
5#
发表于 2015-8-26 12:09:44 | 只看该作者
学习！
回复

使用道具 举报

yanwei82123300
6#
发表于 2015-8-26 16:20:50 | 只看该作者
学习一下再说
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 12:38 , Processed in 0.080322 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表