pctools.frm

一个修改二进制文件的小程序,不过在打开大于1M的文件时耗时较长

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form1 
   Caption         =   "整人专家"
   ClientHeight    =   3255
   ClientLeft      =   3990
   ClientTop       =   3270
   ClientWidth     =   4680
   Icon            =   "pctools.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3255
   ScaleWidth      =   4680
   Begin MSComDlg.CommonDialog cdopen 
      Left            =   1200
      Top             =   1440
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      Filter          =   "All Files(*.*)|*.*"
   End
   Begin RichTextLib.RichTextBox rdata 
      Height          =   3255
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4695
      _ExtentX        =   8281
      _ExtentY        =   5741
      _Version        =   393217
      ReadOnly        =   -1  'True
      ScrollBars      =   2
      TextRTF         =   $"pctools.frx":0442
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuOpen 
         Caption         =   "打开(&F)..."
      End
      Begin VB.Menu mnuComp 
         Caption         =   "比较(&C)..."
      End
      Begin VB.Menu mnuMRU 
         Caption         =   "-"
         Index           =   0
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMRU 
         Caption         =   ""
         Index           =   1
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMRU 
         Caption         =   ""
         Index           =   2
         Visible         =   0   'False
      End
      Begin VB.Menu mnuMRU 
         Caption         =   ""
         Index           =   3
         Visible         =   0   'False
      End
      Begin VB.Menu mnuSep1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuEnd 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu mnuEdit 
      Caption         =   "编辑(&E)"
      Begin VB.Menu mnuLocate 
         Caption         =   "定位(&L)"
      End
      Begin VB.Menu mnuFind 
         Caption         =   "查找(&F)..."
      End
      Begin VB.Menu mnuReplace 
         Caption         =   "替换(&R)..."
         Shortcut        =   {F3}
      End
   End
   Begin VB.Menu mnuOther 
      Caption         =   "辅助(&O)"
      Begin VB.Menu mnuHexConv 
         Caption         =   "十六进制换器(&C)"
      End
      Begin VB.Menu mnuCharacter 
         Caption         =   "汉字转换器(&S)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
If App.PrevInstance Then End
'MyStr = "": IsNum = False
GetRecentFiles
Dim i As Byte
Form1.Show
For i = 0 To 9
    HexVal(i) = 48 + i
Next i
For i = 10 To 15
    HexVal(i) = 55 + i
Next i
For i = 0 To 254
    HexValA(i) = HexVal(i \ 16)
    HexValB(i) = HexVal(i Mod 16)
Next i
HexValA(255) = HexVal(15): HexValB(255) = HexVal(15)
End Sub

Private Sub Form_Resize()
If Me.WindowState <> 1 Then
    rdata.Width = Form1.Width - 105
    rdata.Height = Form1.Height - 690
    'rdata.RightMargin = rdata.Width
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
rdata.Text = ""
End
End Sub

Private Sub mnuOpen_Click()
On Error GoTo err
With cdopen
    .FileName = OpenName
    .DialogTitle = "打开"
    .ShowOpen
End With
Start = GetTime
rdata.MousePointer = rtfHourglass
OpenName = cdopen.FileName
OpenHex OpenName
Me.Caption = App.Title & "-" & GetFileTitle(OpenName)
Update OpenName
MsgBox "共耗时" & Str((GetTime - Start) / freq) & "秒", vbInformation
rdata.MousePointer = 0
Exit Sub
err:
    rdata.MousePointer = 0
    MsgBox "无法打开此文件,请确认文件是否仍然存在", vbCritical
End Sub

Private Sub mnuComp_Click()
On Error GoTo err
With cdopen
    .FileName = OpenName
    .DialogTitle = "比较文件1"
    .ShowOpen
    CompName1 = .FileName
End With
With cdopen
    .FileName = CompName2
    .DialogTitle = "比较文件2"
    .ShowOpen
    CompName2 = .FileName
End With
Form3.Show
err:
End Sub

