frmmain.frm

一款VB 工具

    Recent2Title = GetSetting("VB Decompiler", "Options", "Recent2FileTitle", "")
    Recent3Title = GetSetting("VB Decompiler", "Options", "Recent3FileTitle", "")
    Recent1File = GetSetting("VB Decompiler", "Options", "Recent1File", "")
    Recent2File = GetSetting("VB Decompiler", "Options", "Recent2File", "")
    Recent3File = GetSetting("VB Decompiler", "Options", "Recent3File", "")



    If Recent1Title <> "" Then
        mnuFileRecent2.Visible = True
    End If
    If Recent2Title <> "" Then
        mnuFileRecent3.Visible = True
    End If
    If Recent3Title <> "" Then
        mnuFileRecent4.Visible = True
    End If


    Call SaveSetting("VB Decompiler", "Options", "Recent4File", Recent3File)
    Call SaveSetting("VB Decompiler", "Options", "Recent4FileTitle", Recent3Title)
    Call SaveSetting("VB Decompiler", "Options", "Recent3File", Recent2File)
    Call SaveSetting("VB Decompiler", "Options", "Recent3FileTitle", Recent2Title)
    Call SaveSetting("VB Decompiler", "Options", "Recent2File", Recent1File)
    Call SaveSetting("VB Decompiler", "Options", "Recent2FileTitle", Recent1Title)


    Call SaveSetting("VB Decompiler", "Options", "Recent1File", Filename)
    Call SaveSetting("VB Decompiler", "Options", "Recent1FileTitle", FileTitle)



    mnuFileRecent4.Caption = mnuFileRecent3.Caption
    mnuFileRecent3.Caption = mnuFileRecent2.Caption
    mnuFileRecent2.Caption = mnuFileRecent1.Caption
    mnuFileRecent1.Caption = FileTitle


End Sub
Sub MakeDir(path As String)
    '*****************************
    'Purpose: To make a dir without erroring
    '*****************************

    On Error Resume Next
    MkDir (path)

End Sub

Private Sub mnuFileRecent1_Click()
    '*****************************
    'Purpose: To load a recent file if it exists
    '*****************************
    Dim RecentTitle As String
    Dim RecentFile As String
    RecentTitle = GetSetting("VB Decompiler", "Options", "Recent1FileTitle", "")
    RecentFile = GetSetting("VB Decompiler", "Options", "Recent1File", "")
    If FileExists(RecentFile) = True Then
        Call OpenVBExe(RecentFile, RecentTitle)
    Else
        MsgBox "File no longer exists!", vbExclamation
    End If
End Sub

Private Sub mnuFileRecent2_Click()
    '*****************************
    'Purpose: To load a recent file if it exists
    '*****************************
    Dim RecentTitle As String
    Dim RecentFile As String
    RecentTitle = GetSetting("VB Decompiler", "Options", "Recent2FileTitle", "")
    RecentFile = GetSetting("VB Decompiler", "Options", "Recent2File", "")
    If FileExists(RecentFile) = True Then
        Call OpenVBExe(RecentFile, RecentTitle)
    Else
        MsgBox "File no longer exists!", vbExclamation
    End If
End Sub

Private Sub mnuFileRecent3_Click()
    '*****************************
    'Purpose: To load a recent file if it exists
    '*****************************
    Dim RecentTitle As String
    Dim RecentFile As String
    RecentTitle = GetSetting("VB Decompiler", "Options", "Recent3FileTitle", "")
    RecentFile = GetSetting("VB Decompiler", "Options", "Recent3File", "")
    If FileExists(RecentFile) = True Then
        Call OpenVBExe(RecentFile, RecentTitle)
    Else
        MsgBox "File no longer exists!", vbExclamation
    End If
End Sub

Private Sub mnuFileRecent4_Click()
    '*****************************
    'Purpose: To load a recent file if it exists
    '*****************************
    Dim RecentTitle As String
    Dim RecentFile As String
    RecentTitle = GetSetting("VB Decompiler", "Options", "Recent4FileTitle", "")
    RecentFile = GetSetting("VB Decompiler", "Options", "Recent4File", "")
    If FileExists(RecentFile) = True Then
        Call OpenVBExe(RecentFile, RecentTitle)
    Else
        MsgBox "File no longer exists!", vbExclamation
    End If
End Sub

Private Sub mnuFileSaveExe_Click()
    '#####################################
    'Purpose: Save Changes to the Form's Gui
    'And generates a Patch Report
    '#####################################
    Cd1.DialogTitle = "Save As"
    Cd1.Filename = ""
    Cd1.Filter = "VB Files(*.exe,*.ocx,*.dll)|*.exe;*.ocx;*.dll"
    Cd1.ShowSave

    If Cd1.Filename = "" Then Exit Sub
    On Error Resume Next
    'Copy the exe to the temp directory
    FileCopy SFilePath, App.path & "\dump\" & SFile & "\" & SFile

    'Make the changes
    fFile = FreeFile
    Dim i As Integer
    Dim NewByte As Byte
    Open App.path & "\dump\" & SFile & "\" & SFile For Binary Access Write Lock Write As fFile
    If UBound(StringChange) > 0 Then
        For i = 1 To UBound(StringChange)
            Seek fFile, StringChange(i).offset             '+ 1
            Dim bArray() As Byte
            ReDim bArray(Len(StringChange(i).sString))
            For g = 0 To Len(StringChange(i).sString)
                bArray(g) = Asc(Mid(StringChange(i).sString, 1 + g, 1))
            Next g
            Put fFile, , bArray
            'Put fFile, , StringChange(I).sString
        Next
    End If
    If UBound(ByteChange) > 0 Then
        For i = 1 To UBound(ByteChange)
            Seek fFile, ByteChange(i).offset
            Put fFile, , ByteChange(i).bByte
        Next
    End If

    If UBound(BooleanChange) > 0 Then
        For i = 1 To UBound(BooleanChange)
            Seek fFile, BooleanChange(i).offset
            If BooleanChange(i).bBool = True Then
                NewByte = 255
                Put fFile, , NewByte
            Else
                NewByte = 0
                Put fFile, , NewByte
            End If
            'Put fFile, , ByteChange(i).bByte
        Next i
    End If
    If UBound(IntegerChange) > 0 Then
        For i = 1 To UBound(IntegerChange)
            Seek fFile, IntegerChange(i).offset
            Put fFile, , IntegerChange(i).iInt
        Next
    End If
    If UBound(LongChange) > 0 Then
        For i = 1 To UBound(LongChange)
            Seek fFile, LongChange(i).offset
            Put fFile, , LongChange(i).lLong
        Next
    End If
    If UBound(SingleChange) > 0 Then
        For i = 1 To UBound(SingleChange)
            Seek fFile, SingleChange(i).offset
            Put fFile, , SingleChange(i).sSingle
        Next
    End If

    Close fFile

    'Save the file
    FileCopy App.path & "\dump\" & SFile & "\" & SFile, Cd1.Filename
    'Kill the temp file
    Kill App.path & "\dump\" & SFile & "\" & SFile

    'Write Patch Report

    fFile = FreeFile

    Open App.path & "\dump\" & SFile & "\PatchReport.txt" For Output As fFile
    Print #fFile, "File Patch Report from Semi VB Decompiler by vbgamer45"
    Print #fFile, "------------------------------------------------------"
    Print #fFile, "Filename=" & SFile
    Print #fFile, ""
    Print #fFile, "Byte Changes"
    For i = 0 To UBound(ByteChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & ByteChange(i).offset & " Changed to: " & ByteChange(i).bByte
        End If
    Next i
    Print #fFile, ""
    Print #fFile, "Boolean Changes"
    For i = 0 To UBound(BooleanChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & BooleanChange(i).offset & " Changed to: " & BooleanChange(i).bBool
        End If
    Next i
    Print #fFile, ""
    Print #fFile, "Integer Changes"
    For i = 0 To UBound(IntegerChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & IntegerChange(i).offset & " Changed to: " & IntegerChange(i).iInt
        End If
    Next i
    Print #fFile, ""
    Print #fFile, "Long Changes"
    For i = 0 To UBound(LongChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & LongChange(i).offset & " Changed to: " & LongChange(i).lLong
        End If
    Next i
    Print #fFile, ""
    Print #fFile, "Single Changes"
    For i = 0 To UBound(SingleChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & SingleChange(i).offset & " Changed to: " & SingleChange(i).sSingle
        End If
    Next i
    Print #fFile, ""
    Print #fFile, "String Changes"
    For i = 0 To UBound(StringChange)
        If i <> 0 Then
            Print #fFile, "Offset:" & StringChange(i).offset & " Changed to: " & StringChange(i).sString
        End If
    Next i

    Close fFile

    MsgBox "Done"
End Sub

Private Sub mnuHelpAbout_Click()
    '*****************************
    'Purpose: Show my Cool about screen.
    '*****************************
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuOptions_Click()
    '*****************************
    'Purpose: Show the options form
    '*****************************
    frmOptions.Show vbModal, Me

End Sub
Private Sub mnuToolsPCodeProcedure_Click()
    '*****************************
    'Purpose: Show the Procedure Decompile View
    '*****************************
    If SFilePath = "" Then
        MsgBox "No File Loaded"
        Exit Sub
    End If
    If modGlobals.gProjectInfo.aNativeCode = 0 Then
        frmPcode.Show vbModal, Me
    Else
        MsgBox "This is a Native compiled exe! Not a P-Code one!", vbExclamation
    End If
End Sub

Private Sub tvProject_NodeClick(ByVal Node As MSComctlLib.Node)
    '*****************************
    'Purpose: To show the contents of each struture and textbox data
    '*****************************
    On Error Resume Next
    Dim ParentObject As Node
    Dim LenTab As Long
    Dim i As Long, o As Long
    Dim strCode As String

    Dim tblPath() As String
    txtCode.SelStart = 0
    txtCode.SelColor = vbBlack

    If CurrentItem <> tvProject.SelectedItem.Key Then
        tblPath = Split(tvProject.SelectedItem.Key, "/")
        CurrentItem = tvProject.SelectedItem.Key

        Select Case tblPath(1)
            Case "VERSIONINFO"
                sstViewFile.TabVisible(1) = True
                sstViewFile.TabVisible(0) = False
                sstViewFile.TabVisible(2) = False
                sstViewFile.TabVisible(3) = False
                fxgEXEInfo.Visible = True
                fxgEXEInfo.ColAlignment(1) = 0
                fxgEXEInfo.Clear
                fxgEXEInfo.Rows = 2
                fxgEXEInfo.ColWidth(0) = 2500
                fxgEXEInfo.TextArray(0) = "Name"
                fxgEXEInfo.TextArray(1) = "Value"
                fxgEXEInfo.ColWidth(0) = 2000
                fxgEXEInfo.ColWidth(1) = 2500
                fxgEXEInfo.TextArray(2) = "CompanyName"
                fxgEXEInfo.TextArray(3) = gFileInfo.CompanyName
                fxgEXEInfo.AddItem "FileDescription"
                fxgEXEInfo.TextArray(5) = gFileInfo.FileDescription
                fxgEXEInfo.AddItem "FileVersion"
                fxgEXEInfo.TextArray(7) = gFileInfo.FileVersion
                fxgEXEInfo.AddItem "InternalName"
                fxgEXEInfo.TextArray(9) = gFileInfo.InternalName
                fxgEXEInfo.AddItem "LanguageID"
                fxgEXEInfo.TextArray(11) = gFileInfo.LanguageID
                fxgEXEInfo.AddItem "LegalCopyright"
                fxgEXEInfo.TextArray(13) = gFileInfo.LegalCopyright
                fxgEXEInfo.AddItem "OrigionalFileName"
                fxgEXEInfo.TextArray(15) = gFileInfo.OrigionalFileName
                fxgEXEInfo.AddItem "ProductName"
                fxgEXEInfo.TextArray(17) = gFileInfo.ProductName
                fxgEXEInfo.AddItem "ProductVersion"
                fxgEXEInfo.TextArray(19) = gFileInfo.ProductVersion
            Case "STRUCT"
                sstViewFile.TabVisible(1) = True
                sstViewFile.TabVisible(0) = False
                sstViewFile.TabVisible(2) = False
                sstViewFile.TabVisible(3) = False
                fxgEXEInfo.Visible = True
                fxgEXEInfo.ColAlignment(1) = 0
                fxgEXEInfo.Clear
                fxgEXEInfo.Rows = 2
                fxgEXEInfo.ColWidth(0) = 2500
                fxgEXEInfo.TextArray(0) = "Name"
                fxgEXEInfo.TextArray(1) = "Value"
                Select Case tblPath(2)
                    Case "", "VBHEADER"
                        fxgEXEInfo.ColWidth(0) = 2500
                        fxgEXEInfo.TextArray(2) = "Signature"
                        fxgEXEInfo.TextArray(3) = gVBHeader.Signature
                        fxgEXEInfo.AddItem "Address SubMain"
                        fxgEXEInfo.TextArray(5) = gVBHeader.aSubMain
                        fxgEXEInfo.AddItem "Address ExternalComponentTable"
                        fxgEXEInfo.TextArray(7) = gVBHeader.aExternalComponentTable