dcunits.pas

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

      end;
      UnitSrc.Add(EndUnit);
    end
    else
    begin
      if TPEFileClass(PEFileClass).ProjectType = ptPackage then
        // Add "end." if this is an package
        UnitSrc.Add(EndUnit)
      else
        // Add the entrypoint proc (ignore the finalization section)
        UnitSrc.Add(TPEFileClass(TProcs(Collection).PEFileClass).EntryPointProc.InstrSrc.Text);
    end;
   finally
     Consts.Free;
   end;
  finally
    Vars.Free;
  end;
end;

procedure TUnit.DeterIntfImpl;
var
  I, J: Integer;
label
  Next;
begin
  for I := 0 to DecompItems.Count -1 do
  begin
    with TDecompItem(DecompItems[I]) do
    begin
      // Don't check for program source objects
      if TUnit(TDecompItem(DecompItems[I]).AUnit).UnitType = utProgram then
        goto Next;  
      // Add a var to the interface section to maintain the order of the vars.
      if (TDecompItem(DecompItems[I]) is TVar) and (Size <> 0) then
        IntfImpl := iiInterface;
      // If it already is in the interface section leave it there.
      if IntfImpl = iiInterface then
        goto Next;
      // If it is a Initialization or finalization proc it is in implementation.
      if (TDecompItem(DecompItems[I]) is TProc) and
         (TProc(DecompItems[I]).ProcType in [ptInitialization, ptFinalization]) then
        goto Next;
      // If this item is required by an item in another unit it must be in the interface section.
      for J := 0 to ReqByDecompCount -1 do
        if (TDecompItem(ReqByDecomps[J]).AUnit <> Self) and
           (TDecompItem(ReqByDecomps[J]).AUnit <> nil) then
        begin
          IntfImpl := iiInterface;
          goto Next;
        end;
      Next:
    end;
  end;
end;

{ TUnits }

constructor TUnits.Create(PEFileClass: TPEFile);
begin
  inherited Create(TUnit);
  FPEFileClass := PEFileClass as TPEFileClass;
  FOnAssignUnits := TmlneMethodList.Create;
end;

destructor TUnits.Destroy;
begin
  FOnAssignUnits.Free;
  inherited Destroy;
end;

function TUnits.FindInUnitUsingFInit(Address: PChar): TUnit;
var
  J: Integer;
begin
  // The unit in which Address is, is the unit which Finalization address is
  // the closest after the address.
  Result := nil;
  for J := 0 to Count -1 do
    if (Items[J].FInit.Address >= Address) and
       ((Result = nil) or (Result.FInit.Address > Items[J].FInit.Address)) then
      Result := Items[J];
  // The addres must be inside an Unit.
  if Result = nil then
    raise EDecompilerError.CreateFmt('Address not in an unit %p', [Pointer(Address)]);
end;

function TUnits.FindInUnit(Address: PChar): TUnit;
var
  J: Integer;
begin
  for J := 0 to Count -1 do
  begin
    Result := Items[J];
    if (Result.Address <= Address) and (Result.Address + Result.Size > Address) then
      exit;
  end;
  // The addres must be inside an Unit.
  raise EDecompilerError.CreateFmt('Address not in an unit %p,', [Pointer(Address)]);
end;

function TUnits.FindByName(const Name: string): Integer;
begin
  for Result := 0 to Count -1 do
    if AnsiCompareText(Items[Result].Name, Name) = 0 then
      Exit;
  Result := -1;
end;

