[リストへもどる]
一括表示

投稿時間:2003/02/21(Fri) 20:05
投稿者名:ゆうや
Eメール:curren62036@yahoo.co.jp
URL :
タイトル:
バイナリデータをテキストボックスに表示したいです。
こんにちは。わからないことがあるので投稿してみました。
Win98 SecondEditionでVB6.0 SP5 を使っています。
一般的な「バイナリエディタ」のように、バイナリファイルを開いてバイトデータを16進数で表示し
たいのですが、32KB程度以上のファイルを開こうとすると、エラー7:「メモリが不足しています」が出
てしまいます。しかも10KB程度のファイルで表示できても凄い遅くなったりします。
今やっている方法は、Byte型配列に入っているデータ(10進数値)を16進数文字列型に変換してテキス
トボックスに表示、16Byte毎に改行して・・・という方法です。やはり大きすぎるファイルは表示でき
ないのでしょうか?それとも、何か他の方法でサクっと表示できる方法はあるのでしょうか?
どなたかご存知の方、教えてください。宜しくお願いします。

以下のように16進数を表示したいと思っています。
---------------------------------------------------------
0A F8 B6 A8 15 8D FF C1 A8 B5 55 91 7E 18 0B E0
BB 61 7F E7 8C A8 B0 77 E2 95 ・・・・・

投稿時間:2003/02/21(Fri) 20:40
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Re: バイナリデータをテキストボックスに表示したいです。
> たいのですが、32KB程度以上のファイルを開こうとすると、エラー7:「メモリが不足しています」が出
Win9X系では、テキストボックスに入力できるデータサイズは、最大64KBまでです。
より大きなデータを表示させたいのであれば、RichTextBoxを利用してください。

> てしまいます。しかも10KB程度のファイルで表示できても凄い遅くなったりします。
これは、表示させるまでが遅い、という事でしょうか。
それとも、表示させた後の処理(ユーザーが、テキストボックスをスクロールさせたりした場合など)に
時間がかかってしまう…という事でしょうか。

前者であれば、&演算子(あるいは+演算子)による文字列連結を、
何度も繰り返していないかを確認してみてください。
(文字列の連結は、文字列が長くなるほど重い処理となります)

投稿時間:2003/02/24(Mon) 11:30
投稿者名:ゆうや
Eメール:curren62036@yahoo.co.jp
URL :
タイトル:
御礼: バイナリデータをテキストボックスに表示したいです。
魔界の仮面弁士さん>
レスありがとうございました!!
> Win9X系では、テキストボックスに入力できるデータサイズは、最大64KBまでです。
> より大きなデータを表示させたいのであれば、RichTextBoxを利用してください。
RichTextBoxですかぁ。自分の書き込みの後、RichTextBoxに切り替えてみたら表示できました。ありが
とうございます。

> > てしまいます。しかも10KB程度のファイルで表示できても凄い遅くなったりします。
> これは、表示させるまでが遅い、という事でしょうか。
> それとも、表示させた後の処理(ユーザーが、テキストボックスをスクロールさせたりした場合な
ど)に
> 時間がかかってしまう…という事でしょうか。
>
> 前者であれば、&演算子(あるいは+演算子)による文字列連結を、
> 何度も繰り返していないかを確認してみてください。
> (文字列の連結は、文字列が長くなるほど重い処理となります)
これはご指摘の通り、&演算子使いまくって文字連結をしています。ここは違う方法でできるように
考えてみようともいます。
教えてくださってありがとうございました!!!

投稿時間:2003/02/25(Tue) 04:41
投稿者名:TOMO
Eメール:
URL :
タイトル:
便乗質問、&演算子を使用しない方法
私も、ループ内で&演算子で文字列を連結しているためか
同様の問題に直面しています。

できれば、&演算子を使用しないで、16進数に変換した文字列
の作成方法を教えて下さい。ヒントだけでも結構です。
宜しくお願いします。

