dcdecomps.pas

SrcDecompiler is about creating a Delphi program decompiler. The program is written for Delphi 4 or

unit dcDecomps;

interface

uses
  {$IFOPT D+}
    dcDebug, dialogs,
  {$ENDIF}
  Classes, PEFile;

type
  TDecompCollection = class;

  { TDecompItem }

  TIntfImpl = (iiInterface, iiImplementation);

  TReqDecompType = (rdtReq, rdtReqBy, rdtReqAddress);

  TDecompItem = class(TCollectionItem)
  private
    FAddress: PChar;
    FRefAddress: PChar;
    FSize: Integer;
    FAUnit: TCollectionItem;
    FReqDecomps: array[TReqDecompType] of TList;
    FIntfImpl: TIntfImpl;
    FComments: TStrings;
    FPEFileClass: TPEFile;
    procedure SetAUnit(Value: TCollectionItem);
    procedure SetIntfImpl(Value: TIntfImpl);
    function GetReqDecompCount(PropIndex: TReqDecompType): Integer;
    function GetReqDecomp(Index: Integer; PropIndex: TReqDecompType): TDecompItem;
    procedure SetAddress(Value: PChar);
  protected
    procedure SetSize(Value: Integer); virtual;
    // PossSetToIntf is called when the decomp is in the interface section and a
    // req decomp is in the implemenation section (only once), by default
    // the decomp item is moved to the implementation section.
    procedure PossSetToIntf(DecompItem: TDecompItem); virtual;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure AddReq(Decomp: TDecompItem; AAddress: PChar); virtual;
    procedure AddReqBy(Decomp: TDecompItem; AAddress: PChar); virtual;
    // Returns the name of the item at address PChar, returns an empty string
    // if it isn't a ref address. This method will be override by descend classes.
    function IsRefAddress(AAddress: PChar): Boolean; virtual;

    property Address: PChar read FAddress write SetAddress;
    property RefAddress: PChar read FRefAddress write FRefAddress;
    property Size: Integer read FSize write SetSize;
    property AUnit: TCollectionItem read FAUnit write SetAUnit;
    // List of decomp items which are required by this decomp item.
    property ReqDecompCount: Integer Index rdtReq read GetReqDecompCount;
    property ReqDecomps[Index: Integer]: TDecompItem Index rdtReq read GetReqDecomp;
    property ReqDecompsAddress[Index: Integer]: TDecompItem Index rdtReqAddress read GetReqDecomp;
    // List of decomp items which require this decomp item.
    property ReqByDecompCount: Integer Index rdtReqBy read GetReqDecompCount;
    property ReqByDecomps[Index: Integer]: TDecompItem Index rdtReqBy read GetReqDecomp;

    property Comments: TStrings read FComments;
    property IntfImpl: TIntfImpl read FIntfImpl write SetIntfImpl;
    property PEFileClass: TPEFile read FPEFileClass;
  end;

  { TDecompCollection }

  TDecompCollection = class(TCollection)
  private
    FPEFileClass: TPEFile;
  public
    constructor CreateDecomp(PEFileClass: TPEFile); virtual;
    property PEFileClass: TPEFile read FPEFileClass;
  end;

  { TDecompList }

  TDecompList = class(TList)
  private
    FSorted: Boolean;
    function GetItem(Index: Integer): TDecompItem;
  public
    procedure MustBeSorted;
    function FindByBlock(Address: PChar): Integer;
    function FindByRef(Address: PChar): Integer;

    property Items[Index: Integer]: TDecompItem read GetItem; default;
  end;

implementation

uses
  SysUtils, PEFileClass, dcUnits;

{ TDecompItem }

constructor TDecompItem.Create(Collection: TCollection);
var
  I: TReqDecompType;
begin
  inherited Create(Collection);
  if not (Collection is TDecompCollection) then
    raise EDecompilerError.Create('Collection is not a decomp collection');
  FPEFileClass := TDecompCollection(Collection).PEFileClass;
  // Add yourself to the decomp list.
  TPEFileClass(PEFileClass).Decomps.Add(Self);
  // The list is now not sorted anymore
  TPEFileClass(PEFileClass).Decomps.FSorted := False;
  for I := Low(TReqDecompType) to High(TReqDecompType) do
    FReqDecomps[I] := TList.Create;
  FIntfImpl := iiImplementation;
  FComments := TStringList.Create;
end;

destructor TDecompItem.Destroy;
var
  I: Integer;
  J: Integer;
  Req: TReqDecompType;
begin
  // Remove the req items.
  for I := 0 to ReqDecompCount -1 do
    ReqDecomps[I].FReqDecomps[rdtReqBy].Remove(Self);
  for I := 0 to ReqByDecompCount -1 do
  begin
    J := ReqByDecomps[I].FReqDecomps[rdtReq].IndexOf(Self);
    Assert(J <> -1, 'Decomp ByDecomps not in sync');
    ReqByDecomps[I].FReqDecomps[rdtReq].Delete(J);
    ReqByDecomps[I].FReqDecomps[rdtReqAddress].Delete(J);
  end;
  for Req := Low(TReqDecompType) to High(TReqDecompType) do
    FReqDecomps[Req].Free;
  // Remove the item from the unit.
  if FAUnit <> nil then
    (FAUnit as TUnit).DecompItems.Delete((FAUnit as TUnit).DecompItems.IndexOf(Self));
  // remove yourself from the decomp list.
  with TPEFileClass(TDecompCollection(Collection).PEFileClass).Decomps do
    Remove(Self);
  // Free private objects.
  FComments.Free;
  inherited Destroy;