procedure TUnits.GenerateReqUnits;
var
  I, J, K: Integer;

  procedure SortInitList;

    procedure CorrectI(StartI, EndI: Integer; Intf: Boolean; AUnit: TUnit);

      procedure AddAtIndex(Index: Integer; XAUnit: TUnit);
      begin
        if Intf then
          AUnit.InsertIntfUnit(Index, XAUnit)
        else
          AUnit.InsertImplUnit(Index, XAUnit);
      end;

    var
      StartBlock, EndBlock: Integer;
      ProjectIndex: Integer;
      X: Boolean;
      A, B: Integer;
    begin
      StartBlock := StartI;
      ProjectIndex := 0;

      while StartBlock <= EndI do
      begin
        A := StartBlock;
        EndBlock := StartBlock;
        repeat
          for B := 0 to Items[A].IntfUnitCount -1 do
            if (Items[A].IntfUnits[B].Index > EndBlock) and
               (Items[A].IntfUnits[B].Index <= EndI) then
              EndBlock := Items[A].IntfUnits[B].Index;
          for B := 0 to Items[A].ImplUnitCount -1 do
            if (Items[A].ImplUnits[B].Index > EndBlock) and
               (Items[A].ImplUnits[B].Index <= EndI) then
              EndBlock := Items[A].ImplUnits[B].Index;
          Inc(A);
        until A > EndBlock;

        // If this is only one unit add it.
        if StartBlock = EndBlock then
        begin
          AddAtIndex(ProjectIndex, Items[StartBlock]);
          Inc(ProjectIndex);
        end
        else if Items[EndBlock].FIntfUnits.Count = 0 then
        begin
          // If the last units hasn't interface units, let is handle
          // it in the implementation uses.
          AddAtIndex(ProjectIndex, Items[EndBlock]);
          CorrectI(StartBlock, EndBlock -1, False, Items[EndBlock]);
          Inc(ProjectIndex);
        end
        else
        begin
          // If the last unit isn't required in a in interface section of the other
          // units.
          X := True;
          for B := StartBlock to EndBlock -1 do
            X := X and (Items[B].FIntfUnits.IndexOf(Items[EndBlock]) = -1);
          if X then
          begin
            AddAtIndex(ProjectIndex, Items[EndBlock]);
            CorrectI(StartBlock, EndBlock -1, True, Items[EndBlock]);
            Inc(ProjectIndex);
          end
          else
          begin
            // If the last unit doens't require an of the other units in its
            // interface units.
            X := True;
            for B := StartBlock to EndBlock -1 do
              X := X and (Items[EndBlock].FIntfUnits.IndexOf(Items[B]) = -1);
            if X then
            begin
              AddAtIndex(ProjectIndex, Items[EndBlock]);
              CorrectI(StartBlock, EndBlock -1, False, Items[EndBlock]);
              Inc(ProjectIndex);
            end
            else
            begin
              // If the last unit isn't required by the unit before it,
              // Add the last unit and transfer the problem to the one therefor.
              if Items[EndBlock -1].FIntfUnits.IndexOf(Items[EndBlock]) = -1 then
              begin
                AddAtIndex(ProjectIndex, Items[EndBlock]);
                Inc(ProjectIndex);
                CorrectI(StartBlock, EndBlock -1, True, Items[EndBlock]);
              end;
            end;
          end;
        end;

        // Next block.
        StartBlock := EndBlock + 1;
      end;
    end;

  begin
    CorrectI(2, Count -2, False, Items[Count -1]);
  end;

begin
    for I := 2 to Count -1 do
    begin
      for J := 0 to Items[I].DecompItems.Count -1 do
      begin
        for K := 0 to TDecompItem(Items[I].DecompItems[J]).ReqDecompCount -1 do
        begin
          if TDecompItem(TDecompItem(Items[I].DecompItems[J]).ReqDecomps[K]).AUnit <> nil then
          begin
            if not (TDecompItem(TDecompItem(Items[I].DecompItems[J]).ReqDecomps[K]).AUnit is TUnit) then
              raise EDecompilerError.Create('Unit not an unit');
            if (not (TDecompItem(Items[I].DecompItems[J]) is TProc)) and
               (TDecompItem(Items[I].DecompItems[J]).IntfImpl = iiInterface) then
              Items[I].AddIntfUnit(TDecompItem(TDecompItem(Items[I].DecompItems[J]).ReqDecomps[K]).AUnit as TUnit)
            else
              Items[I].AddImplUnit(TDecompItem(TDecompItem(Items[I].DecompItems[J]).ReqDecomps[K]).AUnit as TUnit);
          end;
        end;
      end;
    end;

    SortInitList;
end;

procedure TUnits.GenerateNames;
var
  I, J: Integer;
