pefileclass.pas

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

    I: Integer;
  begin
    // Loop all the classes.
    for I := 0 to Classes.Count -1 do
    begin
      // Find the unit in which the class exists, and add the class to it and
      // set the class unit to the unit.
      Classes[I].AUnit := Units.FindInUnitUsingFInit(PChar(Classes[I].AClass));
    end;

    // Loop all the TypeInfos
    for I := 0 to TypeInfos.Count -1 do
    begin
      // Find the unit in which the class exists, and add the typeinfo to it and
      // set the typinfo unit to the unit.
      TypeInfos[I].AUnit := Units.FindInUnitUsingFInit(PChar(TypeInfos[I].TypeInfo));
    end;
  end;

  procedure LoadSystemImportedProcNames;
  var
    I: Integer;
    Str: string;
  begin
    // Don't do this if the system proc is imported.
    if UsePackages then
      Exit;
    with Units.SystemUnit.DecompItems do
      for I := 0 to Count -1 do
      if (TDecompItem(Items[I]) is TProc) and TProc(Items[I]).ImportInfo.Imported then
      begin
        // Found an imported proc. If it ends with a A give it the name without the A.
        Str := TProc(Items[I]).ImportInfo.Entry.Name;
        if Str[Length(Str)] = 'A' then
          SetLength(Str, Length(Str) -1);
        TProc(Items[I]).Name := Str;
      end;
    with Units.SysInitUnit.DecompItems do
      for I := 0 to Count -1 do
      if (TDecompItem(Items[I]) is TProc) and TProc(Items[I]).ImportInfo.Imported then
      begin
        // Found an imported proc. If it ends with a A give it the name without the A.
        Str := TProc(Items[I]).ImportInfo.Entry.Name;
        if Str[Length(Str)] = 'A' then
          SetLength(Str, Length(Str) -1);
        TProc(Items[I]).Name := Str;
      end;
  end;

