如何对这段代码提速

progame 2004-03-29 02:38:09
''
' Convert binary stream to string with hexadecimal representation.
'
'@param value binary stream
'
'@return encoding string
Public Function BinaryToString(value() As Byte) As String
Dim s() As String
Dim i As Long

ReDim s(UBound(value))

For i = LBound(value) To UBound(value)

If value(i) > 15 Then
s(i) = Hex(value(i))
Else
s(i) = "0" & Hex(value(i))
End If

Next i

BinaryToString = "0x" & Join(s, "")

Erase s


End Function

''
' Convert hexadecimal representation string to binary stream.
'
'@param value string
'
'@return decoding stream
Public Function StringToBinary(ByVal value As String) As Byte()
Dim arr() As Byte
Dim i As Long

If Left(value, 2) <> "0x" Then
Err.Raise vbObjectError, , "not binary string."
End If

value = Right(value, Len(value) - 2)

ReDim arr(Len(value) / 2 - 1)

For i = LBound(arr) To UBound(arr)
arr(i) = CByte("&H" & Mid(value, i * 2 + 1, 2))
Next i

StringToBinary = arr

End Function

这两个函数主要是完成一个二进制数据到十六进制字符串的转换
可是对于1M的数据,耗时居然要20多s
有没有什么方法提速?

在用join之前,直接拼字符串,更是速度慢得难以忍受
...全文
5 点赞 收藏 13
写回复
13 条回复
切换为时间正序
请发表友善的回复…
发表回复
progame 2004-03-30
''
' Convert hexadecimal representation string to binary stream.
'
'@param value string
'
'@return decoding stream
Public Function StringToBinary(ByVal value As String) As Byte()
Dim arr() As Byte
Dim i As Long
Dim t As Single

t = Timer

Dim dic As New Scripting.Dictionary

For i = 0 To 255
If i > 15 Then
dic.Add Hex(i), i
Else
dic.Add "0" & Hex(i), i
End If
Next i

If Left(value, 2) <> "0x" Then
Err.Raise vbObjectError, , "not binary string."
End If

ReDim arr(Len(value) / 2 - 2)

For i = LBound(arr) To UBound(arr)
arr(i) = dic.Item(Mid(value, i * 2 + 3, 2))
Next i

StringToBinary = arr

Debug.Print "string to binary:"; Timer - t

End Function

略有提升
回复
liyan010 2004-03-30
百家争鸣啊,不错,学习
回复
progame 2004-03-30
起 继续征求第二个函数的改进方案
回复
progame 2004-03-29
Public Function BinaryToString3(value() As Byte) As String
Dim x(255) As String
Dim s As String
Dim i As Long
i = (UBound(value) - LBound(value) + 1) * 2

s = Space(i)

For i = 0 To 255
If i > 15 Then
x(i) = Hex(i)
Else
x(i) = "0" & Hex(i)
End If
Next i

For i = LBound(value) To UBound(value)
Mid(s, 2 * i + 1, 2) = x(value(i))
Next i

BinaryToString3 = "0x" & s

End Function

原来的是2.4s 这个函数是0.8s
回复
progame 2004-03-29
那么再小改一下:
s = String(i, "0")
For i = LBound(value) To UBound(value)
If value(i) > 15 Then
Mid(s, 2 * i + 1, 2) = Hex(value(i))
Else
Mid(s, 2 * i + 2, 1) = Hex(value(i))
End If
Next i
回复
rainstormmaster 2004-03-29
//差别没这么大的.
精确千分一秒后,加$和不加$只差0.05秒.对不起了. 算我没有来过..呵呵.....

加上也很好啊:)
回复
华芸智森 2004-03-29
差别没这么大的.
精确千分一秒后,加$和不加$只差0.05秒.对不起了. 算我没有来过..呵呵.....
MsgBox (Timer() - d) / 1000
回复
华芸智森 2004-03-29
在 rainstormmaster(暴风雨 v2.0) 的基础.多加一个$.
不加时我的电脑是"2秒",加后是"1秒".
'-------------------------------------------------------
Public Function BinaryToString(value() As Byte) As String
Dim i As Long
i = (UBound(value) - LBound(value) + 1) * 2

Dim s As String
s = Space(i)
For i = LBound(value) To UBound(value)
If value(i) > 15 Then
Mid$(s, 2 * i + 1, 2) = Hex$(value(i))
Else
Mid$(s, 2 * i + 1, 2) = "0" & Hex$(value(i))
End If
Next
BinaryToString = "0x" & s
End Function
回复
lfshf 2004-03-29
向rainstormmaster(暴风雨 v2.0) 表示景仰!有技术且非常热心。
回复
progame 2004-03-29
不错的方法 谢谢
回复
rainstormmaster 2004-03-29
修改了一下BinaryToString,用mid语句加速了字串赋值,处理vba6.dll(1.62M),耗时4秒左右:

Option Explicit
Public Function BinaryToString(value() As Byte) As String
Dim i As Long
i = (UBound(value) - LBound(value) + 1) * 2
Dim s As String
s = Space(i)
For i = LBound(value) To UBound(value)
If value(i) > 15 Then
Mid(s, 2 * i + 1, 2) = Hex(value(i))
Else
Mid(s, 2 * i + 1, 2) = "0" & Hex(value(i))
End If
Next i
BinaryToString = "0x" & s
End Function

Private Sub Command1_Click()
Dim d As Date
d = Now
Dim mfile As String
mfile = "e:\vba6.dll"
Dim buff() As Byte
Dim i As Long
i = FileLen(mfile)
ReDim buff(i - 1)
Open mfile For Binary As #1
Get #1, , buff
Close #1
Dim s As String
s = BinaryToString(buff)
Debug.Print s
MsgBox DateDiff("s", d, Now)
End Sub
回复
hisofty 2004-03-29
大的字符串操作,可以用copymemory函数来,要传递字符串地址(strptr)
回复
liyd1978 2004-03-29
不会,关注,期待
回复
发动态
发帖子
VB基础类
创建于2007-09-28

7451

社区成员

VB 基础类
申请成为版主
社区公告
暂无公告