begin
  J := 1;
  for I := 0 to Count -2 do
  begin
    if Items[I].Name = '' then
    begin
      // There is no check for a already existing UnknownX unit.
      Items[I].Name := Format('Unknown%d', [J]);
      Inc(J);
    end;
  end;
  if Items[Count -1].Name = '' then
  begin
    // There is no check for a already existing Project1 unit.
    Items[Count -1].Name := 'Project1';
  end;
end;

function TUnits.GetItem(Index: Integer): TUnit;
begin
  Result := TUnit(inherited GetItem(Index));
end;

procedure TUnits.SetItem(Index: Integer; Value: TUnit);
begin
  inherited SetItem(Index, Value);
end;

procedure TUnits.GenUnitSrcs;
var
  I: Integer;
begin
  for I := 0 to Count -1 do
    Items[I].GenUnitSrc;
end;

procedure TUnits.DeterIntfImpls;
var
  I: Integer;
begin
  for I := 0 to Count -1 do
    Items[I].DeterIntfImpl;
end;

procedure TUnits.AssignUnits;
var
  I: Integer;
begin
  with TPEFileClass(FPEFileClass) do
    for I := 0 to Decomps.Count -1 do
      if (TDecompItem(Decomps[I]).Address < Data) and
         (TDecompItem(Decomps[I]).Address <> nil) and
         (TDecompItem(Decomps[I]).AUnit = nil) then
        TDecompItem(Decomps[I]).AUnit := Units.FindInUnit(TDecompItem(Decomps[I]).Address);
  // Call the event handler
  OnAssignUnits.CallFirst;
end;

procedure TUnits.LoadInitFInit;
var
  I: Integer;
  XUnit: TUnit;
begin
  with TPEFileClass(PEFileClass) do
  begin
    // Loop though the init table.
    with TDisAsm.Create do
    try
      for I := 0 to InitTable^.UnitCount -1 do
      begin
        // Must not be an imported unit.
        XUnit := TUnit.Create(Self);
        with XUnit do
        begin
          // Set the unit type.
          if I = 0 then
          begin
            FUnitType := utSystem;
            FSysInitUnit := XUnit;
          end
          else if (I = 1) then
          begin
            FUnitType := utSystem;
            FSystemUnit := XUnit;
          end
          else if (I = InitTable^.UnitCount -1) and (ProjectType <> ptPackage) then
          begin
            FUnitType := utProgram;
            FProgramUnit := XUnit;
          end
          else
          begin
            FUnitType := utNormal;
            if FirstNormalUnit = nil then
              FFirstNormalUnit := XUnit;
          end;
          // Create the init proc.
          if Assigned(InitTable^.UnitInfo^[I].Init) then
          begin
            Init := TInitProc.CreateInit(Procs, @InitTable^.UnitInfo^[I].Init);
            Init.AUnit := XUnit;
          end;
          // Units must have a finalization section (required for unit size etc).
          if @InitTable^.UnitInfo^[I].FInit = nil then
            raise EDecompilerError.Create('Every Unit must have an Finalization section');
          // Create the FInit proc.
          FInit := TInitProc.CreateFInit(Procs, @InitTable^.UnitInfo^[I].FInit);
          FInit.AUnit := XUnit;
        end
      end;
    finally
      Free;
    end;
    if ProjectType = ptPackage then
    begin
      // Load the package unit.
      XUnit := TUnit.Create(Self);
      FProgramUnit := XUnit;
      with XUnit do
      begin
        // Set the unit type
        FUnitType := utProgram;
        // Set PackageUnload as the finalization unit.
        FInit := TProc.Create(Procs, PEExports[PEExports.FindCaseInSens('@' + ProjectName + '@@PackageUnload$qqrv')].Address);
        with FInit do
        begin
          AUnit := XUnit;
          AppendBefore := atMayNot;
        end;
        // Create the initilaization unit
        Init := TProc.Create(Procs, PEExports[PEExports.FindCaseInSens('@' + ProjectName + '@initialization$qqrv')].Address);
        with Init do
        begin
          AUnit := XUnit;
          AppendBefore := atMayNot;
          AppendAfter := atMayNot;
        end;
      end;
    end;
  end;
end;

end.