ViewBinFile.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 frmViewBinFile
   Appearance      =   0  'Flat
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Binary file viewer"
   ClientHeight    =   7365
   ClientLeft      =   1605
   ClientTop       =   1530
   ClientWidth     =   10125
   Icon            =   "ViewBinFile.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   491
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   675
   StartUpPosition =   2  'CenterScreen
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   120
      Top             =   990
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.PictureBox picContainer
      AutoRedraw      =   -1  'True
      Height          =   6255
      Left            =   330
      ScaleHeight     =   413
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   633
      TabIndex        =   20
      Top             =   510
      Width           =   9555
      Begin VB.PictureBox picHexDisp
         AutoRedraw      =   -1  'True
         BackColor       =   &H00FFFFFF&
         BeginProperty Font
            Name            =   "Terminal"
            Size            =   9
            Charset         =   255
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5835
         Left            =   1290
         ScaleHeight     =   385
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   399
         TabIndex        =   24
         TabStop         =   0   'False
         Top             =   360
         Width           =   6045
      End
      Begin VB.PictureBox picOffset2
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BeginProperty Font
            Name            =   "Terminal"
            Size            =   9
            Charset         =   255
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   315
         Left            =   1290
         ScaleHeight     =   19
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   401
         TabIndex        =   23
         Top             =   0
         Width           =   6045
      End
      Begin VB.PictureBox picChrDisp
         AutoRedraw      =   -1  'True
         BackColor       =   &H00FFFFFF&
         BeginProperty Font
            Name            =   "Terminal"
            Size            =   9
            Charset         =   255
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   5835
         Left            =   7470
         ScaleHeight     =   385
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   133
         TabIndex        =   22
         Top             =   360
         Width           =   2055
      End
      Begin VB.PictureBox picOffSet1
         Appearance      =   0  'Flat
         AutoRedraw      =   -1  'True
         BeginProperty Font
            Name            =   "Terminal"
            Size            =   9
            Charset         =   255
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00800000&
         Height          =   5835
         Left            =   0
         ScaleHeight     =   387
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   79
         TabIndex        =   21
         Top             =   360
         Width           =   1215
      End
      Begin RichTextLib.RichTextBox rtbChr
         Height          =   5835
         Left            =   30
         TabIndex        =   25
         TabStop         =   0   'False
         Top             =   330
         Visible         =   0   'False
         Width           =   6465
         _ExtentX        =   11404
         _ExtentY        =   10292
         _Version        =   393217
         HideSelection   =   0   'False
         ScrollBars      =   3
         TextRTF         =   $"ViewBinFile.frx":030A
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
            Name            =   "Terminal"
            Size            =   6
            Charset         =   255
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
      End
      Begin VB.Label lblFileSize
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblFileSize"
         ForeColor       =   &H00000080&
         Height          =   315
         Left            =   0
         TabIndex        =   28
         ToolTipText     =   "File size"
         Top             =   0
         Width           =   1215
      End
      Begin VB.Label lblAscii
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblAscii"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FFFF&
         Height          =   315
         Left            =   7470
         TabIndex        =   27
         ToolTipText     =   "ASCII"
         Top             =   0
         Width           =   675
      End
      Begin VB.Label lblBinary
         Alignment       =   2  'Center
         BorderStyle     =   1  'Fixed Single
         Caption         =   "lblBinary"
         BeginProperty Font
            Name            =   "MS Sans Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H0000FFFF&
         Height          =   315
         Left            =   8220
         TabIndex        =   26
         ToolTipText     =   "Binary"
         Top             =   0
         Width           =   1305
      End
   End
   Begin VB.CommandButton cmdPrintPage
      Height          =   345
      Left            =   390
      Picture         =   "ViewBinFile.frx":0410
      Style           =   1  'Graphical
      TabIndex        =   19
      TabStop         =   0   'False
      ToolTipText     =   "Print current page"
      Top             =   30
      Width           =   315
   End
   Begin VB.PictureBox picHeader
      Align           =   1  'Align Top
      Height          =   405
      Left            =   0
      ScaleHeight     =   345
      ScaleWidth      =   10065
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   10125
      Begin VB.CommandButton cmdGoTo
         Height          =   345
         Left            =   7470
         Picture         =   "ViewBinFile.frx":055A
         Style           =   1  'Graphical
         TabIndex        =   18
         TabStop         =   0   'False
         ToolTipText     =   "Go to"
         Top             =   0
         Width           =   315
      End
      Begin VB.TextBox txbSearch
         BackColor       =   &H00FFFFC0&
         Height          =   345
         Left            =   3690
         TabIndex        =   17
         TabStop         =   0   'False
         Text            =   "txtSearch"
         Top             =   0
         Width           =   1665
      End
      Begin VB.TextBox txbGoTo
         BackColor       =   &H00E0E0E0&
         Height          =   345
         Left            =   6360
         TabIndex        =   16
         TabStop         =   0   'False
         Text            =   "txtGoTo"
         Top             =   0
         Width           =   1095
      End
      Begin VB.CommandButton cmdSearchFromStart
         Height          =   345
         Left            =   5370
         Picture         =   "ViewBinFile.frx":0724
         Style           =   1  'Graphical
         TabIndex        =   14
         TabStop         =   0   'False
         ToolTipText     =   "Search from start"
         Top             =   0
         Width           =   345
      End
      Begin VB.CheckBox ckbCaseSensitive
         Caption         =   "Case"
         Height          =   195
         Left            =   2940
         TabIndex        =   13
         TabStop         =   0   'False
         ToolTipText     =   "Case sensitive"
         Top             =   60
         Value           =   1  'Checked
         Width           =   705
      End
      Begin VB.CommandButton cmdFileOpen
         Height          =   345
         Left            =   0
         Picture         =   "ViewBinFile.frx":086E
         Style           =   1  'Graphical
         TabIndex        =   12
         TabStop         =   0   'False
         ToolTipText     =   "Open file"
         Top             =   0
         Width           =   345
      End
      Begin VB.CommandButton cmdExit
         Height          =   345
         Left            =   1050
         Picture         =   "ViewBinFile.frx":09B8
         Style           =   1  'Graphical
         TabIndex        =   11
         TabStop         =   0   'False
         ToolTipText     =   "Exit"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdHelp
         Height          =   345
         Left            =   690
         Picture         =   "ViewBinFile.frx":0B82
         Style           =   1  'Graphical
         TabIndex        =   10
         TabStop         =   0   'False
         ToolTipText     =   "Help"
         Top             =   0
         Width           =   345
      End
      Begin VB.CommandButton cmdSearchOrFindNext
         Height          =   345
         Left            =   5730
         Picture         =   "ViewBinFile.frx":0CCC
         Style           =   1  'Graphical
         TabIndex        =   9
         TabStop         =   0   'False
         ToolTipText     =   "Search / find next"
         Top             =   0
         Width           =   345
      End
      Begin VB.CommandButton cmdPgUp
         Height          =   345
         Left            =   8430
         Picture         =   "ViewBinFile.frx":0E16
         Style           =   1  'Graphical
         TabIndex        =   8
         TabStop         =   0   'False
         ToolTipText     =   "PgUp"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdDn
         Height          =   345
         Left            =   8760
         Picture         =   "ViewBinFile.frx":1158
         Style           =   1  'Graphical
         TabIndex        =   7
         TabStop         =   0   'False
         ToolTipText     =   "Down line"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdPgDn
         Height          =   345
         Left            =   8100
         Picture         =   "ViewBinFile.frx":149A
         Style           =   1  'Graphical
         TabIndex        =   6
         TabStop         =   0   'False
         ToolTipText     =   "PgDn"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdUp
         Height          =   345
         Left            =   9090
         Picture         =   "ViewBinFile.frx":17DC
         Style           =   1  'Graphical
         TabIndex        =   5
         TabStop         =   0   'False
         ToolTipText     =   "Up line"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdFirst
         Height          =   345
         Left            =   9420
         Picture         =   "ViewBinFile.frx":1B1E
         Style           =   1  'Graphical
         TabIndex        =   4
         TabStop         =   0   'False
         ToolTipText     =   "First page"
         Top             =   0
         Width           =   315
      End
      Begin VB.CommandButton cmdLast
         Height          =   345
         Left            =   9750
         Picture         =   "ViewBinFile.frx":1E60
         Style           =   1  'Graphical
         TabIndex        =   3
         TabStop         =   0   'False
         ToolTipText     =   "Last page"
         Top             =   0
         Width           =   315
      End
      Begin VB.OptionButton OptSearch
         Caption         =   "Hex"
         Height          =   195
         Index           =   0
         Left            =   1620
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   60
         Width           =   615
      End
      Begin VB.OptionButton OptSearch
         Caption         =   "Chr"
         Height          =   195
         Index           =   1
         Left            =   2370
         TabIndex        =   1
         Top             =   60
         Value           =   -1  'True
         Width           =   615
      End
   End
   Begin VB.Label lblFileSpec
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblFileSpec"
      ForeColor       =   &H00000080&
      Height          =   285
      Left            =   330
      TabIndex        =   15
      Top             =   6810
      Width           =   9555
   End
   Begin VB.Image imgHerman
      Height          =   1305
      Left            =   30
      Picture         =   "ViewBinFile.frx":21A2
      Top             =   5820
      Width           =   240
   End
