unit Procs;

interface

uses
  PEFile, Classes, TypInfo,
  {$IFOPT D+} dcDebug, dialogs, {$ENDIF}
  dcDecomps, dcFields, MethodLists, dcParams, peExports;

type
  { TMiscs }

  TMiscs = class(TDecompCollection)
  private
    function GetItem(Index: Integer): TDecompItem;
    procedure SetItem(Index: Integer; Value: TDecompItem);
  public
    property Items[Index: Integer]: TDecompItem read GetItem write SetItem; default;
  end;

  { TGUIDConst }

  TGUIDConst = class(TDecompItem)
  public
    function IsRefAddress(AAddress: PChar): Boolean; override;
  end;
  
  { TTypeInfoInfo }

  TTypeInfoInfo = class(TDecompItem)
  private
    FTypeInfo: PTypeInfo;
    FName: string;
    function GetTypeDef: string;
    function GetTypeInfoVarName: string;
    function GetName: string;
  public
    function IsRefAddress(AAddress: PChar): Boolean; override;
    function HasTypeDef: Boolean;
    procedure LoadMethodRefs;

    property TypeInfo: PTypeInfo read FTypeInfo;
    property TypeDef: string read GetTypeDef;
    property TypeInfoVarName: string read GetTypeInfoVarName;
    property Name: string read GetName;
  end;

  { TTypeInfoInfos }

  TTypeInfoInfos = class(TDecompCollection)
  private
    function GetItem(Index: Integer): TTypeInfoInfo;
    procedure SetItem(Index: Integer; Value: TTypeInfoInfo);
  public
    procedure LoadTypeInfos;
    function FindTypeInfo(TypeInfo: PTypeInfo): TTypeInfoInfo;
    function IndexOfName(Name: string): Integer;
    property Items[Index: Integer]: TTypeInfoInfo read GetItem write SetItem; default;
  end;

  { TInterface }

  TInterface = class(TCollectionItem)
  private
    FGuid: TGUID;
    FMethodCount: Integer;
  public
    property GUID: TGUID read FGUID;
    property MethodCount: Integer read FMethodCount;
  end;

  { TInterfaces }

  TInterfaces = class(TCollection)
  private
    function GetItem(Index: Integer): TInterface;
    procedure SetItem(Index: Integer; Value: TInterface);
  public
    function Add(GUID: TGUID; MethodCount: Integer): TInterface;
    function FindInterface(GUID: TGUID): TInterface;
    property Items[Index: Integer]: TInterface read GetItem write SetItem; default;
  end;

const
  AppendBeforeIndex = 0;
  AppendAfterIndex = 1;