// ----------------------------------------------------------------------------

  procedure LoadSystemObjFiles;

    procedure AnaObjFile(ObjSig: array of Byte; ObjSigO, ObjSize: Integer; HCProcs: array of THCProc); overload;
    var
      AAddress: PChar;
      I: Integer;
    begin
      AAddress := Code;
      while AAddress <= Units.SystemUnit.FInit.Address - ObjSize do
      begin
        if CompareMem(@ObjSig, AAddress + ObjSigO, SizeOf(ObjSig)) then
        begin
          // Create a block for the Obj File
          with TDecompItem.Create(Miscs) do
          begin
            Comments.Add('Obj file filler');
            Address := AAddress;
            Size := ObjSize;
            AUnit := Units.SystemUnit;
            for I := Low(HCProcs) to High(HCProcs) do
              // Create the readln procedure.
              with Procs.Add(AAddress + HCProcs[I].R) do
              begin
                Comments.Add('Obj file proc');
                AppendAfter := atMayNot;
                AppendBefore := atMayNot;
                Name := HCProcs[I].N;
                PossProcTypes := [ptProcedure];
                AUnit := Units.SystemUnit;
             end;
         end;
         // exit the search
         break;
       end;
       Inc(AAddress, 4);
      end;
    end;

    procedure AnaObjFile(ObjSigA: array of Byte; ObjSigAO, ObjSize: Integer; HCProcs: array of THCProc;
      ObjSigB: array of Byte; ObjSigBO: Integer); overload;
    var
      AAddress: PChar;
      I: Integer;
    begin
      AAddress := Code;
      while AAddress <= Units.SystemUnit.FInit.Address - ObjSize do
      begin
        if CompareMem(@ObjSigA, AAddress + ObjSigAO, SizeOf(ObjSigA)) and
           CompareMem(@ObjSigB, AAddress + ObjSigBO, SizeOf(ObjSigB)) then
        begin
          // Create a block for the Obj File
          with TDecompItem.Create(Miscs) do
          begin
            Comments.Add('Obj file filler');
            Address := AAddress;
            Size := ObjSize;
            AUnit := Units.SystemUnit;
            for I := Low(HCProcs) to High(HCProcs) do
              // Create the readln procedure.
              with Procs.Add(AAddress + HCProcs[I].R) do
              begin
                Comments.Add('Obj file proc');
                AppendAfter := atMayNot;
                AppendBefore := atMayNot;
                Name := HCProcs[I].N;
                PossProcTypes := [ptProcedure];
                AUnit := Units.SystemUnit;
             end;
         end;
         // exit the search
         break;
       end;
       Inc(AAddress, 4);
      end;
    end;

    procedure AnaConst(ConstSig: array of Byte; ConstName: string);
    var
      AAddress: PChar;
    begin
      AAddress := Code;
      while AAddress <= Units.SystemUnit.FInit.Address - SizeOf(ConstSig)do
      begin
        if CompareMem(@ConstSig, AAddress, SizeOf(ConstSig)) then
        begin
          // Create a block for the const File
          with TStringInfo.Create(StringInfos, AAddress, stPAnsiChar) do
          begin
            Name := ConstName;
            Size := SizeOf(ConstSig);
            AUnit := Units.SystemUnit;
          end;
          // exit the search
          break;
        end;
        Inc(AAddress, 4);
      end;
    end;

    procedure AnaHCBlock(HCBlock: PHCBlock);
    var
      AAddress: PChar;

      function IsBlock: Boolean;
      var
        I: Integer;
        PR: TPRoc;
      begin
        Result := False;
        // Compare the Val blocks
        for I := 0 to HCBlock^.ValC -1 do
        begin
          if not CompareMem(AAddress + PValArray(HCBlock^.Val)^[I].RA,
            PValArray(HCBlock^.Val)^[I].Val, PValArray(HCBlock^.Val)^[I].Count) then exit;
        end;
        // Compare the Internal RA.
        for I := 0 to HCBlock^.IAC -1 do
          if PPChar(AAddress + TIAArray(HCBlock^.IA^)[I].RA)^ <> AAddress + TIAArray(HCBlock^.IA^)[I].RRA then
            exit;
        // Compare the procs.
        for I := 0 to HCBlock^.PRC -1 do
        begin
          PR := FindDecompItemByRef(AAddress + TPRArray(HCBlock^.PR^)[I].RA + 4 + PInteger(AAddress + TPRArray(HCBlock^.PR^)[I].RA)^) as TPRoc;
          if (PR = nil) or (PR.Name <> TPRArray(HCBlock^.PR^)[I].PN) then exit;
          if (TPRArray(HCBlock^.PR^)[I].CN = '') and (PR.AClass <> nil) then exit;
          if (TPRArray(HCBlock^.PR^)[I].CN <> '') and
             ((PR.AClass = nil) or (PR.AClass.AClass.ClassName <> TPRArray(HCBlock^.PR^)[I].CN)) then exit;
        end;
        // If there was no exit the this is the block.
        Result := True;
      end;

    var
      I: Integer;
      AProc: TProc;
      DC: TDecompItem;
    begin
      // Search the address at which the block starts.
      AAddress := Code;
      DC := FindDecompItemByBlock(AAddress);
      while DC <> nil do
      begin
        AAddress := Align4(DC.Address + DC.Size);
        DC := FindDecompItemByBlock(AAddress);
      end;
      while IsBlock = False do
      begin
        Inc(AAddress, 4);
        DC := FindDecompItemByBlock(AAddress);
        while DC <> nil do
        begin
          AAddress := Align4(DC.Address + DC.Size);
          DC := FindDecompItemByBlock(AAddress);
        end;
        // The block must be before the sysinit finalization section.
        if AAddress + HCBlock.Size > Units.SysInitUnit.FInit.Address then
          exit;
      end;
      {$IFOPT D+}
        SendDebug(Format('Found proc %s, %p', [TRAArray(HCBlock^.RA^)[0].PN, Pointer(AAddress)]));
      {$ENDIF}
      // Create a memory filler.
      with TDecompItem.Create(miscs) do
      begin
        Comments.Add('HC proc filler');
        Address := AAddress;
        Size := HCBlock^.Size;
      end;
      // Create the procs.
      for I := 0 to HCBlock^.RAC -1 do
        with TRAArray(HCBlock^.RA^)[I] do
        begin
          AProc := Procs.Add(AAddress + RA);
          with AProc do
          begin
            Comments.Add('system proc');
            AppendAfter := atMayNot;
            AppendBefore := atMayNot;
            Name := PN;
            Size := 0;
            if (PT = ptProcedure) and (CN <> '') then
              PossProcTypes := [ptMethodProcedure]
            else
              PossProcTypes := [PT];
            AUnit := Units.FindInUnitUsingFInit(AAddress);
            if CN <> '' then
              AClass := Classes.FindClassByName(CN);
            if PV <> nil then
              PV^ := AProc;
          end;
        end;
      // Create the vars.
      for I := 0 to HCBlock^.VarsC -1 do
        with TVarArray(HCBlock^.Vars^)[I] do
          VarInfos.loadVar(PPChar(AAddress + RA)^ - VRA, VN, Units.SystemUnit);
    end;

    procedure AnaSysUtilsHCBlock(HCBlock: PHCBlock);
    var
      AAddress: PChar;

      function IsBlock: Boolean;
      var
        I: Integer;
        PR: TPRoc;
      begin
        Result := False;
        // Compare the Val blocks
        for I := 0 to HCBlock^.ValC -1 do
          if not CompareMem(AAddress + TValArray(HCBlock^.Val^)[I].RA,
            TValArray(HCBlock^.Val^)[I].Val, TValArray(HCBlock^.Val^)[I].Count) then exit;
        // Compare the Internal RA.
        for I := 0 to HCBlock^.IAC -1 do
          if PPChar(AAddress + TIAArray(HCBlock^.IA^)[I].RA)^ <> AAddress + TIAArray(HCBlock^.IA^)[I].RRA then
            exit;
        // Compare the procs.
        for I := 0 to HCBlock^.PRC -1 do
        begin
          PR := FindDecompItemByRef(AAddress + TPRArray(HCBlock^.PR^)[I].RA + 4 + PInteger(AAddress + TPRArray(HCBlock^.PR^)[I].RA)^) as TPRoc;
          if (PR = nil) or (PR.Name <> TPRArray(HCBlock^.PR^)[I].PN) then exit;
          if (TPRArray(HCBlock^.PR^)[I].CN = '') and (PR.AClass <> nil) then exit;
          if (TPRArray(HCBlock^.PR^)[I].CN <> '') and
             ((PR.AClass = nil) or (PR.AClass.AClass.ClassName <> TPRArray(HCBlock^.PR^)[I].CN)) then exit;
        end;
        // If there was no exit the this is the block.
        Result := True;
      end;

    var
      I: Integer;
      AProc: TProc;
    begin
      // Search the address at which the block starts.
      AAddress := Units.SysInitUnit.FInit.Address;
      while IsBlock = False do
      begin
        Inc(AAddress, 4);
        // The block must be before the sysinit finalization section.
        if AAddress + HCBlock.Size > Units[Units.Count -1].FInit.Address then
          exit;
      end;
      {$IFOPT D+}
        SendDebug(Format('Found proc %s, %p', [TRAArray(HCBlock^.RA^)[0].PN, Pointer(AAddress)]));
      {$ENDIF}
      HasFFMTObj := True;
      // Create a memory filler.
      with TDecompItem.Create(miscs) do
      begin
        Comments.Add('System log, HCBlock filler');
        Address := AAddress;
        Size := HCBlock^.Size;
      end;
      // Create the procs.
      for I := 0 to HCBlock^.RAC -1 do
        with TRAArray(HCBlock^.RA^)[I] do
        begin
          AProc := Procs.Add(AAddress + RA);
          with AProc do
          begin
            Comments.Add('System proc');
            AppendAfter := atMayNot;
            AppendBefore := atMayNot;
            Name := PN;
            Size := 0;
            PossProcTypes := [ptProcedure];
            AUnit := Units.FindInUnitUsingFInit(AAddress);
            InstrSrc.Text := Source;
            TUnit(AUnit).Name := 'Sysutils';
            if PV <> nil then
              PV^ := AProc;
          end;
        end;
      // Create the vars.
      for I := 0 to HCBlock^.VarsC -1 do
        with TVarArray(HCBlock^.Vars^)[I] do
          VarInfos.loadVar(PPChar(AAddress + RA)^ - VRA, VN, Units.FindInUnitUsingFInit(AAddress));
      // Change the Fixups address to prevent a empty req add error.
      AAddress[$73E] := Chr($18);
    end;

  var
    I: Integer;
  begin
    if Units.SystemUnit <> nil then
    begin
      // Increment the size of the initialization proc
      Units.SystemUnit.Init.Size := Units.SystemUnit.Init.Size + 4;

      // Load the var Output (can only happen in the system finalization proc.
      VarInfos.loadVar(PPChar(Units.SystemUnit.FInit.Address + $24)^, 'Output', Units.SystemUnit);
    end;

    for I := 0 to High(HCBlocks) do