Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = Right$("0" & Hex$(bt(I)), 2)
Next I
Byte2HexStr = strDes
End Function
Private Function HexStr2Byte(strSrc As String) As Byte()
Dim strLen As Integer
Dim btLen As Integer
Dim I As Integer
Dim bt() As Byte
strLen = Len(strSrc)
btLen = strLen / 2
ReDim bt(btLen - 1)
For I = 0 To btLen - 1
bt(I) = Val("&H" & Mid$(strSrc, I + I + 1, 2))
Next I
HexStr2Byte = bt
End Function
27 个解决方案
#1
api: copymemory
#2
我所希望的是探讨一下,如果各位有更好的方法,请写出来,这样大家才可以比较啊,目的是达到共同进步和方法共享。
#3
我以前写的
自己觉得速度不错
ZHexView.vbp
====================================================================
Type=Exe
Form=FrmZHexView.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="FrmZHexView"
Startup="FrmZHexView"
ExeName32="ZHexView.exe"
Command32=""
Name="HexView"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="910"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
自己觉得速度不错
ZHexView.vbp
====================================================================
Type=Exe
Form=FrmZHexView.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="FrmZHexView"
Startup="FrmZHexView"
ExeName32="ZHexView.exe"
Command32=""
Name="HexView"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="910"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
#4
FrmZHexView.frm
====================================================================
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmZHexView
Caption = "ZHexView"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CDlg1
Left = 2100
Top = 1350
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin RichTextLib.RichTextBox RText1
Height = 1245
Left = 0
TabIndex = 2
Top = 330
Width = 2115
_ExtentX = 3731
_ExtentY = 2196
_Version = 393217
HideSelection = 0 'False
ScrollBars = 3
DisableNoScroll = -1 'True
RightMargin = 1e7
TextRTF = $"FrmZHexView.frx":0000
End
Begin VB.TextBox TxtFile
Height = 285
Left = 570
TabIndex = 1
Text = "Text1"
ToolTipText = "文件名"
Top = 0
Width = 4035
End
Begin VB.Label Lbl1
AutoSize = -1 'True
Caption = "打开:"
Height = 180
Left = 30
TabIndex = 0
Top = 30
Width = 540
End
End
Attribute VB_Name = "FrmZHexView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, lpString As Any) As Long
Private Const MeText = "ZHexView"
Private HexChar(0 To &HF) As Byte
Private Sub Form_Load()
'Dim S1 As String, S2 As String * 3
'
'S1 = Space$(3)
'S2 = "03 "
'Call CopyMemory(ByVal StrPtr(S1), ByVal StrPtr(S2), 6)
'
'Debug.Print S1
CDlg1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CDlg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
InitHexChar
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
TxtFile.Width = Me.ScaleWidth - TxtFile.Left
RText1.Width = Me.ScaleWidth
RText1.Height = Me.ScaleHeight - RText1.Top
On Error GoTo 0
End Sub
Private Sub Lbl1_Click()
'
End Sub
Private Sub Lbl1_DblClick()
On Error GoTo ErrOpen
CDlg1.ShowOpen
TxtFile.Text = CDlg1.FileName
TxtFile_KeyPress vbKeyReturn
On Error GoTo 0
Exit Sub
ErrOpen:
On Error GoTo 0
End Sub
Private Sub TxtFile_Change()
'
End Sub
Private Sub TxtFile_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
LoadHex TxtFile.Text
End If
End Sub
Private Sub InitHexChar()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
End Sub
====================================================================
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmZHexView
Caption = "ZHexView"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CDlg1
Left = 2100
Top = 1350
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin RichTextLib.RichTextBox RText1
Height = 1245
Left = 0
TabIndex = 2
Top = 330
Width = 2115
_ExtentX = 3731
_ExtentY = 2196
_Version = 393217
HideSelection = 0 'False
ScrollBars = 3
DisableNoScroll = -1 'True
RightMargin = 1e7
TextRTF = $"FrmZHexView.frx":0000
End
Begin VB.TextBox TxtFile
Height = 285
Left = 570
TabIndex = 1
Text = "Text1"
ToolTipText = "文件名"
Top = 0
Width = 4035
End
Begin VB.Label Lbl1
AutoSize = -1 'True
Caption = "打开:"
Height = 180
Left = 30
TabIndex = 0
Top = 30
Width = 540
End
End
Attribute VB_Name = "FrmZHexView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, lpString As Any) As Long
Private Const MeText = "ZHexView"
Private HexChar(0 To &HF) As Byte
Private Sub Form_Load()
'Dim S1 As String, S2 As String * 3
'
'S1 = Space$(3)
'S2 = "03 "
'Call CopyMemory(ByVal StrPtr(S1), ByVal StrPtr(S2), 6)
'
'Debug.Print S1
CDlg1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CDlg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
InitHexChar
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
TxtFile.Width = Me.ScaleWidth - TxtFile.Left
RText1.Width = Me.ScaleWidth
RText1.Height = Me.ScaleHeight - RText1.Top
On Error GoTo 0
End Sub
Private Sub Lbl1_Click()
'
End Sub
Private Sub Lbl1_DblClick()
On Error GoTo ErrOpen
CDlg1.ShowOpen
TxtFile.Text = CDlg1.FileName
TxtFile_KeyPress vbKeyReturn
On Error GoTo 0
Exit Sub
ErrOpen:
On Error GoTo 0
End Sub
Private Sub TxtFile_Change()
'
End Sub
Private Sub TxtFile_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
LoadHex TxtFile.Text
End If
End Sub
Private Sub InitHexChar()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
End Sub
#5
Private Sub LoadHex(FileStr As String)
Dim LoadBytes() As Byte
Dim FileNum As Integer
Dim FileSize As Long
Dim ArrayMax As Long
Dim TimeLng As Long
FileNum = FreeFile
On Error GoTo ErrLoad
Open TxtFile.Text For Binary Access Read Lock Write As #FileNum
On Error GoTo 0
FileSize = LOF(FileNum)
If FileSize <= 0 Then RText1.Text = "": Exit Sub
ArrayMax = FileSize - 1
Me.MousePointer = 13
Me.Caption = MeText + " 处理中……"
DoEvents
TimeLng = timeGetTime
ReDim LoadBytes(0 To ArrayMax)
Get #FileNum, , LoadBytes
Close #FileNum
'/-----------
'01234567h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ; 0123456789abcdef
'12345678901234567890123456789012345678901234567890123456789012345678901234567
'0 1 2 3 4 5 6 7
'行长度:77 + 2(vbCrLf)
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Const AscSpace = 32 '" "
Const Asch = 104 '"h"
Const AscMH = 58 '":"
Const AscFH = 59 '";"
Const AscSysChar = 46
Const AscLf = 10
Const LineWidth = 77 + 2
Const Num0 = 0
Const Num1 = 1
Const Num2 = 2
Const Num3 = 3
Const Num8 = 8
Const Num15 = 15
Const Num16 = 16
Const Char0 = "0"
'\-----------
Dim StrBytes() As Byte
Dim HexStrPtr As Long
Dim LineCount As Long
Dim LinePtr As Long
Dim CurPtr As Long
Dim TempNum As Long
Dim TempStr As String
Dim I As Long, MaxI As Long
Dim J As Long
LineCount = (FileSize + &HF) \ &H10
MaxI = LineCount * LineWidth - Num1
ReDim StrBytes(0 To MaxI)
HexStrPtr = VarPtr(StrBytes(0))
Debug.Print "Start"
'TempStr = "00000000h: "
LinePtr = Num0
For I = Num0 To FileSize - Num1 Step Num16
''Mid(TempStr, 1, Num8) = Replace(Format$(Hex$(I), "@@@@@@@@"), " ", "0")
'Mid(TempStr, 1, Num8) = Format$(Hex$(I), "@@@@@@@@")
TempStr = Hex$(I)
TempStr = String$(Num8 - Len(TempStr), Char0) + TempStr '+ "h: "
'TempStr = TempStr + "h: "
CopyMemory StrBytes(CurPtr), ByVal TempStr, Num8 '11
CurPtr = CurPtr + Num8 '11
StrBytes(CurPtr) = Asch
StrBytes(CurPtr + Num1) = AscMH
StrBytes(CurPtr + Num2) = AscSpace
CurPtr = CurPtr + Num3
For J = Num0 To Num15
TempNum = I + J
If TempNum < FileSize Then
TempNum = LoadBytes(TempNum)
StrBytes(CurPtr) = HexChar((TempNum And &HF0) \ &H10)
StrBytes(CurPtr + Num1) = HexChar(TempNum And &HF)
StrBytes(CurPtr + Num2) = AscSpace
Else
StrBytes(CurPtr) = AscSpace
StrBytes(CurPtr + Num1) = AscSpace
StrBytes(CurPtr + Num2) = AscSpace
End If
CurPtr = CurPtr + Num3
Next J
StrBytes(CurPtr) = AscFH
StrBytes(CurPtr + Num1) = AscSpace
CurPtr = CurPtr + Num2
For J = Num0 To Num15
TempNum = I + J
If TempNum < FileSize Then
TempNum = LoadBytes(TempNum)
StrBytes(CurPtr + J) = IIf(TempNum < AscSpace, AscSysChar, TempNum)
Else
StrBytes(CurPtr + J) = AscSpace
End If
Next J
CurPtr = CurPtr + Num16
StrBytes(CurPtr) = vbKeyReturn
StrBytes(CurPtr + Num1) = AscLf
'Debug.Print CurPtr - LinePtr
LinePtr = LinePtr + LineWidth
CurPtr = LinePtr
'Debug.Print I
Next I
Debug.Print "SetText"
SetWindowText RText1.hwnd, StrBytes(0)
'RText1.Text = StrConv(StrBytes, vbUnicode)
Debug.Print "End"
Me.MousePointer = 0
TimeLng = timeGetTime - TimeLng
Me.Caption = MeText + " 处理时间:" + Format$(TimeLng / 1000, "##,###,###,##0.000") + "秒"
Exit Sub
ErrLoad:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Public Function MyHex(ByVal Num As Byte) As Byte
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Num = Num And &HF
If Num < 10 Then
MyHex = AscNum0 + Num
Else
MyHex = AscA + Num - 10
End If
End Function
#6
楼上的做法用于十六进制的方式查看文件,我把它改了一下放入下面的两个函数,总体的架构没有变化,但是我发现对一个132K的文件进行操作时,它们和原先给出的两个程序仍然有速度差距,大致慢0.1秒钟左右.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = Hex$((bt(I) And &HF0) \ &H10)
Mid$(strDes, I + I + 2, 1) = Hex$(bt(I) And &HF)
Next I
Byte2HexStr = strDes
End Function
Private Function HexStr2Byte(strSrc As String) As Byte()
Dim strLen As Integer
Dim btLen As Integer
Dim I As Integer
Dim bt() As Byte
strLen = Len(strSrc)
btLen = strLen / 2
ReDim bt(btLen - 1)
For I = 0 To btLen - 1
Call CopyMemory(bt(I), CByte("&H" & Mid$(strSrc, I + I + 1, 2)), 1)
Next I
HexStr2Byte = bt
End Function
还有种做法好像也可以把十六进制字符串转化为Byte数字数组,比如字符 "1"转化成数字就是ASCII码减48(ASC("1")-48),但是这好像要考虑"A"..."F"(ASC("A")-55)的ASCII码与"0"..."9"的做法要区别对待,所以能速度会慢一点.
还有就是定义71个元素的数组,但实际上用到的只有其中的15个, 在48-57,65-70 索引
写入相应的值0-9,10-15,然后在赋值时用数组中相应的来代替,如bt(i)=aryVal(Asc("A")).但这个要考虑两位数的问题,也就是一个Byte是8位的,由两位的16制进数组成,所以真正数字都是 bt(i)=aryVal(Asc("A")) * &H10 + aryVal(Asc("D"))才对的.所以速度想来好像也不会快一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = Hex$((bt(I) And &HF0) \ &H10)
Mid$(strDes, I + I + 2, 1) = Hex$(bt(I) And &HF)
Next I
Byte2HexStr = strDes
End Function
Private Function HexStr2Byte(strSrc As String) As Byte()
Dim strLen As Integer
Dim btLen As Integer
Dim I As Integer
Dim bt() As Byte
strLen = Len(strSrc)
btLen = strLen / 2
ReDim bt(btLen - 1)
For I = 0 To btLen - 1
Call CopyMemory(bt(I), CByte("&H" & Mid$(strSrc, I + I + 1, 2)), 1)
Next I
HexStr2Byte = bt
End Function
还有种做法好像也可以把十六进制字符串转化为Byte数字数组,比如字符 "1"转化成数字就是ASCII码减48(ASC("1")-48),但是这好像要考虑"A"..."F"(ASC("A")-55)的ASCII码与"0"..."9"的做法要区别对待,所以能速度会慢一点.
还有就是定义71个元素的数组,但实际上用到的只有其中的15个, 在48-57,65-70 索引
写入相应的值0-9,10-15,然后在赋值时用数组中相应的来代替,如bt(i)=aryVal(Asc("A")).但这个要考虑两位数的问题,也就是一个Byte是8位的,由两位的16制进数组成,所以真正数字都是 bt(i)=aryVal(Asc("A")) * &H10 + aryVal(Asc("D"))才对的.所以速度想来好像也不会快一点.
#7
别用字符串!
字符串太慢!
把StrBytes用StrConv函数把它转化成UniCode就可直接付给字符串了
只不过这样没有用SetWindowTextA快(省了 分配字符串空间、ANSI->UniCode->ANSI)
字符串太慢!
把StrBytes用StrConv函数把它转化成UniCode就可直接付给字符串了
只不过这样没有用SetWindowTextA快(省了 分配字符串空间、ANSI->UniCode->ANSI)
#8
还要尽量少用CopyMemory
因为动态连接也需要时间的
因为动态连接也需要时间的
#9
动态连接库只在初始化的时候浪费时间,
执行过后速度就很快了
我写了有一份,比你的速度快,呵呵
'你原来的程序
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim i As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For i = 0 To btLen - 1
Mid$(strDes, i + i + 1, 2) = Right$("0" & Hex$(bt(i)), 2)
Next i
Byte2HexStr = strDes
End Function
'我的程序
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
For i = 0 To 255
TblB2H(i) = Format(Hex(i), "00")
Next
End Sub
Private Sub Form_Load()
InitTable
Dim i As Long
Dim b(0 To 15000 - 1) As Byte
Dim t As Integer
Randomize Timer
For i = 0 To 1000
t = Int(Rnd * 256)
b(i) = t
Next
Dim st1 As Double, st2 As Double
While True
st1 = Timer
Byte2HexStr b
st1 = Timer - st1
st2 = Timer
B2H b, 15000
st2 = Timer - st2
Debug.Print st1, st2
Wend
End Sub
执行过后速度就很快了
我写了有一份,比你的速度快,呵呵
'你原来的程序
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim i As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For i = 0 To btLen - 1
Mid$(strDes, i + i + 1, 2) = Right$("0" & Hex$(bt(i)), 2)
Next i
Byte2HexStr = strDes
End Function
'我的程序
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
For i = 0 To 255
TblB2H(i) = Format(Hex(i), "00")
Next
End Sub
Private Sub Form_Load()
InitTable
Dim i As Long
Dim b(0 To 15000 - 1) As Byte
Dim t As Integer
Randomize Timer
For i = 0 To 1000
t = Int(Rnd * 256)
b(i) = t
Next
Dim st1 As Double, st2 As Double
While True
st1 = Timer
Byte2HexStr b
st1 = Timer - st1
st2 = Timer
B2H b, 15000
st2 = Timer - st2
Debug.Print st1, st2
Wend
End Sub
#10
忘了定义了:
Dim TblB2H(0 To 255) As String * 2
Dim TblB2H(0 To 255) As String * 2
#11
忘了定义了:
Dim TblB2H(0 To 255) As String * 2
Dim TblB2H(0 To 255) As String * 2
#12
楼上的做法速度确实是很快,比我的Byte2HexStr 基本上能快上1倍左右,但是唯一的遗憾是要事先定义一个全局的变量数组,我后来把它改写了一下,只是每一次都必须事先初始化那256个元素,也有一点不爽,但速度还可以,分多次转换132k字节比你的函数慢0.02-0.05秒左右.
Private Sub InitB2H(mB2H() As String)
Dim I As Integer
For I = 0 To 255
mB2H(I) = Right$("0" & Hex$(I), 2)
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
Dim strB2H(255) As String
Dim bTmp As Byte
Call InitB2H(strB2H)
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = strB2H(bt(I))
Next I
Byte2HexStr = strDes
End Function
还有用你说的字符串用StrConv方式生成也做了一次,效果可先前的差不多做法如下,用到了中间变量和除法,所以总慢一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim bDes() As Byte
Dim bTmp As Byte
btLen = UBound(bt) + 1
ReDim bDes(btLen * 2 - 1)
For I = 0 To btLen - 1
bTmp = (bt(I) And &HF0) \ &H10
bDes(I + I) = bTmp + 48 + (bTmp \ 10) * 7
bTmp = bt(I) And &HF
bDes(I + I + 1) = bTmp + 48 + (bTmp \ 10) * 7
Next I
Byte2HexStr = StrConv(bDes, vbUnicode)
End Function
Private Sub InitB2H(mB2H() As String)
Dim I As Integer
For I = 0 To 255
mB2H(I) = Right$("0" & Hex$(I), 2)
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
Dim strB2H(255) As String
Dim bTmp As Byte
Call InitB2H(strB2H)
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = strB2H(bt(I))
Next I
Byte2HexStr = strDes
End Function
还有用你说的字符串用StrConv方式生成也做了一次,效果可先前的差不多做法如下,用到了中间变量和除法,所以总慢一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim bDes() As Byte
Dim bTmp As Byte
btLen = UBound(bt) + 1
ReDim bDes(btLen * 2 - 1)
For I = 0 To btLen - 1
bTmp = (bt(I) And &HF0) \ &H10
bDes(I + I) = bTmp + 48 + (bTmp \ 10) * 7
bTmp = bt(I) And &HF
bDes(I + I + 1) = bTmp + 48 + (bTmp \ 10) * 7
Next I
Byte2HexStr = StrConv(bDes, vbUnicode)
End Function
#13
还有,各位对十六进制的字符串转成BYTE数组有没有更好的建议呢?
#14
其实另一个版本的也写了(H2B和B2H当时都写好了)
可恶的CSDN不让连续回复抄过三次,
这次全贴了吧:
Option Explicit
Dim TblB2H(0 To 255) As String * 2
Dim TblH2B(0 To 65536) As Byte
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Function H2B(ByVal s As String)
Dim l As Long, idx As Long, i As Long
Dim bt() As Byte
l = Len(s) / 2
ReDim bt(l - 1)
For i = 0 To l - 1
CopyMemory idx, ByVal Mid$(s, i + i + 1, 2), 2
bt(i) = TblH2B(idx)
Next i
H2B = bt
End Function
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
Dim idx As Long
For i = 0 To 255
TblB2H(i) = Right$("0" & Hex$(i), 2)
CopyMemory idx, ByVal (TblB2H(i)), 2
TblH2B(idx) = i
Next
End Sub
以上是全套程序,其中H2B和B2H是我的程序,速度绝对快!
#15
看上去不错,果然是高手。
只是定义的那个数组让人觉得太大了,虽然定义小一点也可以做到,不过那样的话又要在转换的时候计算,会花时间,所以也就这样了。
只是定义的那个数组让人觉得太大了,虽然定义小一点也可以做到,不过那样的话又要在转换的时候计算,会花时间,所以也就这样了。
#16
很难再小了。
如果想小点,那么最少要定义到
chr("f") * &h100& + chr("f")
#17
嗯,是这样的。
#18
没有人继续了吗?
#19
个人认为,除非内嵌汇编,不可能再快了(而且速度也快不了很多) :)
内嵌汇编代价太大,得不偿失,一般没人会用的~~~~~
内嵌汇编代价太大,得不偿失,一般没人会用的~~~~~
#20
xuexi
#21
都是些高手,不错,我个人是这样做的:
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
三行代码,三个运算符,不知是否符合你的要求!
(仅供参考!(此程序中原本如是16进制的小写不会自动改变为大写,这是唯一的缺陷,代要比调手一下HEX快很多倍!!!!!!!!))
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
三行代码,三个运算符,不知是否符合你的要求!
(仅供参考!(此程序中原本如是16进制的小写不会自动改变为大写,这是唯一的缺陷,代要比调手一下HEX快很多倍!!!!!!!!))
#22
要成为完整字串,www.easthot.net中有回复内容:
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
NewStr="&H" & Ucase(Replace(Join(dbarr,""),"&H",""))
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
NewStr="&H" & Ucase(Replace(Join(dbarr,""),"&H",""))
#23
Missbo是Bardo吧?
#24
还有,这代码能运行吗?你调试过吗?
#25
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private HexChar(0 To &HF) As Byte
Private HexByte16(0 To &HFF) As Long
Private Sub InitTable()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
For I = 0 To &HFF
HexByte16(I) = HexChar(I \ &H10) Or HexChar(I And &HF) * &H10000
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte, ByVal Size As Long) As String
Dim TempStr As String
TempStr = Space$(Size + Size)
Const Num0 As Long = 0
Const Num1 As Long = 1
Const Num2 As Long = 2
Const Num4 As Long = 4
Const Num12 As Long = 12
Dim DataArr1(Num0 To Num0) As Byte
Dim pDataArr1(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr1 As Long
Dim OldPtrDataArr1 As Long
Dim DataArr2(Num0 To Num0) As Long
Dim pDataArr2(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr2 As Long
Dim OldPtrDataArr2 As Long
Dim TempPtr As Long
Dim TempLng As Long
Dim I As Long, MaxI As Long
Dim MaxPtr As Long
CopyMemory TempLng, ByVal VarPtrArray(DataArr1), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr1, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr1 = pDataArr1(Num0) '保存旧地址
pDataArr1(Num0) = VarPtr(bt(0)) '设置新地址
CopyMemory TempLng, ByVal VarPtrArray(DataArr2), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr2, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr2 = pDataArr2(Num0) '保存旧地址
pDataArr2(Num0) = StrPtr(TempStr) '设置新地址
MaxI = Size
For I = Num1 To Size
DataArr2(Num0) = HexByte16(DataArr1(Num0))
pDataArr1(Num0) = pDataArr1(Num0) + Num1
pDataArr2(Num0) = pDataArr2(Num0) + Num4
Next I
pDataArr1(Num0) = OldPtrDataArr1 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr1, Num4 '恢复旧地址
pDataArr2(Num0) = OldPtrDataArr2 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr2, Num4 '恢复旧地址
Byte2HexStr = TempStr
End Function
处理1,440,054字节的数据(单位:秒)
Chice_wxg的(调试环境) 我的(调试环境) Chice_wxg的(编译后) 我的(编译后)
第一次 4.314 3.546 4.118 0.579
第二次 4.337 3.507 4.148 0.554
第三次 4.247 3.501 4.124 0.557
第四次 4.272 3.499 4.154 0.548
第五次 4.249 3.533 4.119 0.559
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private HexChar(0 To &HF) As Byte
Private HexByte16(0 To &HFF) As Long
Private Sub InitTable()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
For I = 0 To &HFF
HexByte16(I) = HexChar(I \ &H10) Or HexChar(I And &HF) * &H10000
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte, ByVal Size As Long) As String
Dim TempStr As String
TempStr = Space$(Size + Size)
Const Num0 As Long = 0
Const Num1 As Long = 1
Const Num2 As Long = 2
Const Num4 As Long = 4
Const Num12 As Long = 12
Dim DataArr1(Num0 To Num0) As Byte
Dim pDataArr1(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr1 As Long
Dim OldPtrDataArr1 As Long
Dim DataArr2(Num0 To Num0) As Long
Dim pDataArr2(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr2 As Long
Dim OldPtrDataArr2 As Long
Dim TempPtr As Long
Dim TempLng As Long
Dim I As Long, MaxI As Long
Dim MaxPtr As Long
CopyMemory TempLng, ByVal VarPtrArray(DataArr1), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr1, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr1 = pDataArr1(Num0) '保存旧地址
pDataArr1(Num0) = VarPtr(bt(0)) '设置新地址
CopyMemory TempLng, ByVal VarPtrArray(DataArr2), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr2, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr2 = pDataArr2(Num0) '保存旧地址
pDataArr2(Num0) = StrPtr(TempStr) '设置新地址
MaxI = Size
For I = Num1 To Size
DataArr2(Num0) = HexByte16(DataArr1(Num0))
pDataArr1(Num0) = pDataArr1(Num0) + Num1
pDataArr2(Num0) = pDataArr2(Num0) + Num4
Next I
pDataArr1(Num0) = OldPtrDataArr1 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr1, Num4 '恢复旧地址
pDataArr2(Num0) = OldPtrDataArr2 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr2, Num4 '恢复旧地址
Byte2HexStr = TempStr
End Function
处理1,440,054字节的数据(单位:秒)
Chice_wxg的(调试环境) 我的(调试环境) Chice_wxg的(编译后) 我的(编译后)
第一次 4.314 3.546 4.118 0.579
第二次 4.337 3.507 4.148 0.554
第三次 4.247 3.501 4.124 0.557
第四次 4.272 3.499 4.154 0.548
第五次 4.249 3.533 4.119 0.559
#26
好!厉害~~~~~
又是用的代替方法呀~~~~~
佩服佩服
又是用的代替方法呀~~~~~
佩服佩服
#27
抛砖引玉,果然是高手迭出,学习学习。
#1
api: copymemory
#2
我所希望的是探讨一下,如果各位有更好的方法,请写出来,这样大家才可以比较啊,目的是达到共同进步和方法共享。
#3
我以前写的
自己觉得速度不错
ZHexView.vbp
====================================================================
Type=Exe
Form=FrmZHexView.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="FrmZHexView"
Startup="FrmZHexView"
ExeName32="ZHexView.exe"
Command32=""
Name="HexView"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="910"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
自己觉得速度不错
ZHexView.vbp
====================================================================
Type=Exe
Form=FrmZHexView.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\WINDOWS\SYSTEM\stdole2.tlb#OLE Automation
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="FrmZHexView"
Startup="FrmZHexView"
ExeName32="ZHexView.exe"
Command32=""
Name="HexView"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="910"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
#4
FrmZHexView.frm
====================================================================
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmZHexView
Caption = "ZHexView"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CDlg1
Left = 2100
Top = 1350
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin RichTextLib.RichTextBox RText1
Height = 1245
Left = 0
TabIndex = 2
Top = 330
Width = 2115
_ExtentX = 3731
_ExtentY = 2196
_Version = 393217
HideSelection = 0 'False
ScrollBars = 3
DisableNoScroll = -1 'True
RightMargin = 1e7
TextRTF = $"FrmZHexView.frx":0000
End
Begin VB.TextBox TxtFile
Height = 285
Left = 570
TabIndex = 1
Text = "Text1"
ToolTipText = "文件名"
Top = 0
Width = 4035
End
Begin VB.Label Lbl1
AutoSize = -1 'True
Caption = "打开:"
Height = 180
Left = 30
TabIndex = 0
Top = 30
Width = 540
End
End
Attribute VB_Name = "FrmZHexView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, lpString As Any) As Long
Private Const MeText = "ZHexView"
Private HexChar(0 To &HF) As Byte
Private Sub Form_Load()
'Dim S1 As String, S2 As String * 3
'
'S1 = Space$(3)
'S2 = "03 "
'Call CopyMemory(ByVal StrPtr(S1), ByVal StrPtr(S2), 6)
'
'Debug.Print S1
CDlg1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CDlg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
InitHexChar
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
TxtFile.Width = Me.ScaleWidth - TxtFile.Left
RText1.Width = Me.ScaleWidth
RText1.Height = Me.ScaleHeight - RText1.Top
On Error GoTo 0
End Sub
Private Sub Lbl1_Click()
'
End Sub
Private Sub Lbl1_DblClick()
On Error GoTo ErrOpen
CDlg1.ShowOpen
TxtFile.Text = CDlg1.FileName
TxtFile_KeyPress vbKeyReturn
On Error GoTo 0
Exit Sub
ErrOpen:
On Error GoTo 0
End Sub
Private Sub TxtFile_Change()
'
End Sub
Private Sub TxtFile_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
LoadHex TxtFile.Text
End If
End Sub
Private Sub InitHexChar()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
End Sub
====================================================================
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmZHexView
Caption = "ZHexView"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin MSComDlg.CommonDialog CDlg1
Left = 2100
Top = 1350
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin RichTextLib.RichTextBox RText1
Height = 1245
Left = 0
TabIndex = 2
Top = 330
Width = 2115
_ExtentX = 3731
_ExtentY = 2196
_Version = 393217
HideSelection = 0 'False
ScrollBars = 3
DisableNoScroll = -1 'True
RightMargin = 1e7
TextRTF = $"FrmZHexView.frx":0000
End
Begin VB.TextBox TxtFile
Height = 285
Left = 570
TabIndex = 1
Text = "Text1"
ToolTipText = "文件名"
Top = 0
Width = 4035
End
Begin VB.Label Lbl1
AutoSize = -1 'True
Caption = "打开:"
Height = 180
Left = 30
TabIndex = 0
Top = 30
Width = 540
End
End
Attribute VB_Name = "FrmZHexView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, lpString As Any) As Long
Private Const MeText = "ZHexView"
Private HexChar(0 To &HF) As Byte
Private Sub Form_Load()
'Dim S1 As String, S2 As String * 3
'
'S1 = Space$(3)
'S2 = "03 "
'Call CopyMemory(ByVal StrPtr(S1), ByVal StrPtr(S2), 6)
'
'Debug.Print S1
CDlg1.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
CDlg1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
InitHexChar
End Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then Exit Sub
On Error Resume Next
TxtFile.Width = Me.ScaleWidth - TxtFile.Left
RText1.Width = Me.ScaleWidth
RText1.Height = Me.ScaleHeight - RText1.Top
On Error GoTo 0
End Sub
Private Sub Lbl1_Click()
'
End Sub
Private Sub Lbl1_DblClick()
On Error GoTo ErrOpen
CDlg1.ShowOpen
TxtFile.Text = CDlg1.FileName
TxtFile_KeyPress vbKeyReturn
On Error GoTo 0
Exit Sub
ErrOpen:
On Error GoTo 0
End Sub
Private Sub TxtFile_Change()
'
End Sub
Private Sub TxtFile_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
LoadHex TxtFile.Text
End If
End Sub
Private Sub InitHexChar()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
End Sub
#5
Private Sub LoadHex(FileStr As String)
Dim LoadBytes() As Byte
Dim FileNum As Integer
Dim FileSize As Long
Dim ArrayMax As Long
Dim TimeLng As Long
FileNum = FreeFile
On Error GoTo ErrLoad
Open TxtFile.Text For Binary Access Read Lock Write As #FileNum
On Error GoTo 0
FileSize = LOF(FileNum)
If FileSize <= 0 Then RText1.Text = "": Exit Sub
ArrayMax = FileSize - 1
Me.MousePointer = 13
Me.Caption = MeText + " 处理中……"
DoEvents
TimeLng = timeGetTime
ReDim LoadBytes(0 To ArrayMax)
Get #FileNum, , LoadBytes
Close #FileNum
'/-----------
'01234567h: 00 01 02 03 04 05 06 07 08 09 0a 0b 0c 0d 0e 0f ; 0123456789abcdef
'12345678901234567890123456789012345678901234567890123456789012345678901234567
'0 1 2 3 4 5 6 7
'行长度:77 + 2(vbCrLf)
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Const AscSpace = 32 '" "
Const Asch = 104 '"h"
Const AscMH = 58 '":"
Const AscFH = 59 '";"
Const AscSysChar = 46
Const AscLf = 10
Const LineWidth = 77 + 2
Const Num0 = 0
Const Num1 = 1
Const Num2 = 2
Const Num3 = 3
Const Num8 = 8
Const Num15 = 15
Const Num16 = 16
Const Char0 = "0"
'\-----------
Dim StrBytes() As Byte
Dim HexStrPtr As Long
Dim LineCount As Long
Dim LinePtr As Long
Dim CurPtr As Long
Dim TempNum As Long
Dim TempStr As String
Dim I As Long, MaxI As Long
Dim J As Long
LineCount = (FileSize + &HF) \ &H10
MaxI = LineCount * LineWidth - Num1
ReDim StrBytes(0 To MaxI)
HexStrPtr = VarPtr(StrBytes(0))
Debug.Print "Start"
'TempStr = "00000000h: "
LinePtr = Num0
For I = Num0 To FileSize - Num1 Step Num16
''Mid(TempStr, 1, Num8) = Replace(Format$(Hex$(I), "@@@@@@@@"), " ", "0")
'Mid(TempStr, 1, Num8) = Format$(Hex$(I), "@@@@@@@@")
TempStr = Hex$(I)
TempStr = String$(Num8 - Len(TempStr), Char0) + TempStr '+ "h: "
'TempStr = TempStr + "h: "
CopyMemory StrBytes(CurPtr), ByVal TempStr, Num8 '11
CurPtr = CurPtr + Num8 '11
StrBytes(CurPtr) = Asch
StrBytes(CurPtr + Num1) = AscMH
StrBytes(CurPtr + Num2) = AscSpace
CurPtr = CurPtr + Num3
For J = Num0 To Num15
TempNum = I + J
If TempNum < FileSize Then
TempNum = LoadBytes(TempNum)
StrBytes(CurPtr) = HexChar((TempNum And &HF0) \ &H10)
StrBytes(CurPtr + Num1) = HexChar(TempNum And &HF)
StrBytes(CurPtr + Num2) = AscSpace
Else
StrBytes(CurPtr) = AscSpace
StrBytes(CurPtr + Num1) = AscSpace
StrBytes(CurPtr + Num2) = AscSpace
End If
CurPtr = CurPtr + Num3
Next J
StrBytes(CurPtr) = AscFH
StrBytes(CurPtr + Num1) = AscSpace
CurPtr = CurPtr + Num2
For J = Num0 To Num15
TempNum = I + J
If TempNum < FileSize Then
TempNum = LoadBytes(TempNum)
StrBytes(CurPtr + J) = IIf(TempNum < AscSpace, AscSysChar, TempNum)
Else
StrBytes(CurPtr + J) = AscSpace
End If
Next J
CurPtr = CurPtr + Num16
StrBytes(CurPtr) = vbKeyReturn
StrBytes(CurPtr + Num1) = AscLf
'Debug.Print CurPtr - LinePtr
LinePtr = LinePtr + LineWidth
CurPtr = LinePtr
'Debug.Print I
Next I
Debug.Print "SetText"
SetWindowText RText1.hwnd, StrBytes(0)
'RText1.Text = StrConv(StrBytes, vbUnicode)
Debug.Print "End"
Me.MousePointer = 0
TimeLng = timeGetTime - TimeLng
Me.Caption = MeText + " 处理时间:" + Format$(TimeLng / 1000, "##,###,###,##0.000") + "秒"
Exit Sub
ErrLoad:
MsgBox Err.Description, vbCritical, Err.Number
End Sub
Public Function MyHex(ByVal Num As Byte) As Byte
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Num = Num And &HF
If Num < 10 Then
MyHex = AscNum0 + Num
Else
MyHex = AscA + Num - 10
End If
End Function
#6
楼上的做法用于十六进制的方式查看文件,我把它改了一下放入下面的两个函数,总体的架构没有变化,但是我发现对一个132K的文件进行操作时,它们和原先给出的两个程序仍然有速度差距,大致慢0.1秒钟左右.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = Hex$((bt(I) And &HF0) \ &H10)
Mid$(strDes, I + I + 2, 1) = Hex$(bt(I) And &HF)
Next I
Byte2HexStr = strDes
End Function
Private Function HexStr2Byte(strSrc As String) As Byte()
Dim strLen As Integer
Dim btLen As Integer
Dim I As Integer
Dim bt() As Byte
strLen = Len(strSrc)
btLen = strLen / 2
ReDim bt(btLen - 1)
For I = 0 To btLen - 1
Call CopyMemory(bt(I), CByte("&H" & Mid$(strSrc, I + I + 1, 2)), 1)
Next I
HexStr2Byte = bt
End Function
还有种做法好像也可以把十六进制字符串转化为Byte数字数组,比如字符 "1"转化成数字就是ASCII码减48(ASC("1")-48),但是这好像要考虑"A"..."F"(ASC("A")-55)的ASCII码与"0"..."9"的做法要区别对待,所以能速度会慢一点.
还有就是定义71个元素的数组,但实际上用到的只有其中的15个, 在48-57,65-70 索引
写入相应的值0-9,10-15,然后在赋值时用数组中相应的来代替,如bt(i)=aryVal(Asc("A")).但这个要考虑两位数的问题,也就是一个Byte是8位的,由两位的16制进数组成,所以真正数字都是 bt(i)=aryVal(Asc("A")) * &H10 + aryVal(Asc("D"))才对的.所以速度想来好像也不会快一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = Hex$((bt(I) And &HF0) \ &H10)
Mid$(strDes, I + I + 2, 1) = Hex$(bt(I) And &HF)
Next I
Byte2HexStr = strDes
End Function
Private Function HexStr2Byte(strSrc As String) As Byte()
Dim strLen As Integer
Dim btLen As Integer
Dim I As Integer
Dim bt() As Byte
strLen = Len(strSrc)
btLen = strLen / 2
ReDim bt(btLen - 1)
For I = 0 To btLen - 1
Call CopyMemory(bt(I), CByte("&H" & Mid$(strSrc, I + I + 1, 2)), 1)
Next I
HexStr2Byte = bt
End Function
还有种做法好像也可以把十六进制字符串转化为Byte数字数组,比如字符 "1"转化成数字就是ASCII码减48(ASC("1")-48),但是这好像要考虑"A"..."F"(ASC("A")-55)的ASCII码与"0"..."9"的做法要区别对待,所以能速度会慢一点.
还有就是定义71个元素的数组,但实际上用到的只有其中的15个, 在48-57,65-70 索引
写入相应的值0-9,10-15,然后在赋值时用数组中相应的来代替,如bt(i)=aryVal(Asc("A")).但这个要考虑两位数的问题,也就是一个Byte是8位的,由两位的16制进数组成,所以真正数字都是 bt(i)=aryVal(Asc("A")) * &H10 + aryVal(Asc("D"))才对的.所以速度想来好像也不会快一点.
#7
别用字符串!
字符串太慢!
把StrBytes用StrConv函数把它转化成UniCode就可直接付给字符串了
只不过这样没有用SetWindowTextA快(省了 分配字符串空间、ANSI->UniCode->ANSI)
字符串太慢!
把StrBytes用StrConv函数把它转化成UniCode就可直接付给字符串了
只不过这样没有用SetWindowTextA快(省了 分配字符串空间、ANSI->UniCode->ANSI)
#8
还要尽量少用CopyMemory
因为动态连接也需要时间的
因为动态连接也需要时间的
#9
动态连接库只在初始化的时候浪费时间,
执行过后速度就很快了
我写了有一份,比你的速度快,呵呵
'你原来的程序
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim i As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For i = 0 To btLen - 1
Mid$(strDes, i + i + 1, 2) = Right$("0" & Hex$(bt(i)), 2)
Next i
Byte2HexStr = strDes
End Function
'我的程序
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
For i = 0 To 255
TblB2H(i) = Format(Hex(i), "00")
Next
End Sub
Private Sub Form_Load()
InitTable
Dim i As Long
Dim b(0 To 15000 - 1) As Byte
Dim t As Integer
Randomize Timer
For i = 0 To 1000
t = Int(Rnd * 256)
b(i) = t
Next
Dim st1 As Double, st2 As Double
While True
st1 = Timer
Byte2HexStr b
st1 = Timer - st1
st2 = Timer
B2H b, 15000
st2 = Timer - st2
Debug.Print st1, st2
Wend
End Sub
执行过后速度就很快了
我写了有一份,比你的速度快,呵呵
'你原来的程序
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim i As Integer
Dim strDes As String
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For i = 0 To btLen - 1
Mid$(strDes, i + i + 1, 2) = Right$("0" & Hex$(bt(i)), 2)
Next i
Byte2HexStr = strDes
End Function
'我的程序
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
For i = 0 To 255
TblB2H(i) = Format(Hex(i), "00")
Next
End Sub
Private Sub Form_Load()
InitTable
Dim i As Long
Dim b(0 To 15000 - 1) As Byte
Dim t As Integer
Randomize Timer
For i = 0 To 1000
t = Int(Rnd * 256)
b(i) = t
Next
Dim st1 As Double, st2 As Double
While True
st1 = Timer
Byte2HexStr b
st1 = Timer - st1
st2 = Timer
B2H b, 15000
st2 = Timer - st2
Debug.Print st1, st2
Wend
End Sub
#10
忘了定义了:
Dim TblB2H(0 To 255) As String * 2
Dim TblB2H(0 To 255) As String * 2
#11
忘了定义了:
Dim TblB2H(0 To 255) As String * 2
Dim TblB2H(0 To 255) As String * 2
#12
楼上的做法速度确实是很快,比我的Byte2HexStr 基本上能快上1倍左右,但是唯一的遗憾是要事先定义一个全局的变量数组,我后来把它改写了一下,只是每一次都必须事先初始化那256个元素,也有一点不爽,但速度还可以,分多次转换132k字节比你的函数慢0.02-0.05秒左右.
Private Sub InitB2H(mB2H() As String)
Dim I As Integer
For I = 0 To 255
mB2H(I) = Right$("0" & Hex$(I), 2)
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
Dim strB2H(255) As String
Dim bTmp As Byte
Call InitB2H(strB2H)
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = strB2H(bt(I))
Next I
Byte2HexStr = strDes
End Function
还有用你说的字符串用StrConv方式生成也做了一次,效果可先前的差不多做法如下,用到了中间变量和除法,所以总慢一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim bDes() As Byte
Dim bTmp As Byte
btLen = UBound(bt) + 1
ReDim bDes(btLen * 2 - 1)
For I = 0 To btLen - 1
bTmp = (bt(I) And &HF0) \ &H10
bDes(I + I) = bTmp + 48 + (bTmp \ 10) * 7
bTmp = bt(I) And &HF
bDes(I + I + 1) = bTmp + 48 + (bTmp \ 10) * 7
Next I
Byte2HexStr = StrConv(bDes, vbUnicode)
End Function
Private Sub InitB2H(mB2H() As String)
Dim I As Integer
For I = 0 To 255
mB2H(I) = Right$("0" & Hex$(I), 2)
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim strDes As String
Dim strB2H(255) As String
Dim bTmp As Byte
Call InitB2H(strB2H)
btLen = UBound(bt) + 1
strDes = Space$(btLen * 2)
For I = 0 To btLen - 1
Mid$(strDes, I + I + 1, 2) = strB2H(bt(I))
Next I
Byte2HexStr = strDes
End Function
还有用你说的字符串用StrConv方式生成也做了一次,效果可先前的差不多做法如下,用到了中间变量和除法,所以总慢一点.
Private Function Byte2HexStr(bt() As Byte) As String
Dim btLen As Integer
Dim I As Integer
Dim bDes() As Byte
Dim bTmp As Byte
btLen = UBound(bt) + 1
ReDim bDes(btLen * 2 - 1)
For I = 0 To btLen - 1
bTmp = (bt(I) And &HF0) \ &H10
bDes(I + I) = bTmp + 48 + (bTmp \ 10) * 7
bTmp = bt(I) And &HF
bDes(I + I + 1) = bTmp + 48 + (bTmp \ 10) * 7
Next I
Byte2HexStr = StrConv(bDes, vbUnicode)
End Function
#13
还有,各位对十六进制的字符串转成BYTE数组有没有更好的建议呢?
#14
其实另一个版本的也写了(H2B和B2H当时都写好了)
可恶的CSDN不让连续回复抄过三次,
这次全贴了吧:
Option Explicit
Dim TblB2H(0 To 255) As String * 2
Dim TblH2B(0 To 65536) As Byte
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Function H2B(ByVal s As String)
Dim l As Long, idx As Long, i As Long
Dim bt() As Byte
l = Len(s) / 2
ReDim bt(l - 1)
For i = 0 To l - 1
CopyMemory idx, ByVal Mid$(s, i + i + 1, 2), 2
bt(i) = TblH2B(idx)
Next i
H2B = bt
End Function
Private Function B2H(bt() As Byte, ByVal size As Long) As String
Dim s As String
Dim i As Long
s = Space$(size * 2)
For i = 0 To size - 1
Mid$(s, i + i + 1, 2) = TblB2H(bt(i))
Next
B2H = s
End Function
Private Sub InitTable()
Dim i As Long
Dim idx As Long
For i = 0 To 255
TblB2H(i) = Right$("0" & Hex$(i), 2)
CopyMemory idx, ByVal (TblB2H(i)), 2
TblH2B(idx) = i
Next
End Sub
以上是全套程序,其中H2B和B2H是我的程序,速度绝对快!
#15
看上去不错,果然是高手。
只是定义的那个数组让人觉得太大了,虽然定义小一点也可以做到,不过那样的话又要在转换的时候计算,会花时间,所以也就这样了。
只是定义的那个数组让人觉得太大了,虽然定义小一点也可以做到,不过那样的话又要在转换的时候计算,会花时间,所以也就这样了。
#16
很难再小了。
如果想小点,那么最少要定义到
chr("f") * &h100& + chr("f")
#17
嗯,是这样的。
#18
没有人继续了吗?
#19
个人认为,除非内嵌汇编,不可能再快了(而且速度也快不了很多) :)
内嵌汇编代价太大,得不偿失,一般没人会用的~~~~~
内嵌汇编代价太大,得不偿失,一般没人会用的~~~~~
#20
xuexi
#21
都是些高手,不错,我个人是这样做的:
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
三行代码,三个运算符,不知是否符合你的要求!
(仅供参考!(此程序中原本如是16进制的小写不会自动改变为大写,这是唯一的缺陷,代要比调手一下HEX快很多倍!!!!!!!!))
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
三行代码,三个运算符,不知是否符合你的要求!
(仅供参考!(此程序中原本如是16进制的小写不会自动改变为大写,这是唯一的缺陷,代要比调手一下HEX快很多倍!!!!!!!!))
#22
要成为完整字串,www.easthot.net中有回复内容:
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
NewStr="&H" & Ucase(Replace(Join(dbarr,""),"&H",""))
Fro i = 0 to ubound(barr)
dbarr(i)= "&H" + barr(i)
next i
NewStr="&H" & Ucase(Replace(Join(dbarr,""),"&H",""))
#23
Missbo是Bardo吧?
#24
还有,这代码能运行吗?你调试过吗?
#25
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private HexChar(0 To &HF) As Byte
Private HexByte16(0 To &HFF) As Long
Private Sub InitTable()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
For I = 0 To &HFF
HexByte16(I) = HexChar(I \ &H10) Or HexChar(I And &HF) * &H10000
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte, ByVal Size As Long) As String
Dim TempStr As String
TempStr = Space$(Size + Size)
Const Num0 As Long = 0
Const Num1 As Long = 1
Const Num2 As Long = 2
Const Num4 As Long = 4
Const Num12 As Long = 12
Dim DataArr1(Num0 To Num0) As Byte
Dim pDataArr1(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr1 As Long
Dim OldPtrDataArr1 As Long
Dim DataArr2(Num0 To Num0) As Long
Dim pDataArr2(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr2 As Long
Dim OldPtrDataArr2 As Long
Dim TempPtr As Long
Dim TempLng As Long
Dim I As Long, MaxI As Long
Dim MaxPtr As Long
CopyMemory TempLng, ByVal VarPtrArray(DataArr1), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr1, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr1 = pDataArr1(Num0) '保存旧地址
pDataArr1(Num0) = VarPtr(bt(0)) '设置新地址
CopyMemory TempLng, ByVal VarPtrArray(DataArr2), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr2, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr2 = pDataArr2(Num0) '保存旧地址
pDataArr2(Num0) = StrPtr(TempStr) '设置新地址
MaxI = Size
For I = Num1 To Size
DataArr2(Num0) = HexByte16(DataArr1(Num0))
pDataArr1(Num0) = pDataArr1(Num0) + Num1
pDataArr2(Num0) = pDataArr2(Num0) + Num4
Next I
pDataArr1(Num0) = OldPtrDataArr1 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr1, Num4 '恢复旧地址
pDataArr2(Num0) = OldPtrDataArr2 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr2, Num4 '恢复旧地址
Byte2HexStr = TempStr
End Function
处理1,440,054字节的数据(单位:秒)
Chice_wxg的(调试环境) 我的(调试环境) Chice_wxg的(编译后) 我的(编译后)
第一次 4.314 3.546 4.118 0.579
第二次 4.337 3.507 4.148 0.554
第三次 4.247 3.501 4.124 0.557
第四次 4.272 3.499 4.154 0.548
第五次 4.249 3.533 4.119 0.559
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private HexChar(0 To &HF) As Byte
Private HexByte16(0 To &HFF) As Long
Private Sub InitTable()
Const AscNum0 = 48 '"0"
Const AscA = 65 '"A"
Dim I As Long
For I = 0 To 9
HexChar(I) = AscNum0 + I
Next I
For I = 0 To 5
HexChar(I + 10) = AscA + I
Next I
For I = 0 To &HFF
HexByte16(I) = HexChar(I \ &H10) Or HexChar(I And &HF) * &H10000
Next I
End Sub
Private Function Byte2HexStr(bt() As Byte, ByVal Size As Long) As String
Dim TempStr As String
TempStr = Space$(Size + Size)
Const Num0 As Long = 0
Const Num1 As Long = 1
Const Num2 As Long = 2
Const Num4 As Long = 4
Const Num12 As Long = 12
Dim DataArr1(Num0 To Num0) As Byte
Dim pDataArr1(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr1 As Long
Dim OldPtrDataArr1 As Long
Dim DataArr2(Num0 To Num0) As Long
Dim pDataArr2(Num0 To Num0) As Long '这是一个**(二级指针)
Dim OldPtrpDataArr2 As Long
Dim OldPtrDataArr2 As Long
Dim TempPtr As Long
Dim TempLng As Long
Dim I As Long, MaxI As Long
Dim MaxPtr As Long
CopyMemory TempLng, ByVal VarPtrArray(DataArr1), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr1, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr1 = pDataArr1(Num0) '保存旧地址
pDataArr1(Num0) = VarPtr(bt(0)) '设置新地址
CopyMemory TempLng, ByVal VarPtrArray(DataArr2), Num4 '得到DataArr的SAFEARRAY结构的地址
TempLng = TempLng + Num12 '这个指针偏移12个字节后就是pvData指针
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory OldPtrpDataArr2, ByVal (TempPtr + Num12), Num4 '保存旧地址
CopyMemory ByVal (TempPtr + Num12), TempLng, Num4 '使pDataArr指向DataArr的SAFEARRAY结构的pvData指针,**完成了
OldPtrDataArr2 = pDataArr2(Num0) '保存旧地址
pDataArr2(Num0) = StrPtr(TempStr) '设置新地址
MaxI = Size
For I = Num1 To Size
DataArr2(Num0) = HexByte16(DataArr1(Num0))
pDataArr1(Num0) = pDataArr1(Num0) + Num1
pDataArr2(Num0) = pDataArr2(Num0) + Num4
Next I
pDataArr1(Num0) = OldPtrDataArr1 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr1), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr1, Num4 '恢复旧地址
pDataArr2(Num0) = OldPtrDataArr2 '恢复旧地址
CopyMemory TempPtr, ByVal VarPtrArray(pDataArr2), Num4 '得到pDataArr的SAFEARRAY结构的地址
CopyMemory ByVal (TempPtr + Num12), OldPtrpDataArr2, Num4 '恢复旧地址
Byte2HexStr = TempStr
End Function
处理1,440,054字节的数据(单位:秒)
Chice_wxg的(调试环境) 我的(调试环境) Chice_wxg的(编译后) 我的(编译后)
第一次 4.314 3.546 4.118 0.579
第二次 4.337 3.507 4.148 0.554
第三次 4.247 3.501 4.124 0.557
第四次 4.272 3.499 4.154 0.548
第五次 4.249 3.533 4.119 0.559
#26
好!厉害~~~~~
又是用的代替方法呀~~~~~
佩服佩服
又是用的代替方法呀~~~~~
佩服佩服
#27
抛砖引玉,果然是高手迭出,学习学习。