End
Attribute VB_Name = "frmViewBinFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ViewBinFile.frm
'
' By Herman Liu
'
' View binary and text files, with both hex and character search facilities fully
' functional, and you can print any displayed page (upto 512 bytes, showing byte
' positions, hex and characters).
'
Option Explicit

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
    ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
   
Private Const CharsInRow = 16
Private Const CharsInCol = 32
Private Const mPageSize = CharsInRow * CharsInCol
Dim mFileSize As Long
Dim arrByte() As Byte
Dim arrSearchByte() As Byte
Dim pageStart As Long
Dim pageEnd As Long

Dim StdW1 As Long
Dim StdH1 As Long
Dim StdW2 As Long
Dim StdH2 As Long
Dim ChrW As Long

Dim mSuspend As Boolean
Dim prevFoundPos As Long
Dim gcdg As Object




Private Sub Form_Load()
    Me.Show
    Me.KeyPreview = True
   
    txbSearch.Text = ""
    txbGoTo.Text = ""
    lblFileSize.Caption = ""
    lblFileSpec.Caption = ""
    lblAscii.Caption = ""
    lblBinary.Caption = ""
    mFileSize = 0

    rtbChr.Move 0, 0
    rtbChr.Width = Me.Width - 10
    rtbChr.Height = Me.Height - 10
   
    StdW1 = picHexDisp.ScaleWidth / CharsInRow
    StdH1 = picHexDisp.ScaleHeight / CharsInCol
    StdW2 = picChrDisp.ScaleWidth / CharsInRow
    StdH2 = picChrDisp.ScaleHeight / CharsInCol
    ChrW = picHexDisp.TextWidth("X")
   
    setButtons False
    Set gcdg = CommonDialog1
