form1.frm

一个完整的用VB实现的16进制编辑器程序的源代码

HexSet = Hex(HexDisplayed(no))
If Len(HexSet) = 1 Then HexSet = "0" & HexSet

Edit.Visible = True
Showtxt.Visible = True

If Fileopen = False Then Edit.Visible = False: Showtxt.Visible = False
If HexSet <> "100" Then Edit.Text = HexSet Else Edit.Text = ""
End Sub

Private Sub Down1_Click()
If CurrentPos > SizeOfFile - 10 Then Exit Sub
ByteNo.Caption = ""
Edit.Visible = False
Showtxt.Visible = False
CurrentPos = CurrentPos + 10
SortHex
End Sub

Private Sub Down10_Click()
If CurrentPos > SizeOfFile - 100 Then Exit Sub
ByteNo.Caption = ""
Edit.Visible = False
Showtxt.Visible = False
CurrentPos = CurrentPos + 100
SortHex
End Sub

Private Sub Edit_KeyPress(KeyAscii As Integer)
Dim Character As String

If ByteNo.Caption > SizeOfFile Then Exit Sub
Character = Chr(KeyAscii)
KeyAscii = Asc(UCase(Character))
If Chr(KeyAscii) <> vbBack Then
    If (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 70) Then
        DoEvents
    Else
        KeyAscii = 0
    End If
End If
End Sub

Private Sub Edit_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If ByteNo.Caption > SizeOfFile Then Exit Sub
no = ((SetRow - 1) * 10) + SetCol
ByteArray((CurrentPos - 1) + no) = HexToDec(Edit.Text)
HexDisplayed(no) = HexToDec(Edit.Text)
SortHex
Showtxt.Caption = Chr(HexToDec(Edit.Text))
End Sub

Private Sub editmodemnu_Click()
Dim SetTemp As Integer, SAlpha As String
If Selected = False Then
    ByteNo.Caption = ""
    editmodemnu.Checked = True
    edmode.Checked = True
    Selected = True
    Edit.BackColor = vbYellow
    Edit.ForeColor = vbBlack
    Edit.Locked = False
    Edit.Left = 0
    Edit.Top = 0
    Edit.Text = Hex(HexDisplayed(1))
    Showtxt.Left = 0
    Showtxt.Top = 0
    SetTemp = HexDisplayed(1)
    If SetTemp = 0 Or SetTemp = 13 Or SetTemp = 10 Then
        SAlpha = " "
    Else
        SAlpha = Chr(SetTemp)
    End If
    Showtxt.Caption = SAlpha
Else
    ByteNo.Caption = ""
    editmodemnu.Checked = False
    edmode.Checked = False
    Selected = False
    Edit.Locked = True
    Edit.BackColor = &H800000
    Edit.ForeColor = vbWhite
    Edit.Left = 0
    Edit.Top = 0
    Edit.Text = Hex(HexDisplayed(1))
    Showtxt.Left = 0
    Showtxt.Top = 0
    SetTemp = HexDisplayed(1)
    If SetTemp = 0 Or SetTemp = 13 Or SetTemp = 10 Then
        SAlpha = " "
    Else
        SAlpha = Chr(SetTemp)
    End If
    Showtxt.Caption = SAlpha
End If
End Sub

Private Sub edmode_Click()
    editmodemnu_Click
End Sub

Private Sub exitmnu_Click()
Unload Me
End
End Sub

Private Sub Form_Load()
On Error Resume Next
CmdEdit.Caption = "Edit Mode"
Edit.Locked = True
Edit.BackColor = &H800000
Edit.ForeColor = vbWhite
editmodemnu.Checked = False
edmode.Checked = False
Edit.Width = HexDisplay.Width / 10
Edit.Height = HexDisplay.Height / 10
Showtxt.Width = HexDisplay.Width / 10
Showtxt.Height = HexDisplay.Height / 10
Attributes (False)

ColSet.Print " 1     2     3     4     5     6     7     8     9    10"


End Sub

Private Sub gob_Click()
bytemnu_Click
End Sub

Private Sub gos_Click()
searchmnu_Click
End Sub

Private Sub hexdisp_KeyPress(KeyAscii As Integer)
Character = Chr(KeyAscii)
KeyAscii = Asc(UCase(Character))

If Chr(KeyAscii) <> vbBack Then
    If (KeyAscii >= 48 And KeyAscii <= 57) Or (KeyAscii >= 65 And KeyAscii <= 70) Then
        DoEvents
    Else
        KeyAscii = 0
    End If