type
  TClassInfo = class;
  TClassInfos = class;
  TProcs = class;

  { TProc }

  TMethodBindingType = (mbtVirtual, mbtDynamic, mbtStatic);
  TProcType = (ptProcedure, ptClassProcedure, ptMethodProcedure, ptConstructor,
     ptDestructor, ptInitialization, ptFinalization, ptEntryPointProc);
  TProcTypes = set of TProcType;

  TProc = class;

  TImportInfo = record
    Imported: Boolean;
    DLLName: string;
    Entry: TPEImport;
    ImportedProc: TProc;
  end;

  TAppendType = (atMay, atMayNot, atMust);

  TProc = class(TDecompItem)
  private
    FOnSizeChange: TmlneMethodList;
    FOnInitSizeChange: TmlneMethodList;
    FInitSize: Integer;
    FBeforeInitSize: Integer;
    FFinaSize: Integer;
    FAfterFinaSize: Integer;
    FName: string;
    FImportInfo: TImportInfo;
    FPossProcTypes: TProcTypes;
    FMethodBindingType: TMethodBindingType;
    FPublished: Boolean;
    FMethodIndex: Integer;
    FClass: TClassInfo;
    FInstrSrc: TStrings;
    FOverrides: Boolean;
    FForwardDecl: Boolean;
    FParameters: TdcParameters;
    FProcEnh: TObject;
    FProcSize: Integer;
    FAppend: array[AppendBeforeIndex..AppendAfterIndex] of TAppendType;
    procedure SetPossProcTypes(Value: TProcTypes);
    function GetProcType: TProcType;
    procedure SetMethodBindingType(Value: TMethodBindingType);
    procedure SetClass(Value: TClassInfo);
    function GetDefSrc: string;
    function GetAncestorMethod: TProc;
    function GetIncName: string;
    procedure SetInitSize(Value: Integer);
    procedure ProcSizeChange(Sender: TmlneMethodList);
    procedure SetName(Value: string);
    function GetName: string;
    function GetPossProcTypes: TProcTypes;
    procedure SetOverrides(Value: Boolean);
    function GetAppend(Index: Integer): TAppendType;
    procedure SetAppend(Index: Integer; Value: TAppendType);
  protected
    procedure PossSetToIntf(DecompItem: TDecompItem); override;
    procedure SetSize(Value: Integer); override;
  public
    constructor Create(Procs: TProcs; Address: PChar); reintroduce; overload;
    destructor Destroy; override;
    procedure GenerateInstr;
    function IsRefAddress(AAddress: PChar): Boolean; override;
    procedure Append(Proc: TProc);
    procedure AddReqBy(Decomp: TDecompItem; AAddress: PChar); override;

    // InitSize is the size of the initilization code automaticly generated.
    property InitSize: Integer read FInitSize write SetInitSize;
    // Beofer init size is the size of the code before the auto generated code
    property BeforeInitSize: Integer read FBeforeInitSize write FBeforeInitSize;
    // FinaSize if the size of the finalization code automaticly generated.
    property FinaSize: Integer read FFinaSize write FFinaSize;
    // After init size is the size of the code after the auto generated code, to the end
    // of the proc indicated by procsize (not Size).
    property AfterFinaSize: Integer read FAfterFinaSize write FAfterFinaSize;

    property Name: string read GetName write SetName;
    // Inc name is the name including the object name (and Unit).
    property IncName: string read GetIncName;
    property ImportInfo: TImportInfo read FImportInfo write FImportInfo;
    property ProcType: TProcType read GetProcType;
    property PossProcTypes: TProcTypes read GetPossProcTypes write SetPossProcTypes;   // All posible proc types are set.
    property MethodBindingType: TMethodBindingType read FMethodBindingType write SetMethodBindingType;
    property APublished: Boolean read FPublished write FPublished;
    property MethodIndex: Integer read FMethodIndex write FMethodIndex; // VMT or Dynamic index
    property AClass: TClassInfo read FClass write SetClass;
    property Overrides: Boolean read FOverrides write SetOverrides;
    property InstrSrc: TStrings read FInstrSrc;
    property DefSrc: string read GetDefSrc;
    property ForwardDecl: Boolean read FForwardDecl write FForwardDecl;
    property AncestorMethod: TProc read GetAncestorMethod;
    property ProcSize: Integer read FProcSize write FProcSize;
    property Parameters: TdcParameters read FParameters;

    property AppendBefore: TAppendType index AppendBeforeIndex read GetAppend write SetAppend;
    property AppendAfter: TAppendType index AppendAfterIndex read GetAppend write SetAppend;
    property OnSizeChange: TmlneMethodList read FOnSizeChange;
    property OnInitSizeChange: TmlneMethodList read FOnInitSizeChange;
  end;

  { TProcEnh }

  TProcEnh = class(TObject)
  private
    FProc: TProc;
  public
    constructor CreateEnh(Proc: TProc); virtual;
    property Proc: TProc read FProc;
  end;

  { TDestructorProcEnh }

  TDestructorProcEnh = class(TProcEnh)
  private
    FHasBeforeDestruction: Boolean;
    FHasClassDestroy: Boolean;
  public
    constructor CreateEnh(Proc: TProc); override;
    destructor Destroy; override;
    procedure ProcSizeChange(Sender: TmlneMethodList);
    property HasBeforeDestruction: Boolean read FHasBeforeDestruction;
    property HasClassDestroy: Boolean read FHasClassDestroy;
  end;

  { TInitProcEnh }

  TInitProcEnh = class(TProcEnh)
  private
    FHasInitResStringImport: Boolean;
    FHasInitImport: Boolean;
  public
    constructor CreateEnh(Proc: TProc); override;
    destructor Destroy; override;
    procedure ProcInitSizeChange(Sender: TmlneMethodList);
    property HasInitResStringImport: Boolean read FHasInitResStringImport;
    property HasInitImport: Boolean read FHasInitImport;
  end;

  { TInitProc }

  TInitProc = class(TProc)
  public
    constructor CreateInit(Procs: TProcs; Address: PChar);
    constructor CreateFInit(Procs: TProcs; Address: PChar);
  end;

  { TProcs }

  TProcs = class(TDecompCollection)
  private
    FOnLoadPublishedMethods: TmlneMethodList;
    FPublishedMethodsLoaded: Boolean;
    function GetItem(Index: Integer): TProc;
    procedure SetItem(Index: Integer; Value: TProc);
  public
    constructor CreateDecomp(PEFileClass: TPEFile); override;
    destructor Destroy; override;
    procedure LoadPublishedMethods;
    procedure LoadExportedProcs;
    function AnalyzeProc(Proc: TProc): Boolean;
    procedure GenerateInstrs;
    function Add(Address: PChar): TProc;
    function FindProc(Address: PChar): TProc;
    function FindProcByName(const Name: string): Integer;
    function FindProcIndex(Address: PChar; var Index: Integer): Boolean;

    property Items[Index: Integer]: TProc read GetItem write SetItem; default;
    property OnLoadPublishedMethods: TmlneMethodList read FOnLoadPublishedMethods;
    property PublishedMethodsLoaded: Boolean read FPublishedMethodsLoaded;
  end;

  { TClassInfo }

  TClassInfo = class(TDecompItem)
  private
    FClass: TClass;
    FMethods: TList;
    FInterfaces: TList;
    FClassDef: TStrings;
    FFields: TdcFieldList;
    FAncestorClass: TClassInfo;
    FForwardDecl: Boolean;
    function GetMethod(Index: Integer): TProc;
    function GetMethodCount: Integer;
    function GetInterfaceCount: Integer;
    function GetInterface(Index: Integer): TInterface;
  public
    constructor Create(ClassInfos: TClassInfos; AClass: TClass); reintroduce; overload;
    destructor Destroy; override;
    procedure GenerateClassDef;
    procedure AnaClass;
    function IsRefAddress(AAddress: PChar): Boolean; override;
    function GetVirtualMethod(Index: Integer): TProc;
    function GetDynamicMethod(Index: Integer): TProc;
    function FindProc(const ProcName: string): TProc;

    property AClass: TClass read FClass write FClass;
    property MethodCount: Integer read GetMethodCount;
    property Methods[Index: Integer]: TProc read GetMethod;
    property Fields: TdcFieldList read FFields;
    property InterfaceCount: Integer read GetInterfaceCount;
    property Interfaces[Index: Integer]: TInterface read GetInterface;
    property ClassDef: TStrings read FClassDef write FClassDef;
    property AncestorClass: TClassInfo read FAncestorClass;
    property ForwardDecl: Boolean read FForwardDecl write FForwardDecl;
  end;

  { TClassInfos }

  TClassInfos = class(TDecompCollection)
  private
    FOnLoadClasses: TmlneMethodList;
    function GetItem(Index: Integer): TClassInfo;
    procedure SetItem(Index: Integer; Value: TClassInfo);
  public
    constructor CreateDecomp(PEFileClass: TPEFile); override;
    destructor Destroy; override;
    procedure LoadClassInfos;
    procedure GenerateClassDefs;
    function Add(AClass: TClass): TClassInfo;
    function FindClass(AClass: TClass): TClassInfo;
    function FindClassByName(const Name: string): TClassInfo;

    property Items[Index: Integer]: TClassInfo read GetItem write SetItem; default;
    property OnLoadClasses: TmlneMethodList read FOnLoadClasses;
  end;

  { TStringInfo }

  TStringInfos = class;

  TStringType = (stAnsiString, stWideString, stResourceString, stPAnsiChar,
       stPWideChar);

  TStringInfo = class(TDecompItem)
  private
    FValue: string;
    FStringAddress: PChar;
    FStringType: TStringType;
    FName: string;
    function GetStringTypeName: string;
  public
    constructor Create(StringInfos: TStringInfos; Address: PChar;
       StringType: TStringType; ASize: Integer = 0); reintroduce; overload;
    function IsRefAddress(AAddress: PChar): Boolean; override;

    property Value: string read FValue;
    property StringAddress: PChar read FStringAddress;
    property StringType: TStringType read FStringType;
    property StringTypeName: string read GetStringTypeName;
    property Name: string read FName write FName;
  end;

  { TStringInfos }

  TStringInfos = class(TDecompCollection)
  private
    function GetItem(Index: Integer): TStringInfo;
    procedure SetItem(Index: Integer; Value: TStringInfo);
  public
    procedure LoadStringInfos;
    function FindString(Address: PChar): TStringInfo;
    property Items[Index: Integer]: TStringInfo read GetItem write SetItem; default;
  end;

const
  ptMethods: TProcTypes = [ptClassProcedure .. ptDestructor];
  ptAll: TProcTypes = [Low(TProcType) .. High(TProcType)];
  ptAllStatic: TProcTypes = [ptProcedure .. ptDestructor];

// Returns true if the decomp item is a decomp item.
function IsTypeDecomp(Decomp: TDecompItem): Boolean;

// Functions for aligning Address and size to 4 bytes.
function Align4(Address: PChar): PChar; overload;
function Align4(Value: Integer): Integer; overload;

implementation

uses
  ObjFileConsts, SysUtils, ProcDecomp, DisAsm, VMTUtils, PEFileClass, Windows,
  Vars, dcUnits, dcInstr, TypeInfoUtils, dcNTInfoTypes, dcTypeIntf,
  NameMangling;

type
  PDWord = ^DWord;

{ TMiscs }

function TMiscs.GetItem(Index: Integer): TDecompItem;
begin
  Result := TDecompItem(inherited GetItem(Index));
end;

procedure TMiscs.SetItem(Index: Integer; Value: TDecompItem);