End Sub



Private Sub cmdHelp_Click()
   Dim tmp As String
   tmp = tmp & "(1)  Navigational keys:" & vbCrLf
   tmp = tmp & "      Use keyboard PgDn, PgUp, ArrowUp, ArrowDn, Home and End keys." & vbCrLf
   tmp = tmp & "      Alternatively, use navigational buttons including the GoTo button." & vbCrLf & vbCrLf
   tmp = tmp & "(2)  Character display:" & vbCrLf
   tmp = tmp & "      Characters of ASCII value less than 32 are displayed as a rectangle.  So" & vbCrLf
   tmp = tmp & "      are any characters not printable by Windows for the current font." & vbCrLf & vbCrLf
   tmp = tmp & "(3)  Find corresponding character/hex, and ASCII & binary values:" & vbCrLf
   tmp = tmp & "      Click on the hex/character.  The corresponding character/hex will be" & vbCrLf
   tmp = tmp & "      color-highlighted.  Its ASCII and binary values will also be displayed" & vbCrLf
   tmp = tmp & "      at the upper right corner." & vbCrLf & vbCrLf
   tmp = tmp & "(4)  Search facilities:" & vbCrLf
   tmp = tmp & "      Search the whole file: (a) Hex search or (b) Character search.  You can (i)" & vbCrLf
   tmp = tmp & "      Search from start and/or (ii) Search/find next.   When Character search" & vbCrLf
   tmp = tmp & "      is opted, Case Sensitive checkbox is applicable.  Hex and characters will" & vbCrLf
   tmp = tmp & "      be highlighted with color when found." & vbCrLf & vbCrLf
   tmp = tmp & "(5)  Print current page:" & vbCrLf
   tmp = tmp & "      Get the printer ready and click the Print button." & vbCrLf & vbCrLf
   MsgBox tmp
End Sub



Private Sub cmdExit_Click()
    Unload Me
End Sub