Private Sub mnuMRU_Click(Index As Integer)
On Error GoTo err
Dim strFile As String
Dim key As String
strFile = Mid$(mnuMRU(Index).Caption, 4)
OpenHex strFile
cdopen.FileName = strFile
OpenName = strFile
Me.Caption = App.Title & "-" & GetFileTitle(OpenName)
key = "RecentFile" & Index
strFile = GetSetting(App.Title, ThisKey, key)
WriteRecentFile strFile, Index
GetRecentFiles
Exit Sub
err:
    MsgBox "无法打开此文件,请确认文件是否仍然存在", vbCritical
End Sub

Private Sub mnuEdit_Click()
If Len(rdata.Text) = 0 Then
    mnuFind.Enabled = False
    mnuReplace.Enabled = False
    mnuLocate.Enabled = False
    Exit Sub
Else
    mnuFind.Enabled = True
    mnuLocate.Enabled = True
End If
If (rdata.SelStart Mod 3 = 0 And rdata.SelLength Mod 3 <> 1) And rdata.SelLength <> 0 Then mnuReplace.Enabled = True Else mnuReplace.Enabled = False
End Sub

Private Sub mnuEnd_Click()
rdata.Text = ""
End
End Sub

Private Sub mnuLocate_Click()
Dim n
n = InputBox("共" & Len(rdata.Text) / 3 & "字节" & Chr(13) & Chr(10) & "请输入要查找的字节数")
If IsNumeric(n) Then
    If InStr(n, ".") = 0 And n > 0 And n <= Len(rdata.Text) / 3 Then
        rdata.SelStart = 3 * n - 3: rdata.SelLength = 2
    End If
End If
End Sub

Private Sub mnuFind_Click()
Dim k As String
Dim Pos As Long
With Form2
    .Caption = "查找"
    .Text1 = FindStr
    MyStr = FindStr
    .opt(1).Value = IsNum
    .Text1.SelStart = 0
    .Text1.SelLength = Len(Trim$(MyStr))
    .Show 1
    'a = SetWindowPos(.hwnd, -1, 0, 0, 0, 0, 67)
End With
If al Then
    Form1.Refresh
    Form4.List1.Clear
    k = MyStr
    If IsNum Then k = mst(Val(k))
    Pos = 1
    Do While True
        Pos = InStr(Pos, rdata.Text, k)
        If Pos = 0 Then
            MsgBox "搜索完毕", vbInformation
            SetWindowPos Form4.hwnd, -1, 0, 0, 0, 0, 67
            FindStr = MyStr
            Exit Sub
        End If
        Form4.List1.AddItem Pos \ 3 + 1
        Pos = Pos + 3
    Loop
End If
End Sub

Private Sub mnuReplace_Click()
Dim k As String
Dim m As Long, n As Long, l As Long
With Form2
    .Caption = "替换"
    .Text1 = ReplaceStr
    MyStr = ReplaceStr
    .opt(1).Value = IsNum
    .Text1.SelStart = 0
    .Text1.SelLength = Len(Trim$(MyStr))
    .Show 1
End With
If al Then
    k = MyStr
    If IsNum Then k = mst(Val(MyStr))
    m = rdata.SelStart \ 3 + 1
    If rdata.SelLength Mod 3 = 2 Then rdata.SelLength = rdata.SelLength + 1
    l = Len(k)
    If l <> rdata.SelLength Then MsgBox "数据不匹配", vbCritical: Exit Sub
    n = 1
    Open OpenName For Binary As #2
    Do Until n > l
        Put #2, m, de(Mid$(k, n, 2))
        m = m + 1
        n = n + 3
    Loop
    Close #2
    rdata.SelText = k
    ReplaceStr = MyStr
End If
End Sub

Private Sub mnuHexConv_Click()
Form5.Show
End Sub

Private Sub mnuCharacter_Click()
Form6.Show
End Sub

Private Sub rdata_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then mnuEdit_Click: PopupMenu mnuEdit
End Sub