End If
End Sub

Private Sub hexdisp_KeyUp(KeyCode As Integer, Shift As Integer)
Dim AscStore As Integer
AscStore = HexToDec(hexdisp)
asciidisp.Text = AscStore
chardisp.Text = Chr(AscStore)
binarytxt.Text = GetBinary(hexdisp.Text)
End Sub

Private Sub HexDisplay_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ' complete
On Error Resume Next
Dim Col, Row, no As Integer, HexSet As String, SAlpha As String, SetTemp As Integer

If Button = 2 And Fileopen = True Then
PopupMenu popup, , HexDisplay.Left + X + 30, HexDisplay.Top + Y + 380
Exit Sub
End If

Edit.Left = Int((X / HexDisplay.Width) * 10) * (HexDisplay.Width / 10)
Edit.Top = Int((Y / HexDisplay.Height) * 10) * (HexDisplay.Height / 10)

Showtxt.Left = Int((X / HexDisplay.Width) * 10) * (HexDisplay.Width / 10)
Showtxt.Top = Int((Y / HexDisplay.Height) * 10) * (HexDisplay.Height / 10)


Col = Int((X / HexDisplay.Width) * 10) + 1
Row = Int((Y / HexDisplay.Height) * 10) + 1

SetRow = Row
SetCol = Col

no = ((Row - 1) * 10) + Col


SetTemp = HexDisplayed(no)

If SetTemp = 0 Or SetTemp = 13 Or SetTemp = 10 Then
    SAlpha = " "
Else
    SAlpha = Chr(SetTemp)
End If

Showtxt.Caption = SAlpha

If Fileopen = True Then
    ByteNo.Caption = CurrentPos + (no - 1)
End If

HexSet = Hex(HexDisplayed(no))
If Len(HexSet) = 1 Then HexSet = "0" & HexSet

Edit.Visible = True
Showtxt.Visible = True

If Fileopen = False Then Edit.Visible = False: Showtxt.Visible = False
If HexSet <> "100" Then Edit.Text = HexSet Else Edit.Text = ""
End Sub

Function OpenFile()
On Error Resume Next
Dim Fno As Integer
Fno = FreeFile

Open FileName For Binary As #Fno
    SizeOfFile = LOF(Fno)
    ReDim ByteArray(1 To SizeOfFile) As Byte
    Get #Fno, , ByteArray
Close #Fno

CurrentPos = 1
StartByte = 0
Attributes (True)
Size.Caption = " " & SizeOfFile & " bytes"
Me.Caption = "Hex Editor Pro - " & FileName
Call SortHex
End Function

Function SortHex()
On Error Resume Next
Dim Counter As Integer, Counter2 As Integer, HexSet As String
Dim Line1 As String, Lines(1 To 10) As String, SAlpha As String, SetTemp As Integer
Static Pos As Integer

For Counter = 1 To 100
    If ((CurrentPos - 1) + Counter) > SizeOfFile Then
        HexDisplayed(Counter) = 256
    Else
        HexDisplayed(Counter) = ByteArray((CurrentPos - 1) + Counter)
    End If
Next Counter

For Counter = 1 To 10
    Pos = (Counter - 1) * 10
    For Counter2 = 1 To 10
        Pos = Pos + 1
        HexSet = Hex(HexDisplayed(Pos))
        If Len(HexSet) = 1 Then HexSet = "0" & HexSet
        If HexSet <> "100" Then Lines(Counter) = Lines(Counter) & HexSet & " "
    Next Counter2
Next Counter

HexDisplay.Cls
For Counter = 1 To 10
    HexDisplay.Print Lines(Counter)
Next Counter
DispTxt.Cls

For Counter = 1 To 10
Line1 = ""
    For Counter2 = 1 To 10
        SetTemp = HexDisplayed(((Counter - 1) * 10) + Counter2)
        If SetTemp < 256 Then
            If SetTemp = 0 Or SetTemp = 13 Or SetTemp = 10 Then
                SAlpha = " "
            Else
                SAlpha = Chr(SetTemp)
            End If
        Else
            SAlpha = ""
        End If
        Line1 = Line1 & "  " & SAlpha
    Next Counter2
    Line1 = Mid(Line1, 3, Len(Line1) - 2)
DispTxt.Print Line1
Next Counter

Position.Cls
For Counter = 1 To 10
    Position.Print (((Counter - 1) * 10) + (CurrentPos) - 1)
Next Counter

End Function