Private Sub cmdFileOpen_Click()
     On Error GoTo errHandler
     Dim mHandle
    
     gcdg.Flags = cdlOFNFileMustExist
     gcdg.FileName = ""
     gcdg.CancelError = True
     gcdg.ShowOpen
     If gcdg.FileName = "" Then
         Exit Sub
     End If
      ' Read file.
     mHandle = FreeFile
     Open gcdg.FileName For Binary As #mHandle
     mFileSize = LOF(mHandle)
     If mFileSize = 0 Then
          Close mHandle
          MsgBox "Empty file"
          Exit Sub
     End If
     Screen.MousePointer = vbHourglass
     ReDim arrByte(1 To mFileSize)
     Get #mHandle, , arrByte
     Close mHandle
       ' We load the file into a hidden richtextboxes to facilitate Search
       ' if required
     rtbChr.Text = ""
     rtbChr.LoadFile gcdg.FileName
    
     setButtons True
     lblFileSize.Caption = CStr(mFileSize) & " bytes"
     lblFileSpec.Caption = Space(2) & gcdg.FileName
    
     pageStart = 1
     pageEnd = mPageSize
     ShowPage False
     Screen.MousePointer = vbDefault
     Exit Sub
errHandler:
    If Err.Number <> 32755 Then
         Screen.MousePointer = vbDefault
         lblFileSize.Caption = ""
         lblFileSpec.Caption = ""
         rtbChr.Text = ""
         picHexDisp.Picture = LoadPicture()
         picChrDisp.Picture = LoadPicture()
         picOffSet1.Picture = LoadPicture()
         picOffset2.Picture = LoadPicture()
         setButtons False
         ErrMsgProc "cmdFileOpen_Click"
    End If
End Sub




Private Sub setButtons(ByVal OnOff As Boolean)
    cmdSearchOrFindNext.Enabled = OnOff
    cmdSearchFromStart.Enabled = OnOff
    If mFileSize <= mPageSize Then
         OnOff = False
    End If
    cmdPrintPage.Enabled = OnOff
    cmdGoTo.Enabled = OnOff
    cmdPgDn.Enabled = OnOff
    cmdPgUp.Enabled = OnOff
    cmdDn.Enabled = OnOff
    cmdUp.Enabled = OnOff
    cmdFirst.Enabled = OnOff
    cmdLast.Enabled = OnOff
End Sub



