探讨字节数组和字符串之间以十六进制转换的方式和速度。

时间:2022-01-09 10:45:24
字节数组和字符串按十六进制互相转换,以下两种是最普通的做法,还有没有更快的算法,各位各舒已见。

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

#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

#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"))才对的.所以速度想来好像也不会快一点.

#7


别用字符串!
字符串太慢!

把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

#10


忘了定义了:


Dim TblB2H(0 To 255) As String * 2


#11


忘了定义了:


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

#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快很多倍!!!!!!!!))


#22


要成为完整字串,www.easthot.net中有回复内容:
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

#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

#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

#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"))才对的.所以速度想来好像也不会快一点.

#7


别用字符串!
字符串太慢!

把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

#10


忘了定义了:


Dim TblB2H(0 To 255) As String * 2


#11


忘了定义了:


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

#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快很多倍!!!!!!!!))


#22


要成为完整字串,www.easthot.net中有回复内容:
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

#26


好!厉害~~~~~

又是用的代替方法呀~~~~~


佩服佩服

#27


抛砖引玉,果然是高手迭出,学习学习。