Attribute VB_Name = "modPCode4"
'源碼收集：www.codefans.net
'#############Begin Information#############
'Informative:
'Takes no bytes tells how to process data
'>'      put the following hex in subsegments up to next
'         offset following ArgStr char should be "p" for
'         Procedure Address
'h'      return hex output of following typechars. possible(?%,&);
'}'      End Procedure

'Arguments
'Will usually take bytes from the datastream

'.'      name Of Object at the Address specified by a Long off the datastream
'b'      a byte off the datastream - formerly '?
'%'      an integer off the datastream
'&'      a long off the datastream
'!'      a single off the datastream
'a'      an argument reference. Followed by an Int and a type char.  Takes variable out of the ConstantPool
'c'      return the control index,uses one int from the datastream
'l'      return Local variable reference(uses int off datastream)
'L'      take (Value of Int off DataStream) local variable references
'm'      return Local Variable reference followed by typechar
'n'      return hex Integer
'o'      return item off the stack(Pop)
'p'      return (value of Integer  off datastream) + Procedure Base Address
't'      followed by typechar('o' return ObjectName;'c' return control name)
'u'      push...not used anymore
'v'      vTable this is slightly complicated ;)
'z'      return Null-Termed Unicode String From File(not used?)


'Type Characters
' b     Byte
' ?     Boolean
' %     Integer
' !     Single
' &    Long
' ~     Variant
' z     String


'Pcode Opcode Meanings
'Imp=import
'Ad = Address
'St/Ld=Store/Load
'I2 = Integer
'Lit=Literal(ie "Hi",2,8 )
'Cy=Currency
'R4=
'R8=Single
'Str=String
'DOC=Duplicate/Redundante Opcode(in the table it will redirect you to another opcode)
'#############End Information#############
Option Explicit

Private Type OpcodeType
    Mnemonic    As String
    Size        As Long
    flag        As Byte
End Type

Private Type PeType
    PE_ID As Long
    CPU_Type As Integer
    NumObjects As Integer
    TimeDateStamp As Long
    pCOFFTable As Long
    COFFTableSize As Long
    NTHeaderSize As Integer
    Flags As Integer
    Magic As Integer
    Linker As Integer
    SizeOfCode As Long
    SizeOfInitData As Long
    SizeOfUnInitData As Long
    EntryPointRVA As Long
    BaseOfCode As Long
    BaseOfData As Long
    ImageBase As Long
    ObjectAlign As Long
    FileAlign As Long
    OSMajor As Integer
    OSMinor As Integer
    USERMajor As Integer
    USERMinor As Integer
    SubSysMajor As Integer
    SubSysMinor As Integer
    Reserved1 As Long
    ImageSize As Long
    HeaderSize As Long
    FileCheckSum As Long
    SubSytem As Integer
    DLLFlags As Integer
    StackReserveSize As Long
    StackCommitSize As Long
    HeapReserveSize As Long
    HeapComitSize As Long
    LoaderFlags As Long
    NumOfRVAandSizes As Long
    ExportTableRVA As Long
    ExportDataSize As Long
    ImportTableRVA As Long
    ImportDataSize As Long
    ResourceTableRVA As Long
    ResourceDataSize As Long
    ExceptionTableRVA As Long
    ExceptionDataSize As Long
    SecurityTableRVA As Long
    SecurityDataSize As Long
    FixTableRVA As Long
    FixDataSize As Long
    DebugTableRVA As Long
    DebugDataSize As Long
    ImageDescriptionRVA As Long
    DescriptionDataSize As Long
    MachineSpecificRVA As Long
    MachnineDataSize As Long
    TLSRVA As Long
    TLSDataSize As Long
    LoadConfigRVA As Long
    LoadConfigDataSize As Long
    Reserved2(39) As Byte
End Type

Private Type ObjEntry
    ObjectName(7) As Byte
    VirtualSize   As Long
    SectionRVA   As Long
    PhysicalSize   As Long
    PhysicalOffset   As Long
    Reserved(11)   As Byte
    ObjectFlags   As Long
End Type

Private Type ImportTable
    LookUpRVA  As Long
    TimeDateStamp  As Long
    Chains  As Long
    NameRVA  As Long
    AddressTableRVA  As Long
End Type

Private Type RecordTableInfo
    Data00  As Long
    Vftable As Long
    Layout  As Long
    data0C  As Long
    data10  As Long
    Data14  As Long
    Info(15)  As Byte
    flag    As Integer
    Len     As Integer
    len2    As Integer
    Len3    As Integer
    RecAddr As Long
    unk(2) As Long
    NameTab As Long
End Type

Private Type RecordType
    TabAddr As Long
    Data04  As Long
    Import  As Long
    data0C  As Long
    data10  As Long
    Data14  As Long
    ModName As Long
    Owner   As Long
    Names   As Long
    data20  As Long
    data24  As Long
    data2C  As Long
End Type

Private Type ProcDscInfo 'CodeInfo
    table           As Long
    field_4         As Integer
    FrameSize       As Integer                             '24
    ProcSize        As Integer                             '22
    field_A         As Integer                             '20
    field_C         As Integer                             '18
    field_E         As Integer                             '16
    field_10        As Integer                             '14
    field_12        As Integer                             '12
    field_14        As Integer                             '10
    field_16        As Integer                             '8
    field_18        As Integer                             '6
    field_1A        As Integer                             '4
    flag            As Integer                             '2