Private Sub ShowPage(ByVal Hilit As Boolean, Optional ByVal inStart As Long = 0, _
      Optional ByVal inEnd As Long = 0, Optional ByVal inPaint1 As Long, _
      Optional ByVal inPaint2 As Long)
    On Error Resume Next
    If mSuspend Or lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    Dim strContent As String
    Dim offSetPos As String
    Dim unDispChar As String
    Dim mAscii As Integer
    Dim mHex As String
    Dim x As Integer, y As Integer
    Dim tmp As String
    Dim i As Long
    Dim j As Long
    Dim k
    Dim origX
    Dim origY

    picHexDisp.Picture = LoadPicture()
    picChrDisp.Picture = LoadPicture()
    picOffSet1.Picture = LoadPicture()
    picOffset2.Picture = LoadPicture()
   
      ' Since we repaint, any values in ASCII & Binary labels are no longer valid
    lblAscii.Caption = ""
    lblBinary.Caption = ""
   
      ' Adjust if required - safety
    If mFileSize <= mPageSize Then
         pageStart = 1
         pageEnd = mFileSize
    Else
         If pageStart < 1 Then
             pageStart = 1
             pageEnd = mPageSize
             If pageEnd > mFileSize Then pageEnd = mFileSize
         End If
         If pageEnd > mFileSize Then
             k = (mFileSize - 1) / mPageSize
             k = NoFraction(k)
             pageStart = k * mPageSize + 1
             pageEnd = pageStart + mPageSize - 1
             If pageEnd > mPageSize Then pageEnd = mPageSize
         End If
    End If
   
      ' Also adjust if required - safety
    If (inStart > 0 And inStart < pageStart) Then inStart = 0
    If (inEnd > 0 And inEnd > pageEnd) Then inEnd = 0
   
      ' Display offset subhead
    picOffset2.CurrentY = 3
    For x = 0 To 15
        tmp = Format$(x, "@@")
        picOffset2.CurrentX = x * StdW1
        picOffset2.Print tmp;
    Next x
   
      ' Restart from top
    picOffSet1.CurrentY = 0
    picHexDisp.CurrentY = 0
    picChrDisp.CurrentY = 0
   
    unDispChar = Chr$(1)
    i = pageStart
    Do While i <= pageEnd
        offSetPos = Format$(i, " @@@@@@@")
        picOffSet1.Print offSetPos
       
        For j = 0 To 15
            If (i + j) > pageEnd Or (i + j) > mFileSize Then
                Exit For
            Else
                mAscii = arrByte(i + j)
                   ' For Hex area
                mHex = Hex(mAscii)
                If Len(mHex) < 2 Then
                    mHex = "0" & mHex
                End If
               
                picHexDisp.CurrentX = j * StdW1
               
                If Hilit = True And (inStart > 0 And inEnd > 0) Then
                    If (i + j) >= inStart And (i + j) <= inEnd Then
                        origX = picHexDisp.CurrentX
                        origY = picHexDisp.CurrentY
                        x = j * StdW1 - ChrW * 0.4
                        y = picHexDisp.CurrentY
                        picHexDisp.ForeColor = inPaint1
                        picHexDisp.Line (x, y)-(x + ChrW * 2.8, _
                              y + picHexDisp.TextHeight("X")), , BF    '"XX" + 0.4*2
                        picHexDisp.ForeColor = inPaint2
                        picHexDisp.CurrentX = origX
                        picHexDisp.CurrentY = origY
                        picHexDisp.Print mHex;
                        picHexDisp.ForeColor = vbBlack
                    Else
                        picHexDisp.Print mHex;
                    End If
                Else
                    picHexDisp.Print mHex;
                End If
               
                   ' For Chr area
                If Hilit = True And (inStart > 0 And inEnd > 0) Then
                    If (i + j) >= inStart And (i + j) <= inEnd Then
                        origX = picChrDisp.CurrentX
                        origY = picChrDisp.CurrentY
                        x = j * StdW2
                        y = picChrDisp.CurrentY
                        picChrDisp.ForeColor = inPaint1
                        picChrDisp.Line (x, y)-(x + ChrW, _
                           y + picChrDisp.TextHeight("X")), inPaint1, BF      ' "X"
                        picChrDisp.ForeColor = inPaint2
                        picChrDisp.CurrentX = origX
                        picChrDisp.CurrentY = origY
                       
                        If mAscii > 31 Then
                            picChrDisp.Print Chr(mAscii);
                        Else
                            picChrDisp.Print unDispChar;
                        End If
                        picChrDisp.ForeColor = vbBlack
                    Else
                        If mAscii > 31 Then
                            picChrDisp.Print Chr(mAscii);
                        Else
                            picChrDisp.Print unDispChar;
                        End If
                    End If
                Else
                    If mAscii > 31 Then
                        picChrDisp.Print Chr(mAscii);
                    Else
                        picChrDisp.Print unDispChar;
                    End If
                End If
            End If
        Next j
        i = i + CharsInRow
        picHexDisp.Print               ' Force picHexDisp change row after earlier ";"
        picHexDisp.CurrentX = 0
        picChrDisp.Print
        picChrDisp.CurrentX = 0        ' Force picChrDisp change row after earlier ";"
    Loop
    For i = 1 To 3
        picHexDisp.Line (StdW1 * 4 * i - ChrW * 0.6, 0)-(StdW1 * 4 * i - ChrW * 0.6, 3), vbBlue, BF
    Next i
    For i = 1 To 3
        picHexDisp.Line (StdW1 * 4 * i - ChrW * 0.6, picHexDisp.ScaleHeight - 4)- _
                (StdW1 * 4 * i - ChrW * 0.6, picHexDisp.ScaleHeight), vbBlue, BF
    Next i
End Sub



Private Sub OptSearch_Click(Index As Integer)
    rtbChr.SelStart = 0                    ' For chr search
    rtbChr.SelLength = 0
    prevFoundPos = 0                       ' For hex search
    If OptSearch(0).Value = True Then
          ckbCaseSensitive.Value = 0
          If Len(txbSearch.Text) > 0 Then
               Dim tmp1 As String, tmp2 As String
               Dim i As Integer
                  ' Purposely not to use Replace()
               tmp1 = txbSearch.Text
               tmp2 = ""
               For i = 1 To Len(tmp1)
                    If Mid(tmp1, i, 1) <> " " Then
                       tmp2 = tmp2 & Mid(tmp1, i, 1)
                    End If
               Next i
               txbSearch.Text = tmp2
               txbSearch.Text = UCase(txbSearch.Text)
          End If
    Else
          ckbCaseSensitive.Value = 1            ' Default
    End If
End Sub



Private Sub txbSearch_KeyPress(KeyAscii As Integer)
    If OptSearch(0).Value = True Then
         KeyAscii = FilterHexKey(KeyAscii)
    End If