投稿時間:2003/02/25(Tue) 09:58
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
Re: 便乗質問、&演算子を使用しない方法
00〜FFの範囲にあるランダムな16進数文字列を、3000個繋げるサンプルです。
RichTextBoxを1個、CommandButtonを4個貼って、それぞれの動作時間を比較して見てください。

Option Explicit

Private Const MAX_COUNT As Long = 4000&

Private Sub Command1_Click()
    Dim L As Long
    Dim T As Single
    
    RichTextBox1.Text = ""
    MsgBox "Textプロパティによる連結(その1)", vbInformation

    T = Timer
    With RichTextBox1
        .Visible = False
        For L = 1 To MAX_COUNT
            .Text = .Text & toHex(Int(Rnd * 255))
        Next
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "Text(ループ内)"
End Sub

Private Sub Command2_Click()
    Dim L As Long
    Dim S As String
    Dim T As Single

    RichTextBox1.Text = ""
    MsgBox "Textプロパティによる連結(その2)", vbInformation

    T = Timer
    With RichTextBox1
        .Visible = False
        S = ""
        For L = 1 To MAX_COUNT
            S = S & toHex(Int(Rnd * 255))
        Next
        .Text = S
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "Text(ループ外)"
End Sub

Private Sub Command3_Click()
    Dim L As Long
    Dim T As Single

    RichTextBox1.Text = ""
    MsgBox "SelTextプロパティによる連結", vbInformation

    T = Timer
    With RichTextBox1
        .Visible = False
        For L = 1 To MAX_COUNT
            .SelStart = (MAX_COUNT - 1) * 2
            .SelText = toHex(Int(Rnd * 255))
        Next
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "SelText"
End Sub

Private Sub Command4_Click()
    Dim L As Long
    Dim O As Object
    Dim T As Single

    RichTextBox1.Text = ""
    MsgBox "VB6のJoin関数による連結", vbInformation

    T = Timer
    With RichTextBox1
        .Visible = False
        Set O = CreateObject("Scripting.Dictionary")
        For L = 1 To MAX_COUNT
            O(L) = toHex(Int(Rnd * 255))
        Next
        .Text = Join(O.Items(), "")
        Set O = Nothing
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "Join関数"
End Sub

Private Function toHex(ByVal B As Byte)
    If B < &H10 Then
        toHex = "0" & Hex(B)
    Else
        toHex = Hex(B)
    End If
End Function

投稿時間:2003/02/25(Tue) 19:19
投稿者名:TOMO
Eメール:
URL :
タイトル:
Re^2: 便乗質問、&演算子を使用しない方法
サンプルありがとうございます。
Dictionary オブジェクトとJoin関数の組合せが最も高速でした。

戴いたサンプルを参考に、16進ダンプのサンプルができましたので報告します。

サンプルを2つ作りましたが、私のコードがマズイためか、
Dictionary オブジェクトのコレクションよりも単純にSring型変数
の配列にした方が高速でした。
しかし、Join関数の存在を初めて知りましたが、その効果に驚きました。
誠にありがとうございました。

' サンプル−0
' Dictionary オブジェクト + Join関数
Private Function GetHexDump_0(bytData() As Byte) As String
    Dim lngByteLen  As Long
    Dim strVAddress As String
    Dim objDicHex   As Object
    Dim objDicChr   As Object
    Dim objDicRow   As Object
    Dim bTmp        As Byte
    Dim n           As Long
    Dim i           As Long
    Dim j           As Long
    On Error Resume Next
    lngByteLen = UBound(bytData) + 1
    If (lngByteLen = 0) Then Exit Function
    Set objDicHex = CreateObject("Scripting.Dictionary")
    Set objDicChr = CreateObject("Scripting.Dictionary")
    Set objDicRow = CreateObject("Scripting.Dictionary")
    n = 0
    For i = 0 To lngByteLen - 1 Step 16
        strVAddress = Right$("0000000" & Hex(i), 8) & " "
        For j = 0 To 15
            If (i + j < lngByteLen) Then
                bTmp = bytData(i + j)
                If (bTmp < &H10) Then
                    objDicHex(j) = "0" & Hex(bTmp)
                Else: objDicHex(j) = Hex(bTmp)
                End If
                If (bTmp < 32) Then
                    objDicChr(j) = "."
                Else: objDicChr(j) = Chr$(bTmp)
                End If
            Else: objDicHex(j) = "  "
            End If
        Next j
        objDicRow(n) = strVAddress & Join(objDicHex.Items()) _
                       & " " & Join(objDicChr.Items(), "")
        n = n + 1
    Next i
    GetHexDump_0 = Join(objDicRow.Items(), vbCrLf)
    Set objDicHex = Nothing
    Set objDicChr = Nothing
    Set objDicRow = Nothing