end;

procedure TDecompItem.SetAUnit(Value: TCollectionItem);
begin
  if Value <> FAUnit then
  begin
    if (FAUnit <> nil) then
      raise EDecompilerError.Create('Item already has a unit');
    Assert(Value is TUnit, 'Unit not an unit');
    FAUnit := Value;
    (FAUnit as TUnit).DecompItems.Add(Self);
  end;
end;

procedure TDecompItem.SetSize(Value: Integer);
begin
  FSize := Value;
end;

procedure TDecompItem.SetIntfImpl(Value: TIntfImpl);
var
  I: Integer;
begin
  // Do nothing if the new value is the same as the old.
  if Value = FIntfImpl then Exit;
  // A item can not be set back the the implementation part.
  if Value = iiImplementation then
    raise EDecompilerError.Create('Value set back the implementation');
  // A decomp item in the program unit can't be set to interface.
  if (AUnit <> nil) and (TUnit(AUnit).UnitType = utProgram) then
    raise EDecompilerError.Create('Set the interface with the unit type');
  // Set the var
  FIntfImpl := Value;
  // if a req item is in the implementation section possibly set it to the
  // interface section.
  for I := 0 to ReqDecompCount -1 do
    if ReqDecomps[I].IntfImpl = iiImplementation then
      PossSetToIntf(ReqDecomps[I]);
end;

procedure TDecompItem.PossSetToIntf(DecompItem: TDecompItem);
begin
  DecompItem.IntfImpl := iiInterface;
end;

function TDecompItem.GetReqDecompCount(PropIndex: TReqDecompType): Integer;
begin
  Result := FReqDecomps[PropIndex].Count;
end;

function TDecompItem.GetReqDecomp(Index: Integer; PropIndex: TReqDecompType): TDecompItem;
begin
  Result := FReqDecomps[PropIndex].Items[Index];
end;

procedure TDecompItem.SetAddress(Value: PChar);
begin
  if Value <> FAddress then
  begin
    FAddress := Value;
    TPEFileClass(PEFileClass).Decomps.FSorted := False;
  end;
end;

procedure TDecompItem.AddReq(Decomp: TDecompItem; AAddress: PChar);
var
  I: Integer;
begin
  if Decomp = nil then
  begin
    {$IFOPT D+}
      SendDebugEx('Empty Req added', mtError);
      exit;
    {$ELSE}
      raise EDecompilerError.Create('empty Req Added');
    {$ENDIF}
  end;
  // Do nothing if the decomp is already Req.
  for I := 0 to ReqDecompCount -1 do
    if (ReqDecomps[I] = Decomp) and
       (PChar(ReqDecompsAddress[I]) = AAddress) then
      exit;
  FReqDecomps[rdtReqAddress].Add(AAddress);
  FReqDecomps[rdtReq].Add(Decomp);
  Decomp.FReqDecomps[rdtReqBy].Add(Self);
  // If this Decomp is in the interface section and the added in the implementation
  // it must possibly Move to the interface section
  if (IntfImpl = iiInterface) and (Decomp.IntfImpl = iiImplementation) then
    PossSetToIntf(Decomp);
  Decomp.AddReqBy(Self, AAddress);
end;

procedure TDecompItem.AddReqBy(Decomp: TDecompItem; AAddress: PChar);
begin
end;

function TDecompItem.IsRefAddress(AAddress: PChar): Boolean;
begin
  Result := AAddress = RefAddress;
end;

{ TDecompCollection }

constructor TDecompCollection.CreateDecomp(PEFileClass: TPEFile);
begin
  inherited Create(TDecompItem);
  if not (PEFileClass is TPEFileClass) then
    raise EDecompilerError.Create('PEFileClass is not TPEFileClass');
  FPEFileClass := PEFileClass;
end;

{ TDecompList }

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

function DecompItemSort(Item1, Item2: Pointer): Integer;
begin
  Result := TDecompItem(Item1).Address - TDecompItem(Item2).Address;
end;

procedure TDecompList.MustBeSorted;
begin
  if not FSorted then
  begin
    Sort(DecompItemSort);
    FSorted := True;
  end;
end;

function TDecompList.FindByBlock(Address: PChar): Integer;
var
  L, H, I, C: Integer;
begin
  MustBeSorted;
  Result := -1;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Items[I].Address - Address;
    if C <= 0 then
      L := I + 1
    else
      H := I - 1;
  end;

  for I := H downto 0 do
    if (Address >= Items[I].Address) and
       (Address < Items[I].Address + Items[I].Size) then
    begin
      Result := I;
      Exit;
    end;
end;

function TDecompList.FindByRef(Address: PChar): Integer;
var
  I, L, C, H: Integer;
begin
  MustBeSorted;
  Result := -1;
  L := 0;
  H := Count - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := Items[I].Address - Address;
    if C <= 0 then
      L := I + 1
    else
      H := I - 1;
  end;

  for I := H downto 0 do
  begin
    if (Address = Items[I].RefAddress) or Items[I].IsRefAddress(Address) then
    begin
      Result := I;
      Exit;
    end;
  end;
end;

end.