HackVBASpeed 之进制转换,之二进制转十六进制. 极限速度

wang1999 · 发表于 2015-8-25 18:53:20

本帖最后由 wang1999 于 2015-8-25 19:05 编辑

这是我刚开始学VBA时写的, 结构清晰, 看着清爽. 还算不错. 只是性能方面，现在看来不敢恭维。

Public Function BinToHex(ByVal Bin As String) As String
Dim i As Long
i = Len(Bin) Mod 4
If i <> 0 Then '按每组4个二进制字符配齐
Bin = String(4 - i, "0") & Bin
End If
For i = 1 To Len(Bin) Step 4
Select Case Mid$(Bin, i, 4)
Case "0000": BinToHex = BinToHex & "0"
Case "0001": BinToHex = BinToHex & "1"
Case "0010": BinToHex = BinToHex & "2"
Case "0011": BinToHex = BinToHex & "3"
Case "0100": BinToHex = BinToHex & "4"
Case "0101": BinToHex = BinToHex & "5"
Case "0110": BinToHex = BinToHex & "6"
Case "0111": BinToHex = BinToHex & "7"
Case "1000": BinToHex = BinToHex & "8"
Case "1001": BinToHex = BinToHex & "9"
Case "1010": BinToHex = BinToHex & "A"
Case "1011": BinToHex = BinToHex & "B"
Case "1100": BinToHex = BinToHex & "C"
Case "1101": BinToHex = BinToHex & "D"
Case "1110": BinToHex = BinToHex & "E"
Case "1111": BinToHex = BinToHex & "F"
End Select
Next
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

wang1999 · 发表于 2015-8-25 19:11:11

这个是重写, 速度十万次 172686.836 微秒, 是一楼的5倍速
不含调用开销为:

843,929

172,077

671,852

0.20389965

4.90437329

Public Function BinToHexV3(BinString As String) As String
Dim i As Long, lLen As Long
Static sacurData(7) As Currency, sData(7) As Integer
'//1.初始化
lLen = LenB(BinString)
If lLen <= 64& Then Else Err.Raise erCom + 3, "BinToDecN1", "参数过长": Exit Function
If lLen <> 0& Then Else Err.Raise erCom + 4, "BinToDecN1", "空参数": Exit Function
'复制二进制字符串到数组; (64& - lLen) Mod 8&: 字节对齐
sacurData(0) = 1351100504368.7472@ '字符串: 0000
MoveMemoryPtr2Ptr VarPtr(sacurData(0)) + (64& - lLen) Mod 8&, BinString, lLen
'//2.转换数据. 遍历字符串, 从未尾(低位)开始转换
lLen = (lLen - 2) \ 8
For i = lLen To 0 Step -1
Select Case sacurData(i)
Case 1351100504368.7472@ '0000
sData(i) = 48 ' "0"
Case 1379248002039.8128@ '0001
sData(i) = 49 ' "1"
Case 1351100933865.4768@ '0010
sData(i) = 50 ' "2"
Case 1379248431536.5424@ '0011
sData(i) = 51 ' "3"
Case 1351100504375.3008@ '0100
sData(i) = 52 ' "4"
Case 1379248002046.3664@ '0101
sData(i) = 53 ' "5"
Case 1351100933872.0304@ '0110
sData(i) = 54 ' "6"
Case 1379248431543.096@ '0111
sData(i) = 55 ' "7"
Case 1351100504368.7473@ '1000
sData(i) = 56 ' "8"
Case 1379248002039.8129@ '1001
sData(i) = 57 ' "9"
Case 1351100933865.4769@ '1010
sData(i) = 65 ' "A"
Case 1379248431536.5425@ '1011
sData(i) = 66 ' "B"
Case 1351100504375.3009@ '1100
sData(i) = 67 ' "C"
Case 1379248002046.3665@ '1101
sData(i) = 68 ' "D"
Case 1351100933872.0305@ '1110
sData(i) = 69 ' "E"
Case 1379248431543.0961@ '1111
sData(i) = 70 ' "F"
Case Else:
Debug.Assert False '错误
End Select
Next
BinToHexV3 = SysAllocStringByteLen(ByVal SafeArrayDataPtr(sData), (lLen + 1) * 2)
End Function

复制代码

wang1999 · 发表于 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 · 发表于 2015-8-26 10:19:15

赞一个！很好的对比文章

t小宝 · 发表于 2015-8-26 12:09:44

学习！

yanwei82123300 · 发表于 2015-8-26 16:20:50

学习一下再说

帐号		自动登录	找回密码
密码			注册

群介绍
Access培训群 (792054000)
Access免费培训群2 (792054000)
Access经典源码培训群 (77130759)
Access源码技巧群 (138920637)
access vba (307776555)

主题相关群

地区相关群[您还没设置居住地]

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

群介绍
主题无相 (随机显示版	同地区群块其他地区)