End Function


' サンプル−1
' Sring型の配列 + Join関数
Private Function GetHexDump_1(bytData() As Byte) As String
    Dim lngByteLen  As Long
    Dim strVAddress As String
    Dim strHex(15)  As String
    Dim strChr(15)  As String
    Dim strRow()    As String
    Dim nRows       As Long
    Dim bTmp        As Byte
    Dim n           As Long
    Dim i           As Long
    Dim j           As Long
    On Error Resume Next
    lngByteLen = UBound(bytData) + 1
    If (lngByteLen = 0) Then Exit Function
    nRows = (lngByteLen + 15) \ 16
    ReDim strRow(nRows - 1)
    n = 0
    For i = 0 To lngByteLen - 1 Step 16
        strVAddress = Right$("0000000" & Hex(i), 8) & " "
        For j = 0 To 15
            If (i + j < lngByteLen) Then
                bTmp = bytData(i + j)
                If (bTmp < &H10) Then
                    strHex(j) = "0" & Hex(bTmp)
                Else: strHex(j) = Hex(bTmp)
                End If
                If (bTmp < 32) Then
                    strChr(j) = "."
                Else: strChr(j) = Chr$(bTmp)
                End If
            Else
                strHex(j) = "  "
                strChr(j) = ""
            End If
        Next j
        strRow(n) = strVAddress & Join(strHex()) _
                    & " " & Join(strChr(), "")
        n = n + 1
    Next i
    GetHexDump_1 = Join(strRow(), vbCrLf)
End Function

投稿時間:2003/02/26(Wed) 01:05
投稿者名:Starfish
Eメール:
URL :
タイトル:
Re^2: 便乗質問、&演算子を使用しない方法
強引ですが、こんなやり方もあるのかなぁ。

Private Sub Command5_Click()
    Dim L As Long
    Dim S() As Byte
    Dim T As Single
    Dim r As Byte

    RichTextBox1.Text = ""
    MsgBox "バイト配列にセットしてStrconv", vbInformation

    ReDim S(MAX_COUNT * 2 - 1)
    T = Timer
    With RichTextBox1
        .Visible = False
        For L = 1 To MAX_COUNT
            r = Int(Rnd * 255)
            If (r \ 16) < 10 Then
                S((L - 1) * 2) = 48 + (r \ 16)
            Else
                S((L - 1) * 2) = 55 + (r \ 16)
            End If
            If (r Mod 16) < 10 Then
                S((L - 1) * 2 + 1) = 48 + (r Mod 16)
            Else
                S((L - 1) * 2 + 1) = 55 + (r Mod 16)
            End If
        Next
        .Text = StrConv(S, vbUnicode)
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "バイト配列"

End Sub

Private Sub Command6_Click()
    Dim L As Long
    Dim S As String
    Dim T As Single
    Dim r As Byte

    RichTextBox1.Text = ""
    MsgBox "Mid ステートメント", vbInformation

    S = Space(MAX_COUNT * 2)
    T = Timer
    With RichTextBox1
        .Visible = False
        For L = 1 To MAX_COUNT
            Mid(S, (L - 1) * 2 + 1, 2) = toHex(Int(Rnd * 255))
        Next
        .Text = S
        .Visible = True
    End With
    MsgBox Format$(Timer - T, "0.000") & "秒かかりました。", vbInformation, "Mid ステートメント"

End Sub

投稿時間: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