End Type

Private Type TableInfo 'ObjectInfo
    data0       As Long
    Record      As Long                                    '4
    data8       As Long
    data0C      As Long
    data10      As Long
    Owner       As Long                                    '14
    rtl         As Long                                    '18
    data1C      As Long
    data20      As Long
    data24      As Long
    JmpCnt      As Integer                                 '28
    data2A      As Integer
    data2C      As Long
    data30      As Long
    ConstPool   As Long
End Type

Global Const unkno = 0
Global Const std = 1
Global Const idx = 2

Global Const none = 99
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal length As Long)

Private Base&, Start&, PESize&, Table1&, Table2&, Table3&, RecTable&
Private pePcodeHeader As PeType
Private ObjTable(10) As ObjEntry
Private ImpTab(50) As ImportTable
Private Record(256) As RecordType
Private RecordNames(256) As String
Private RecordTable As RecordTableInfo
Private Opcode(5, 255) As OpcodeType
Private File() As Byte
Private Map() As Byte
Public SubName() As String
Private RefName() As String
Private ProcList() As Long
Private ProcCnt As Long
Global EventProcList() As Long

'Holds SubNames from OpenVBExe
Private Type subNameListType
    strName As String
    offset As Long
End Type
Global SubNamelist() As subNameListType

Sub Decode(Filename As String)
    '*****************************
    'Purpose: To decode a P-Code excutable and return all procedures in P-Code tokens
    '*****************************
    Dim f$, c&, a&
    Dim i As Integer
    ReDim ProcList(0)
    ProcCnt = 0

    f$ = Filename
    LoadPE f$
    LoadPcode


    Dim ProcAddr() As Long
    Dim g As Integer
    'Get all procedures
    Open SFilePath For Binary Access Read As #24
    For i = 0 To UBound(gObjectInfoHolder)
        If gObjectInfoHolder(i).NumberOfProcs > 0 Then
            ReDim ProcAddr(gObjectInfoHolder(i).NumberOfProcs - 1)
            Seek #24, gObjectInfoHolder(i).aProcTable + 1 - OptHeader.ImageBase
            Get #24, , ProcAddr
            For g = 0 To UBound(ProcAddr)
                If ProcAddr(g) <> 0 And ProcAddr(g) <> -1 Then
                    If ProcAddr(g) < UBound(SubName) And ProcAddr(g) > LBound(SubName) Then
                        SubName(ProcAddr(g)) = gObjectNameArray(i) & ".Proc" & ProcAddr(g)
                        AddProc ProcAddr(g)
                    End If
                End If
            Next
        End If
    Next
    Dim addrSubMain As Long
    If gVBHeader.aSubMain <> 0 Then
        Seek #24, gVBHeader.aSubMain + 2 - OptHeader.ImageBase
        Get #24, , addrSubMain
        Dim sTemp
        sTemp = Split(SubName(addrSubMain), ".")
        SubName(addrSubMain) = sTemp(0) & ".Sub Main"
    End If
    Close #24
    'Add Event ProcLists

    For i = 0 To UBound(EventProcList) - 1
        If EventProcList(i) <> 0 Then
            AddProc EventProcList(i)
            'MsgBox "Added" & EventProcList(i)
        End If
    Next
    'For i = 1 To UBound(exeIMPORT_APINAME)
    'On Error Resume Next
    'SubName(exeIMPORT_APINAME(i).Address) = exeIMPORT_APINAME(i).ApiName
    ' Next
    For i = 0 To UBound(SubNamelist) - 1
        If SubNamelist(i).offset < UBound(SubName) Then
            SubName(SubNamelist(i).offset) = SubNamelist(i).strName
        End If
        '  MsgBox "SubName:" & SubNamelist(i).Offset
    Next

    Open App.path & "\dump\" & SFile & "\PcodeOut.txt" For Output As #2
    Print #2, "Semi VB Decompiler vbgamer45"
    Print #2, "P-Code Output for : " & Filename
    Print #2, "---------------------------------"
    Do
        c = 0
        For a = 0 To ProcCnt - 1
            If ProcList(a) <> 0 Then
                Print #2, DecompileProc(ProcList(a))
                'call modPcodeToVB.RecoverCode(ProcList(a))

                ProcList(a) = 0
                c = 1
            End If
        Next
    Loop While c
    Close #2
End Sub


Sub LoadPE(f$)
    '*****************************
    'Purpose: To get the PE data of the filename
    '*****************************
    Dim a&, l&, b&, t() As Byte
    Dim addrtab&, libname$, fname$, i&, tmp$, func&
    Open f$ For Binary As #1
    Get #1, 185, pePcodeHeader
    For a = 0 To pePcodeHeader.NumObjects - 1
        Get #1, 185 + 248 + a * 40, ObjTable(a)
        l = ObjTable(a).VirtualSize + ObjTable(a).SectionRVA
        If PESize < l Then PESize = l
        l = ObjTable(a).PhysicalSize + ObjTable(a).SectionRVA
        If PESize < l Then PESize = l
    Next