End Sub



Private Sub txbGoTo_KeyPress(KeyAscii As Integer)
    KeyAscii = FilterNumericKey(KeyAscii)
End Sub



Private Sub picHexDisp_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    Dim i, j
    Dim k As Long
    Dim mHex As String
    i = NoFraction(x / StdW1)
    j = NoFraction(y / StdH1) * CharsInRow
    k = pageStart + j + i
    If k > pageEnd Then                          ' Outside displayed area
         Exit Sub
    End If
    ShowPage True, k, k, vbYellow, vbBlue        ' So to result in yellow, same as ForeColor of lblAscii & lblBinary
    mHex = Hex$(arrByte(k))
    If Len(mHex) < 2 Then mHex = "0" & mHex
    lblAscii.Caption = Trim(CStr(CInt("&h" & mHex)))
    lblBinary.Caption = HexToBinStr(mHex)
End Sub



Private Sub picChrDisp_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    Dim i, j
    Dim k As Long
    Dim mHex As String
    i = NoFraction(x / StdW2)
    j = NoFraction(y / StdH2) * CharsInRow
    k = pageStart + j + i
    If k > pageEnd Then                          ' Outside displayed area
         Exit Sub
    End If
    ShowPage True, k, k, vbYellow, vbBlue
    mHex = Hex$(arrByte(k))
    If Len(mHex) < 2 Then mHex = "0" & mHex
    lblAscii.Caption = Trim(CStr(CInt("&h" & mHex)))
    lblBinary.Caption = HexToBinStr(mHex)
End Sub



Private Sub Form_KeyUp(keycode As Integer, Shift As Integer)
    If lblFileSpec.Caption = "" Then
        Exit Sub
    End If
    If mFileSize <= mPageSize Then
        Exit Sub
    End If
    Select Case keycode
        Case 34           ' PgDn
            cmdPgDn_Click
        Case 33           ' PgUp
            cmdPgUp_Click
        Case 40           ' Dn
            cmdDn_Click
        Case 38           ' Up
            cmdUp_Click
        Case 36           ' Home
            cmdFirst_Click
        Case 35           ' End
            cmdLast_Click
    End Select
End Sub



Private Sub cmdPgDn_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    If mFileSize <= mPageSize Then
         Exit Sub
    End If
    If pageEnd = mFileSize Then
         Exit Sub
    End If
    picHexDisp.SetFocus
    pageStart = pageStart + mPageSize
    If pageStart > mFileSize Then pageStart = pageStart - mPageSize
    pageEnd = pageEnd + mPageSize
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdPgUp_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    If mFileSize <= mPageSize Then
         Exit Sub
    End If
    If pageStart = 1 Then
         Exit Sub
    End If
    picHexDisp.SetFocus
    pageStart = pageStart - mPageSize
    If pageStart < 1 Then pageStart = 1
    pageEnd = pageStart + mPageSize - 1
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdDn_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    If mFileSize <= mPageSize Then
         Exit Sub
    End If
    If pageEnd = mFileSize Then
         Exit Sub
    End If
    picHexDisp.SetFocus
    pageStart = pageStart + CharsInRow
    If pageStart > mFileSize Then pageStart = pageStart - CharsInRow
    pageEnd = pageStart + mPageSize - 1
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdUp_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    If mFileSize <= mPageSize Then
         Exit Sub
    End If
    If pageStart <= CharsInRow Then
        Exit Sub
    End If
    picHexDisp.SetFocus
    pageStart = pageStart - CharsInRow
    If pageStart < 1 Then pageStart = pageStart + CharsInRow
    pageEnd = pageStart + mPageSize - 1
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdFirst_Click()
    If lblFileSpec.Caption = "" Then
        Exit Sub
    End If
    If mFileSize <= mPageSize Then
        Exit Sub
    End If
    picHexDisp.SetFocus
    pageStart = 1
    pageEnd = mPageSize
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdLast_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    If mFileSize <= mPageSize Then
         Exit Sub
    End If
    picHexDisp.SetFocus
    Dim k
    k = (mFileSize - 1) / mPageSize
    k = NoFraction(k)
    pageStart = k * mPageSize + 1
    pageEnd = pageStart + mPageSize - 1
    If pageEnd > mFileSize Then pageEnd = mFileSize
    ShowPage False
End Sub



Private Sub cmdSearchFromStart_Click()
    rtbChr.SelStart = 0                    ' For chr search
    rtbChr.SelLength = 0
    prevFoundPos = 0                       ' For hex search
    cmdSearchOrFindNext_Click
