dcdecompthread.pas

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

unit dcDecompThread;

interface

uses
  Classes, StatusForm, PEFile;

type
  TdcDecompThread = class(TThread)
  private
    FFileName: string;
    FDir: string;
    FStatusText: string;
    FStatus: TdcStatus;
    FPEFileClasses: array of TPEFile;
    procedure SyncSetStatus;
    function GetPEFileClass(Index: Integer): TPEFile;
    function GetPEFileClassCount: Integer;
  public
    {$IFDEF DebugView}
    constructor CreateDecomp(const FileName: string);
    {$ELSE}
    constructor CreateDecomp(const FileName, Dir: string);
    {$ENDIF DebugView}
    procedure SaveFiles;
    procedure SetStatus(Status: TdcStatus; const StatusText: string);
    procedure CheckTerminated;
    procedure AddPEFileClass(PEFileClass: TPEFile);
    procedure Execute; override;
    destructor Destroy; override;

    property Dir: string read FDir write FDir;
    property FileName: string read FFileName;
    property PEFileClasses[Index: Integer]: TPEFile read GetPEFileClass;
    property PEFileClassCount: Integer read GetPEFileClassCount;
  end;

implementation

uses
  dcUnits, Windows, SysUtils, dcDFMs, PEFileClass;

type
  ETerminated = class(Exception);

{ TdcDecompThread }

{$IFDEF DebugView}
constructor TdcDecompThread.CreateDecomp(const FileName: string);
{$ELSE}
constructor TdcDecompThread.CreateDecomp(const FileName, Dir: string);
{$ENDIF}
begin
  FFileName := FileName;
  {$IFNDEF DebugView}
  FDir := Dir;
  {$ENDIF}
  inherited Create(False);
end;

destructor TdcDecompThread.Destroy;
var
  I: Integer;
begin
  for I := 0 to PEFileClassCount -1 do
    PEFileClasses[I].Free;
  inherited Destroy;
end;

procedure TdcDecompThread.SaveFiles;
var
  I, J, K, L: Integer;
  Str: string;
begin
  for L := 0 to PEFileClassCount -1 do
    with TPEFileClass(PEFileClasses[L]) do
    begin
      for I := 0 to Units.Count -1 do
      begin
        if Units[I].ImportedUnit then Continue;
        // Insert a Enter if a line is more than 1000 characters
        Str := Units[I].UnitSrc.Text;
        J := 1;
        K := 1;
        while J < Length(Str) -1 do
        begin
          if (Str[J] = #13) and (Str[J+1] = #10) then
            K := J;
          if J - K > 1000 then
          begin
            for J := J downto K do
            begin
              if Str[J] = ' ' then
              begin
                Insert(#13#10, Str, J + 1);
                K := J + 1;
                Break;
              end;
              if J = K then
              begin
                Insert(#13#10, Str, K + 500);
                K := K + 500;
              end;
            end;
            J := K;
          end;
          Inc(J);
        end;
        Units[I].UnitSrc.Text := Str;

        // Create the untis.
        case Units[I].UnitType of
          utNormal: Units[I].UnitSrc.SaveToFile(Dir + '\' + Units[I].Name + '.pas');
          utProgram: Units[I].UnitSrc.SaveToFile(Dir + '\' + Units[I].Name + '.dpr');
        end;
      end;

      // Create the FFMT.OBJ file
      if HasFFMTObj then
        with TResourceStream.Create(HInstance, 'FfmtObjFile', RT_RCDATA) do
        try
          SaveToFile(Dir + '\FFMT.OBJ');
        finally
          Free;
        end;

      // Save the DFMs.
      for I := 0 to DFMs.Count -1 do
        with TdcDFM(DFMs.Items[I]) do
          if FormClass <> nil then
            SaveToFile(Dir + '\' + TUnit(FormClass.AUnit).Name + '.DFM')
          else
            SaveToFile(Dir + '\' + Resources[ResTypeIndex].Entries[ResIndex].Name + '.DFM');
    end;
end;

procedure TdcDecompThread.CheckTerminated;
begin
  if Terminated then
    raise ETerminated.Create('Cancelled');
end;

procedure TdcDecompThread.AddPEFileClass(PEFileClass: TPEFile);
begin
  SetLength(FPEFileClasses, Length(FPEFileClasses) +1);
  FPEFileClasses[High(FPEFileClasses)] := PEFileClass;
end;

procedure TdcDecompThread.Execute;
begin
  try
    SetStatus(sCanCancel, 'Decompiling the program.');
    TPEFileClass.CreateDecomp(FileName, Self);
    CheckTerminated;
    {$IFNDEF DebugView}
    SetStatus(sCanNotCancel, 'Saving the files.');
    SaveFiles;
    {$ENDIF DebugView}
    SetStatus(sFinished, 'Decompiling complete.');
  except
    on ETerminated do
      SetStatus(sCanceled, 'Cancelled.');
    on E: Exception do
      SetStatus(sError, Format('Error: %s, %s', [E.ClassName, E.Message]));
  end;
end;

procedure TdcDecompThread.SetStatus(Status: TdcStatus; const StatusText: string);
begin
  FStatus := Status;
  FStatusText := StatusText;
  Synchronize(SyncSetStatus);
end;

procedure TdcDecompThread.SyncSetStatus;
begin
  if StatusFrm <> nil then
  begin
    StatusFrm.StatusText := FStatusText;
    StatusFrm.Status := FStatus;
  end;
end;

function TdcDecompThread.GetPEFileClass(Index: Integer): TPEFile;
begin
  Result := FPEFileClasses[Index];
end;

function TdcDecompThread.GetPEFileClassCount: Integer;
begin
  Result := Length(FPEFileClasses);
end;

end.