Private Sub insertb_Click()
CmdInsert_Click
End Sub

Private Sub insertbytes_Click()
CmdInsert_Click
End Sub

Private Sub openmnu_Click()
On Error Resume Next
Dim File As String
Edit.Visible = False
Showtxt.Visible = False
File = CommonDialog.ShowOpenDlg(Me.hwnd, "All files (*.*)" & Chr(0) & "*.*")

If File <> "Cancel" Then
    FileName = File
Else
    Exit Sub
End If

OpenFile
End Sub

Private Sub rembyte_Click()
cmdremove_Click
End Sub

Private Sub removeb_Click()
cmdremove_Click
End Sub

Private Sub savemnu_Click()
Dim Fno As Integer
If Fileopen = False Then Exit Sub
If MsgBox("Are you sure you want to save the changes?", vbYesNo) = vbYes Then
Fno = FreeFile

Open FileName For Binary As #Fno
Put #Fno, , ByteArray
Close #Fno
End If
End Sub

Private Sub searchmnu_Click()
If Fileopen = False Then Exit Sub
Form3.Show
End Sub


Private Sub textDisplay_DblClick()
MsgBox Len(textDisplay.Text)
End Sub


Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

On Error Resume Next
If Button.Key = "open" Then openmnu_Click
If Button.Key = "save" Then savemnu_Click
If Button.Key = "close" Then closemnu_Click


If Fileopen = True Then
    If Button.Key = "Remove" Then cmdremove_Click
    If Button.Key = "Add" Then AddBytes_Click
    If Button.Key = "Insert" Then CmdInsert_Click
    If Button.Key = "search" Then searchmnu_Click
    If Button.Key = "goto" Then bytemnu_Click
    If Button.Key = "Edit" Then
        If Button.Image = 2 Then
            editmodemnu_Click
            Button.Image = 3
        Else
            editmodemnu_Click
            Button.Image = 2
        End If
    End If
End If
End Sub

Private Sub vTop_Click()
ByteNo.Caption = ""
CurrentPos = 1
Edit.Visible = False
Showtxt.Visible = False
SortHex
End Sub

Private Sub Up1_Click()
If CurrentPos - 10 < 1 Then vTop_Click: Exit Sub
ByteNo.Caption = ""
Edit.Visible = False
Showtxt.Visible = False
CurrentPos = CurrentPos - 10
SortHex
End Sub

Private Sub Up10_Click()
If CurrentPos - 100 < 1 Then vTop_Click: Exit Sub
ByteNo.Caption = ""
Edit.Visible = False
Showtxt.Visible = False
CurrentPos = CurrentPos - 100
SortHex
End Sub

Function HexSearch(HexVal As String, StartVal As Long) As Long
Dim ASCIIVal As Integer, Counter As Long
ASCIIVal = HexToDec(HexVal)
For Counter = StartVal To SizeOfFile
If ByteArray(Counter) = ASCIIVal Then HexSearch = Counter: Exit Function Else HexSearch = -1
Next Counter
End Function

Function SearchChars(SearchString As String, StartVal As Long) As Long
Dim Counter As Long, StrArr() As Integer, Counter2 As Integer, Check As Boolean

ReDim StrArr(1 To Len(SearchString)) As Integer
Check = True

For Counter = 1 To Len(SearchString)
StrArr(Counter) = Asc(Mid(SearchString, Counter, 1))
Next Counter

For Counter = StartVal To SizeOfFile
If ByteArray(Counter) = StrArr(1) Then

    If Len(SearchString) > 1 Then
        For Counter2 = 2 To Len(SearchString)
            If ByteArray(Counter + (Counter2 - 1)) <> StrArr(Counter2) Then
                Check = False
            End If
        Next Counter2
        If Check = True Then SearchChars = Counter: Exit Function
    Else
        SearchChars = Counter
        Exit Function
    End If
    
End If

Next Counter
SearchChars = -1
End Function

Function GetBinary(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
    GetBinary = s
End Function


Function Attributes(Value As Boolean)
Fileopen = Value
Down1.Enabled = Value
Down10.Enabled = Value
Bottom.Enabled = Value
Up1.Enabled = Value
Up10.Enabled = Value
VTop.Enabled = Value
CmdInsert.Enabled = Value
insertbytes.Enabled = Value
rembyte.Enabled = Value
addbyte.Enabled = Value
AddBytes.Enabled = Value
SearchChar = Value
cmdremove.Enabled = Value
If Value = False Then Edit.Visible = False: Showtxt.Visible = False
End Function