End Sub



Private Sub cmdSearchOrFindNext_Click()
    If lblFileSpec.Caption = "" Then
         Exit Sub
    End If
    picHexDisp.SetFocus
    If Len(txbSearch.Text) = 0 Then
         MsgBox "No search text entered yet"
         Exit Sub
    End If
    If OptSearch(1).Value = True Then
         doChrSearch
    Else
         If (Len(txbSearch.Text) Mod 2) > 0 Then
              MsgBox "Incorrect hex value entered"
              Exit Sub
         End If
         doHexSearch
    End If
End Sub




Private Sub doChrSearch()
    On Error Resume Next
    Dim foundStartPos As Long
    Screen.MousePointer = vbHourglass
    foundStartPos = rtbChr.SelStart
    If foundStartPos = 0 Then
        If ckbCaseSensitive.Value = 0 Then              ' Not checked
             foundStartPos = InStr(foundStartPos + 1, UCase(rtbChr.Text), UCase(txbSearch.Text))
        Else                                            ' Checked
             foundStartPos = InStr(foundStartPos + 1, rtbChr.Text, txbSearch.Text)
        End If
    Else
        If ckbCaseSensitive.Value = 0 Then              ' Not checked
             foundStartPos = InStr(foundStartPos + 2, UCase(rtbChr.Text), UCase(txbSearch.Text))
        Else                                            ' Checked
             foundStartPos = InStr(foundStartPos + 2, rtbChr.Text, txbSearch.Text)
        End If
    End If
    If foundStartPos = prevFoundPos Then
        prevFoundPos = 0
    Else
        prevFoundPos = foundStartPos
    End If
    If foundStartPos = 0 Then
          ' Start the search from beginning
        rtbChr.SelStart = 0
        rtbChr.SelLength = 0
    Else
          ' Start the search from this point
        rtbChr.SelStart = foundStartPos - 1
        rtbChr.SelLength = Len(txbSearch.Text)
    End If
    Screen.MousePointer = vbDefault
    If prevFoundPos > 0 And rtbChr.SelLength > 0 Then
        Dim k
        k = (foundStartPos + 1) / CLng(mPageSize)
        k = NoFraction(k)
        pageStart = k * mPageSize + 1
        pageEnd = pageStart + mPageSize - 1
        If pageEnd > mFileSize Then pageEnd = mFileSize
        k = foundStartPos + (Len(txbSearch.Text) - 1)
        If k > pageEnd Then k = pageEnd
          ' So to result in Aqua, similar to txbSearch BgColor
        ShowPage True, foundStartPos, k, &HFFFF00, vbRed
        Exit Sub
    End If
    MsgBox txbSearch.Text & vbCrLf & vbCrLf & "Searched to end."
End Sub



Private Sub doHexSearch()
    On Error Resume Next
    Dim HexCtn As Integer
    Dim i, j
    Dim mMatch As Boolean
    Dim foundStartPos As Long
    Screen.MousePointer = vbHourglass
    HexCtn = Len(txbSearch.Text) / 2
    ReDim arrHexByte(1 To HexCtn)
    For i = 1 To HexCtn
         arrHexByte(i) = CByte("&h" & (Mid(txbSearch.Text, (i * 2 - 1), 2)))
    Next i
    foundStartPos = prevFoundPos + 1
    For i = foundStartPos To (UBound(arrByte) - (HexCtn - 1))
         If arrByte(i) = arrHexByte(1) Then
              mMatch = True
                ' Compare rest bytes
              For j = 1 To (HexCtn - 1)
                   If arrByte(i + j) <> arrHexByte(1 + j) Then
                       mMatch = False
                       Exit For
                   End If
              Next j
              If mMatch = True Then
                   Dim k
                   foundStartPos = i
                   prevFoundPos = i
                   k = (foundStartPos + 1) / CLng(mPageSize)
                   k = NoFraction(k)
                   pageStart = k * mPageSize + 1
                   pageEnd = pageStart + mPageSize - 1
                   If pageEnd > mFileSize Then pageEnd = mFileSize
                   k = foundStartPos + (HexCtn - 1)
                   If k > pageEnd Then k = pageEnd
                   ShowPage True, foundStartPos, k, &HFFFF00, vbRed
                   Screen.MousePointer = vbDefault
                   Exit Sub
              End If
         End If
    Next i
    Screen.MousePointer = vbDefault
    prevFoundPos = 0
    MsgBox txbSearch.Text & vbCrLf & vbCrLf & "Searched to end."
