VB6.0用掲示板の過去のログ(No.1)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [過去ログ] [管理用]

投稿日: 2003/02/27(Thu) 06:15
投稿者TOMO
Eメール
URL
タイトルRe^3: (解決)便乗質問、&演算子を使用しない方法

有益なサンプルを戴き、ありがとうございます。

Midステートメントに、こういう使い方があるとは知りませんでした。
しかも高速に文字列の連結(置換)ができるとは。

バイト配列を使う方法が最も高速ですが、これを私のサンプルに
当てはめるのに苦労しましたが、Win32APIのRtlMoveMemoryを使う
ことで何とか実現できました。

私のサンプルで両者を比較してみると、バイト配列を使う方法が
約10%高速でした。
この程度の差異なら、Midステートメントの方法を採用させて戴きます。

皆様、いろいろとありがとうございました。
参考までに、以下にサンプルをのせます。

' Mid ステートメント
Private Function GetHexDump_2(bytData() As Byte) As String
    Dim lngDataLen  As Long
    Dim nRows       As Long
    Dim strBuff     As String
    Dim strChrs     As String
    Dim n           As Long
    Dim i           As Long
    Dim j           As Long
    On Error Resume Next
    lngDataLen = UBound(bytData) + 1
    If (lngDataLen = 0) Then Exit Function
    nRows = (lngDataLen + 15) \ 16
    strBuff = Space(nRows * 75)
    strChrs = Space(16)
    n = 1
    For i = 0 To lngDataLen - 1 Step 16
        Mid(strBuff, n, 8) = Right("0000000" & Hex(i), 8)
        n = n + 8 + 1
        For j = 0 To 15
            If ((i + j) < lngDataLen) Then  ' データサイズ以内
                If (bytData(i + j) < 16) Then
                    Mid(strBuff, n, 1) = "0"
                    Mid(strBuff, n + 1, 1) = Hex(bytData(i + j))
                Else: Mid(strBuff, n, 2) = Hex(bytData(i + j))
                End If
                If (bytData(i + j) < 32) Then
                    Mid(strChrs, j + 1, 1) = "."
                Else: Mid(strChrs, j + 1, 1) = Chr(bytData(i + j))
                End If
            Else: Mid(strChrs, j + 1, 1) = ""
            End If
            n = n + 3
        Next j
        Mid(strBuff, n, 16) = strChrs
        Mid(strBuff, n + 16, 2) = vbCrLf
        n = n + 16 + 2
    Next i
    GetHexDump_2 = strBuff
End Function


' バイト配列
Private Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" (Destination As Any, _
    Source As Any, ByVal Length As Long)

Private Function GetHexDump_3(bytData() As Byte) As String
    Dim lngDataLen  As Long
    Dim nRows       As Long
    Dim strVAddress As String
    Dim bytBuff()   As Byte
    Dim bytRow(15)  As Byte
    Dim n           As Long
    Dim i           As Long
    Dim j           As Long
    On Error Resume Next
    lngDataLen = UBound(bytData) + 1
    If (lngDataLen = 0) Then Exit Function
    nRows = (lngDataLen + 15) \ 16
    ReDim bytBuff(nRows * (8 + 1 + 16 * 3 + 16 + 2) - 1)
    n = 0
    For i = 0 To lngDataLen - 1 Step 16
        strVAddress = Right("0000000" & Hex(i), 8)
        Call CopyMemory(bytBuff(n), ByVal strVAddress, 8)
        bytBuff(n + 8) = 32
        n = n + 8 + 1
        Call CopyMemory(bytRow(0), bytData(i), 16)
        For j = 0 To 15
            If ((i + j) < lngDataLen) Then
                If (bytRow(j) \ 16 < 10) Then
                    bytBuff(n) = 48 + bytRow(j) \ 16
                Else: bytBuff(n) = 55 + bytRow(j) \ 16
                End If
                If (bytRow(j) Mod 16 < 10) Then
                    bytBuff(n + 1) = 48 + bytRow(j) Mod 16
                Else: bytBuff(n + 1) = 55 + bytRow(j) Mod 16
                End If
                bytBuff(n + 2) = 32
                If (bytRow(j) < 32) Then bytRow(j) = 46
            Else
                Call CopyMemory(bytBuff(n), &H202020, 3)
                bytRow(j) = 32
            End If
            n = n + 3
        Next j
        Call CopyMemory(bytBuff(n), bytRow(0), 16)
        Call CopyMemory(bytBuff(n + 16), &HA0D, 2)
        n = n + 16 + 2
    Next i
    GetHexDump_3 = StrConv(bytBuff(), vbUnicode)
End Function


- 関連一覧ツリー (★ をクリックするとツリー全体を一括表示します)

- 返信フォーム (この記事に返信する場合は下記フォームから投稿して下さい)

- Web Forum -