如何对这段代码提速

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之前,直接拼字符串,更是速度慢得难以忍受
...全文
66 13 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
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
  • 打赏
  • 举报
回复
不会,关注,期待

7,785

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