End Sub



Private Sub cmdGoTo_Click()
    If Len(txbGoTo.Text) = 0 Then
        MsgBox "No byte position entered yet"
        Exit Sub
    ElseIf Val(txbGoTo.Text) > mFileSize Then
        MsgBox "Entry exceeds file size"
        Exit Sub
    End If
    Dim k
    Dim i As Long
    i = Val(txbGoTo.Text)
    If i > mPageSize Then
        k = (i + 1) / CLng(mPageSize)
        k = NoFraction(k)
        pageStart = k * mPageSize + 1
    Else
        pageStart = 1
    End If
    pageEnd = pageStart + mPageSize - 1
    If pageEnd > mFileSize Then
        pageEnd = mFileSize
    End If
    ShowPage True, i, i, vbYellow, vbBlue
End Sub



Function NoFraction(ByVal inVal As Variant) As Long
    Dim x As Integer
    Dim tmp As String
    Dim k As Long
    tmp = CStr(inVal)
    x = InStr(tmp, ".")
    If x > 0 Then
        tmp = Left(tmp, x - 1)
    End If
    k = Val(tmp)
    NoFraction = k
End Function




Private Sub cmdPrintPage_Click()
    On Error GoTo errHandler
    gcdg.CancelError = True
    gcdg.Flags = cdlPDReturnDC + cdlPDNoPageNums + cdlPDNoSelection
    gcdg.ShowPrinter
    picContainer.Picture = LoadPicture()
    BitBlt picContainer.hDC, picOffSet1.Left, picOffSet1.Top, picOffSet1.ScaleWidth, _
       picOffSet1.ScaleHeight, picOffSet1.hDC, 0, 0, vbSrcCopy
    BitBlt picContainer.hDC, picOffset2.Left, picOffset2.Top, picOffset2.ScaleWidth, _
       picOffset2.ScaleHeight, picOffset2.hDC, 0, 0, vbSrcCopy
    BitBlt picContainer.hDC, picHexDisp.Left, picHexDisp.Top, picHexDisp.ScaleWidth, _
       picHexDisp.ScaleHeight, picHexDisp.hDC, 0, 0, vbSrcCopy
    BitBlt picContainer.hDC, picChrDisp.Left, picChrDisp.Top, picChrDisp.ScaleWidth, _
       picChrDisp.ScaleHeight, picChrDisp.hDC, 0, 0, vbSrcCopy
    picContainer.Picture = picContainer.Image
    Printer.Print ""
    Printer.CurrentX = 1440
    Printer.CurrentY = 1440
    Printer.Print gcdg.FileName
    Printer.PaintPicture picContainer.Picture, 1440, 2880
    Printer.EndDoc
    picContainer.Picture = LoadPicture()
    Exit Sub
errHandler:
If Err <> 32755 Then
    ErrMsgProc "cmdPrintPage_Click"
End If
End Sub



Private Function HexToBinStr(ByVal inHex As String) As String
    Dim mDec As Integer
    Dim s As String
    Dim i
    mDec = CInt("&h" & inHex)
    s = Trim(CStr(mDec Mod 2))
    i = mDec \ 2
    Do While i <> 0
        s = Trim(CStr(i Mod 2)) & s
        i = i \ 2
    Loop
    Do While Len(s) < 8
        s = "0" & s
    Loop
    HexToBinStr = s
    Exit Function
End Function



Function FilterNumericKey(inkey) As Integer
    If inkey < Asc("0") Or inkey > Asc("9") Then
        If inkey <> 8 Then
            inkey = 0
        End If
    End If
    FilterNumericKey = inkey
End Function


Sub ErrMsgProc(mMsg As String)
    MsgBox mMsg & vbCrLf & Err.Number & Space(5) & Err.Description
End Sub



Function FilterHexKey(mInkey) As Integer
    If mInkey < Asc("0") Or mInkey > Asc("9") Then
        If Not (mInkey >= Asc("A") And mInkey <= Asc("F")) Then
            If Not (mInkey >= Asc("a") And mInkey <= Asc("f")) Then
                 If mInkey <> 8 Then
                      mInkey = 0
                 End If
            End If
        End If
    End If
    If mInkey >= Asc("a") And mInkey <= Asc("f") Then
        mInkey = mInkey - 32
    End If
    FilterHexKey = mInkey
End Function

Project Homepage: