frmmain.frm

VB的反编译分析代码,很强的功能,能分析VB生成的EXE、DLL文件的结构

    AppData.FormTableAddress = gVBHeader.aGUITable
    'GetHelpFile
    Seek #f, StartOffset + 1 + gVBHeader.oHelpFile         'Loc(f) + gVBHeader.oHelpFile + 1

    HelpFile = GetUntilNull(f)

    'Get Project Name
    Seek #f, StartOffset + 1 + gVBHeader.oProjectName
    ProjectName = GetUntilNull(f)
    'Project Title
    Seek #f, StartOffset + 1 + gVBHeader.oProjectTitle
    ProjectTitle = GetUntilNull(f)
    'ExeName
    Seek #f, StartOffset + 1 + gVBHeader.oProjectExename
    ProjectExename = GetUntilNull(f)
    'Get ComRegisterData
    Seek #f, gVBHeader.aComRegisterData + 1 - OptHeader.ImageBase
    Get #f, , gCOMRegData
    Get #f, , gCOMRegInfo

    'Get ProjectDescription
    Seek #f, gVBHeader.aComRegisterData + 1 + gCOMRegData.oNTSProjectDescription - OptHeader.ImageBase
    ProjectDescription = GetUntilNull(f)


    'Get External Componetns
    '##########
    If gVBHeader.ExternalComponentCount > 0 Then
        Seek f, gVBHeader.aExternalComponentTable + 1 - OptHeader.ImageBase
        'MsgBox gVBHeader.aExternalComponentTable + 1 - OptHeader.ImageBase
        ReDim gOcxList(0)
        Dim AexternEnd As Long
        Dim bExternEnd As Long
        For i = 1 To gVBHeader.ExternalComponentCount
            bExternEnd = Loc(f)
            Dim cOcx As tComponent
            Get f, , cOcx
            AexternEnd = bExternEnd + 1 + cOcx.StructLength
            If cOcx.GUIDlength = 72 Then
                Seek f, bExternEnd + 1 + cOcx.GUIDoffset
                gOcxList(UBound(gOcxList)).strGuid = UCase(GetUnicodeString(f, 36))
            End If
            Seek f, bExternEnd + 1 + cOcx.FileNameOffset
            gOcxList(UBound(gOcxList)).strocxName = GetUntilNull(f)
            Seek f, bExternEnd + 1 + cOcx.SourceOffset
            gOcxList(UBound(gOcxList)).strLibName = GetUntilNull(f)
            Seek f, bExternEnd + 1 + cOcx.NameOffset
            gOcxList(UBound(gOcxList)).strName = GetUntilNull(f)
            ReDim Preserve gOcxList(UBound(gOcxList) + 1)
            Seek f, AexternEnd
        Next
    End If

    'Get Project Info Table
    Seek f, gVBHeader.aProjectInfo + 1 - OptHeader.ImageBase
    Get #f, , gProjectInfo

    'Begin Main Loop to get api list
    Dim nApi As Integer
    ReDim gApiList(0)
    For nApi = 0 To gProjectInfo.ExternalCount - 1
        'Get External Table 'Number of Api Calls
        Seek f, gProjectInfo.aExternalTable + 1 + (nApi * 8) - OptHeader.ImageBase
        Get #f, , gExternalTable

        'Get External Library
        If gProjectInfo.ExternalCount > 0 And gExternalTable.flag <> 6 Then
            Seek f, gExternalTable.aExternalLibrary + 1 - OptHeader.ImageBase
            Get #f, , gExternalLibrary

            If gExternalLibrary.aLibraryFunction <> 0 Then
                Seek f, gExternalLibrary.aLibraryFunction + 1 - OptHeader.ImageBase
                gApiList(UBound(gApiList)).strFunctionName = GetUntilNull(f)
                Seek f, gExternalLibrary.aLibraryName + 1 - OptHeader.ImageBase
                gApiList(UBound(gApiList)).strLibraryName = GetUntilNull(f)
                ReDim Preserve gApiList(UBound(gApiList) + 1)
            End If
        End If

    Next nApi                                              'End Api List Loop

    'Get Object Table
    Seek f, gProjectInfo.aObjectTable + 1 - OptHeader.ImageBase
    Get #f, , gObjectTable

    'Resize for the number of objects...(forms,modules,classes)
    ReDim gObject(gObjectTable.ObjectCount1 - 1)
    ReDim gObjectNameArray(gObjectTable.ObjectCount1 - 1)
    ReDim gObjectProcCountArray(gObjectTable.ObjectCount1 - 1)
    ReDim gObjectInfoHolder(gObjectTable.ObjectCount1 - 1)
    'Get Object
    Seek f, gObjectTable.aObject + 1 - OptHeader.ImageBase
    Get #f, , gObject


    Dim loopC As Integer
    For loopC = 0 To UBound(gObject)
        'Get ObjectName
        Seek f, gObject(loopC).aObjectName + 1 - OptHeader.ImageBase
        gObjectNameArray(loopC) = GetUntilNull(f)
        gObjectProcCountArray(loopC) = gObject(loopC).ProcCount

        'Get Object Info
        Seek f, gObject(loopC).aObjectInfo + 1 - OptHeader.ImageBase
        Get #f, , gObjectInfo
        'Save the information for later on
        gObjectInfoHolder(loopC).aConstantPool = gObjectInfo.aConstantPool
        gObjectInfoHolder(loopC).aObject = gObjectInfo.aObject
        gObjectInfoHolder(loopC).aObjectTable = gObjectInfo.aObjectTable
        gObjectInfoHolder(loopC).aProcTable = gObjectInfo.aProcTable
        gObjectInfoHolder(loopC).aSmallRecord = gObjectInfo.aSmallRecord
        gObjectInfoHolder(loopC).Const1 = gObjectInfo.Const1
        gObjectInfoHolder(loopC).Flag1 = gObjectInfo.Flag1
        gObjectInfoHolder(loopC).iConstantsCount = gObjectInfo.iConstantsCount
        gObjectInfoHolder(loopC).iMaxConstants = gObjectInfo.iMaxConstants
        gObjectInfoHolder(loopC).Flag5 = gObjectInfo.Flag5
        gObjectInfoHolder(loopC).Flag6 = gObjectInfo.Flag6
        gObjectInfoHolder(loopC).Flag7 = gObjectInfo.Flag7
        gObjectInfoHolder(loopC).Null1 = gObjectInfo.Null1
        gObjectInfoHolder(loopC).Null2 = gObjectInfo.Null2
        gObjectInfoHolder(loopC).NumberOfProcs = gObjectInfo.NumberOfProcs
        gObjectInfoHolder(loopC).ObjectIndex = gObjectInfo.ObjectIndex
        gObjectInfoHolder(loopC).RunTimeLoaded = gObjectInfo.RunTimeLoaded

        'If gObjectInfo.aProcTable - OptHeader.ImageBase > 0 Then
        'Dim ProcCodeInfo As tCodeInfo
        'Seek f, gObjectInfo.aProcTable + 1 - OptHeader.ImageBase
        'Get f, , ProcCodeInfo
        'End If
        'If gObjectInfo.aConstantPool <> 0 Then
        'Seek f, gObjectInfo.aConstantPool + 1 - OptHeader.ImageBase
        ' End If

        'Get Optional Object Info
        Seek f, gObject(loopC).aObjectInfo + 57 - OptHeader.ImageBase

        'Decide if to get Optional Info or not
        If ((gObject(loopC).ObjectType And &H80) = &H80) Then

            Get #f, , gOptionalObjectInfo
            'Dim testLink() As tEventLink
            Dim LinkPCode() As MethodLinkPCode
            Dim LinkNative() As MethodLinkNative

            'Resize the Arrays
            ReDim LinkPCode(gOptionalObjectInfo.iEventCount - 1)
            ReDim LinkNative(gOptionalObjectInfo.iEventCount - 1)

            'MsgBox gOptionalObjectInfo.iEventCount
            If gOptionalObjectInfo.aEventLinkArray <> 0 And gOptionalObjectInfo.aEventLinkArray <> -1 Then
                If gOptionalObjectInfo.aEventLinkArray + 1 - OptHeader.ImageBase > 0 Then
                    Seek f, gOptionalObjectInfo.aEventLinkArray + 1 - OptHeader.ImageBase
                    If gProjectInfo.aNativeCode = 0 Then
                        'P-Code
                        Get f, , LinkPCode
                    Else
                        'Native
                        Get f, , LinkNative
                    End If


                    'For i = 0 To UBound(LinkPCode)
                    ' MsgBox LinkPCode(i).movAddress '+ 1 - OptHeader.ImageBase
                    'Next
                End If
            End If
        End If
        'Address PublicBytes
        'Notes aPublicBytes points to a structure of 2 integers (iStringBytes and iVarBytes) and this structure tells how many pointers will be in memory at aModulePublic.
        If gObject(loopC).aPublicBytes <> 0 Then
            Seek #f, gObject(loopC).aPublicBytes + 1 - OptHeader.ImageBase
            Dim iStringBytes As Integer, iVarBytes As Integer
            Get f, , iStringBytes
            Get f, , iVarBytes
            'MsgBox "StringBytes: " & iStringBytes & " VarBytes: " & iVarBytes
            If gObject(loopC).aModulePublic <> 0 Then
                Seek #f, gObject(loopC).aModulePublic + 1 - OptHeader.ImageBase
                '  MsgBox gObject(loopC).aModulePublic + 1 - OptHeader.ImageBase
            End If
        End If

        'Resize the control array
        'Check if its a form
        If gObject(loopC).ObjectType = 98435 And gOptionalObjectInfo.ControlCount < 5000 And gOptionalObjectInfo.ControlCount <> 0 Then
            ReDim gControl(gOptionalObjectInfo.ControlCount - 1)
            'Get Control Array
            Seek f, gOptionalObjectInfo.aControlArray + 1 - OptHeader.ImageBase
            Get #f, , gControl
            'Resize Event Table array
            ReDim gEventTable(UBound(gControl))

            Dim ControlName As String

            For i = 0 To UBound(gControl)
                'Get Event Table
                Seek f, gControl(i).aEventTable + 1 - OptHeader.ImageBase
                ' ReDim gEventTable(i).aEventPointer(gControl(i).EventCount - 1)
                ReDim taEventPointer(gControl(i).EventCount - 1)
                'MsgBox gOptionalObjectInfo.iEventCount & " " & gControl(i).EventCount
                Get #f, , gEventTable(i)
                Get #f, , taEventPointer

                If gControl(i).aName + 1 - OptHeader.ImageBase > 0 Then
                    Seek f, gControl(i).aName + 1 - OptHeader.ImageBase
                    ControlName = GetUntilNull(f)
                    Dim strGuid As String
                    Seek f, gControl(i).aGUID + 1 - OptHeader.ImageBase
                    strGuid = modGlobals.ReturnGuid(f)

                    For k = 0 To UBound(taEventPointer)
                        If taEventPointer(k) <> 0 Then
                            '  MsgBox "Good:" & ControlName & " " & taEventPointer(k) + 1 - OptHeader.ImageBase & " #" & k
                            'MsgBox "Offset: " & taEventPointer(k) + 1 - OptHeader.ImageBase
                            Dim pointerAevent As tEventPointer
                            Seek f, taEventPointer(k) + 1 - OptHeader.ImageBase
                            Get f, , pointerAevent
                            If pointerAevent.aEvent <> 0 Then
                                ' MsgBox getEventComplete(App.path & "\VB6.OLB", strGuid, Int(k) + 1)
                                SubNamelist(UBound(SubNamelist)).strName = gObjectNameArray(loopC) & "." & ControlName & "_Event"
                                SubNamelist(UBound(SubNamelist)).offset = pointerAevent.aEvent
                                ReDim Preserve SubNamelist(UBound(SubNamelist) + 1)
                                EventProcList(UBound(EventProcList)) = pointerAevent.aEvent    'taEventPointer(k)
                                ReDim Preserve EventProcList(UBound(EventProcList) + 1)
                            End If
                        End If

                    Next


                    'Save the control information for the treeview
                    ReDim Preserve gControlNameArray(UBound(gControlNameArray) + 1)
                    gControlNameArray(UBound(gControlNameArray)).strControlName = ControlName
                    gControlNameArray(UBound(gControlNameArray)).strParentForm = gObjectNameArray(loopC)
                    gControlNameArray(UBound(gControlNameArray)).strGuid = strGuid
                End If
            Next

        End If

        If gObject(loopC).ProcCount <> 0 Then

            If gObject(loopC).aProcNamesArray <> 0 Then
                Dim AddressProcNamesArray() As Long
                ReDim AddressProcNamesArray(gObject(loopC).ProcCount - 1)


                Seek f, gObject(loopC).aProcNamesArray + 1 - OptHeader.ImageBase
                Get f, , AddressProcNamesArray

                For addr = 0 To UBound(AddressProcNamesArray)

                    If AddressProcNamesArray(addr) = 0 Then

                    Else
                        If (AddressProcNamesArray(addr) - OptHeader.ImageBase) < 0 Then

                        Else
                            Seek f, AddressProcNamesArray(addr) + 1 - OptHeader.ImageBase


                            gProcedureList(UBound(gProcedureList)).strProcedureName = GetUntilNull(f)
                            gProcedureList(UBound(gProcedureList)).strParent = gObjectNameArray(loopC)
                            SubNamelist(UBound(SubNamelist)).strName = gProcedureList(UBound(gProcedureList)).strProcedureName
                            SubNamelist(UBound(SubNamelist)).offset = AddressProcNamesArray(addr)
                            ReDim Preserve SubNamelist(UBound(SubNamelist) + 1)

                            ReDim Preserve gProcedureList(UBound(gProcedureList) + 1)
                        End If
                    End If
                Next

            End If


        End If
    Next loopC

    'Main Loop to Get all Form's Properties
    FrameStatus.Visible = True
    txtStatus.Text = ""
    Call ProccessControls(f)

    Close f


    'Set the compile type either pcode or ncode
    If gProjectInfo.aNativeCode <> 0 Then
        AppData.CompileType = "Native"
        'Begin Native Decompile
        Call modNative.Decode(SFilePath)
    Else
        AppData.CompileType = "PCode"
        'Begin Pcode Decompile
        txtStatus.Text = txtStatus.Text & "Begin PCode Decompile" & vbCrLf
        Call modPCode4.Init
        txtStatus.Text = txtStatus.Text & "End PCode Decompile" & vbCrLf
        'Decompile the file
        If gPcodeDecompile = True Then
            Call modPCode4.Decode(SFilePath)
        End If
    End If



    mnuFileGenerate.Enabled = True
    mnuFileExportMemoryMap.Enabled = True
    ' mnuFileAntiDecompiler.Enabled = True
    'Get FileVersion Info
    gFileInfo = modGlobals.FileInfo(SFilePath)

    'Hide Form Generation Status
    FrameStatus.Visible = False

    Call SetupTreeView
    Call modOutput.DumpVBExeInfo(App.path & "\dump\" & FileTitle & "\FileReport.txt", FileTitle)

    'Add to recent files
    Call AddToRecentList(SFilePath, SFile)

    'Clear current data
    DDirPath = ""
    DFile = ""

    Exit Sub

AnalyzeError:

    MsgBox "Analyze error", vbCritical Or vbOKOnly, "Source file error"

End Sub
Sub AddToRecentList(Filename As String, FileTitle As String)
    '*****************************
    'Purpose: Add a Filename to the recently access list via the registry
    '*****************************
    Dim Recent1File As String
    Dim Recent1Title As String
    Dim Recent2File As String
    Dim Recent2Title As String
    Dim Recent3File As String
    Dim Recent3Title As String

    mnuFileSep1.Visible = True
    mnuFileRecent1.Visible = True

    Recent1Title = GetSetting("VB Decompiler", "Options", "Recent1FileTitle", "")