pefileclass.pas

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

  {$IFOPT D+}
    LastDC: TDecompItem;
    DbugCounter: Integer;
  {$ENDIF}
  label
  {$IFOPT D+}
    NextChecK,
  {$ENDIF}
    ReDo;

    function AnaUnknownBlock(var StartAddress: PChar; EndAddress: PChar): Boolean;
    var
      OrgEndAddress: PChar;
      FixupsTo: TList;
      FixupsInside: TList;
      P: Integer;
      Adjusted: Boolean;
      XAddress: PChar;
      PCharEndAddress: PChar;
      ProcSize: Integer;
      PossType: set of (ptPChar, ptProc, ptGUID);
      AProc: TProc;
      ALog: string;
    resourcestring
      SProcSize0Error = 'Proc with size 0 at %p';
    begin
      Result := False;
      OrgEndAddress := EndAddress;
      FixupsTo := TList.Create;
      try
        FixupsInside := TList.Create;
        try
          // Generate a list of Fixups To and inside the block,
          // order on the address which contains the fixup.
          for P := 0 to Fixups.Count -1 do
          begin
            if (Fixups[P].FixupType = 3) and
               (PPChar(Fixups[P].Address)^ >= StartAddress) and
               (PPChar(Fixups[P].Address)^ < EndAddress) then
            begin
              FixupsTo.Add(Fixups[P].Address);
            end;
            if (Fixups[P].Address >= StartAddress) and
               (Fixups[P].Address < EndAddress) then
              FixupsInside.Add(Fixups[P].Address);
          end;

          // if there is a fixupTo not to the start from outside the block, the blocks ends there.
          Adjusted := True;
          while Adjusted do
          begin
            Adjusted := False;
            for P := 0 to FixupsTo.Count -1 do
              if (PPChar(FixupsTo[P])^ <> StartAddress) and
                 ((PChar(FixupsTo[P]) < StartAddress) or
                  (PChar(FixupsTo[P]) >= EndAddress)) then
              begin
                {$IFOPT D+}
                  SendDebug(Format('EndAddress ajusted %p %p %p %p', [Pointer(StartAddress),
                    Pointer(EndAddress), PPointer(FixupsTo[P])^, FixupsTo[P]]));
                {$ENDIF}
                EndAddress := PPChar(FixupsTo[P])^;
                Adjusted := True;
                break;
              end;
            for P := FixupsTo.Count -1 downto 0 do
              if PPChar(FixupsTo[P])^ >= EndAddress then
                FixupsTo.Delete(P);
            for P := FixupsInside.Count -1 downto 0 do
              if PChar(FixupsInside[P]) >= EndAddress then
                FixupsInside.Delete(P);
          end;

          // Align4 the proc to 4 bytes.
          EndAddress := Align4(EndAddress);
          
          // Sort the lists of fiups.
          FixupsTo.Sort(ListPointerToSort);
          FixupsInside.Sort(ListSimpleSort);

          // At the moment all of the possebilities are possible except ptGUID (no Interfaces).
          PossType := [ptPChar, ptProc];

          // If there is no 0 on the last byte of a DWord before the first Fixup Inside or FixupTo then it is not a PChar.
          XAddress := EndAddress;

          for P := 0 to FixupsTo.Count -1 do
            if PPChar(FixupsTo[P])^ <> StartAddress then
            begin
              XAddress := PPChar(FixupsTo[P])^;
              break;
            end;

          if (FixupsInside.Count > 0) and (FixupsInside[0] < XAddress) then
            XAddress := FixupsInside[0];
          P := 3;
          PCharEndAddress := nil;
          PossType := PossType - [ptPChar];
          while P < XAddress - StartAddress do
          begin
            if StartAddress[P] = #0 then
            begin
              ALog := ALog + Format('PChar still possible due to a #0 at %p, ', [Pointer(StartAddress + P)]);
              PossType := PossType + [ptPChar];
              PCharEndAddress := StartAddress + P + 1;
              break;
            end;
            Inc(P, 4);
          end;

          // if there are fixups inside then it must be a proc.
          if (FixupsInside.Count <> 0) and
             ((PCharEndAddress = nil) or (PCharEndAddress > FixupsInside[0])) then
          begin
            ALog := ALog + Format('can only be proc due to a fixup inside at %p, ', [Pointer(FixupsInside[0])]);
            PCharEndAddress := nil;
            PossType := [ptProc];
          end;

          // If the block smaller than 16 untile the next fixup, it can't be a GUID
          if XAddress - StartAddress <> 16 then
            PossType := PossType - [ptGUID];

          // If the proc doesn't cotain a $C3 or $C2 instruction.
          PossType := PossType - [ptProc];
          for P := Align4(EndAddress-StartAddress) -4 to Align4(EndAddress-StartAddress)-1 do
            if StartAddress[P] = #$C3 then
            begin
              PossType := PossType + [ptProc];
              break;
            end;

          for P := Align4(EndAddress-StartAddress) -5 to Align4(EndAddress-StartAddress) -2 do
            if StartAddress[P] = #$C2 then
            begin
              PossType := PossType + [ptProc];
              break;
            end;

          // A PChar has a maximum Length of 255.
          if (EndAddress - StartAddress > 256) and
             ((PCharEndAddress <> nil) or (PCharEndAddress - StartAddress > 256)) then
          begin
            ALog := ALog + 'pchar not possible because the block is to long, ';
            PossType := PossType - [ptPChar];
            PCharEndAddress := nil;
          end;

          // The proc may not be greater then the empty block.
          if ptProc in PossType then
            ProcSize := GetProcSize(StartAddress)
          else
            ProcSize := 0;
            
          if (ptProc in PossType) and (EndAddress - StartAddress < ProcSize) then
            PossType := PossType - [ptProc];

          if PossType = [] then
          begin
            if (EndAddress - StartAddress > 4) and (StartAddress[0] = #$55) and
               (StartAddress[1] = #$8B) and (StartAddress[2] = #$EC) then
            begin
              PossType := [ptProc];
              {$IFOPT D+}
                SendDebug(Format('Nothing As proc gap %p %p', [Pointer(StartAddress), Pointer(EndAddress)]));
              {$ENDIF}
            end
            else
            begin
              // Search for the first Fixups to after then end, before the original end
              // it probably is a proc.
              XAddress := OrgEndAddress;
              for P := 0 to Fixups.Count -1 do
                if (PPChar(Fixups[P].Address)^ < XAddress) and
                   (PPChar(Fixups[P].Address)^ > StartAddress) then
                begin
                  XAddress := PPChar(Fixups[P].Address)^;
                end;
              if (XAddress < OrgEndAddress) and (Integer(XAddress) mod 4 <> 0) then
              begin
                PossType := [ptProc];
                {$IFOPT D+}
                  SendDebug(Format('Nothing As **proc gap %p %p', [Pointer(StartAddress), Pointer(EndAddress)]));
                {$ENDIF}
              end
              else
              begin
                PossType := [ptPChar];
                {$IFOPT D+}
                  SendDebug(Format('Nothing As PChar gap %p %p', [Pointer(StartAddress), Pointer(EndAddress)]));
                {$ENDIF}
              end;
            end;
          end;

          // If the difference between the pchar end address and the EndAddress of the proc, is
          // very big (say $40, if is probably a pchar followed by a proc.
          if (ptPChar in PossType) and (PCharEndAddress <> nil) and
             (ProcSize <> 0) and (ProcSize - (PCharEndAddress - StartAddress) > $40) then
            PossType := [ptPChar];

          // If a proc is still possible say it is a proc.
          if ptProc in PossType then
            PossType := [ptProc];
          // If a PChar is still possible say it is a pchar.
          if ptPChar in PossType then
            PossType := [ptPChar];

          // Create a TDecompItem to fill the block.
          if PossType = [ptProc] then
          begin
            AProc := Procs.Add(StartAddress);
            AProc.Comments.Add(Format('Unknown block proc at %p to %p',
               [Pointer(StartAddress), Pointer(EndAddress)]));
            AProc.Comments.Add(ALog);
            AProc.PossProcTypes := ptAllStatic;
            AProc.Size := GetProcSize(StartAddress);
            AProc.ProcSize := AProc.Size;
            {$IFOPT D+}
              if AProc.Size > OrgEndAddress - StartAddress then
                SendDebugEx(Format('To big proc %p %x %p', [Pointer(StartAddress), AProc.Size,
                  Pointer(EndAddress)]), mtError);
            {$ENDIF}
            Result := Procs.AnalyzeProc(AProc);
            AppendProcs;
            AlignProcs;
            // A Proc maybe Free in Append Procs, so search for the proc at startaddress.
            AProc := Procs.FindProc(StartAddress);
            if AProc.Size = 0 then
              AProc := Procs.FindProc(StartAddress +1);
//              raise EDecompilerError.CreateFmt(SProcSize0Error, [Pointer(AProc.Address)]);
            EndAddress := AProc.Address + AProc.Size;
//!            if  Integer(EndAddress) mod 4 <> 0 then
//!              raise EDecompilerError.CreateFmt('EndAddress not 4 Byte alligned, %p %p',
//!                 [pointer(AProc.Address), pointer(EndAddress)]);
          end
          else
            if PossType = [ptPChar] then
            begin
              if PCharEndAddress <> nil then
                EndAddress := PCharEndAddress;
              with TStringInfo.Create(StringInfos, StartAddress, stPAnsiChar, EndAddress - StartAddress) do
              begin
                Comments.Add(ALog);
                Name := Format('PChar%p', [Pointer(StartAddress)]);
              end;
            end
            else
              with TGUIDConst.Create(miscs) do
              begin
                Comments.Add(ALog);
                Address := StartAddress;
                Size := EndAddress - StartAddress;
              end;

          StartAddress := EndAddress;
        finally
          FixupsInside.Free;
        end;
      finally
        FixupsTo.Free;
      end;
    end;

  begin
    CodeItems := TList.Create;
    try
      ReDo:
      DecompThread.CheckTerminated;
      {$IFOPT D+}
      SendDebug('Start Analysing unknown blocks');
      LastDC := nil;
      DbugCounter := 0;
      {$ENDIF}

      MaxAddress := Units.SysInitUnit.FInit.Address + Units.SysInitUnit.FInit.Size;
      // Add all code items to the CodeItems list.
      CodeItems.Clear;
      CodeItems.Capacity := Classes.Count + TypeInfos.Count + Procs.Count + StringInfos.Count;
      for I := 0 to Classes.Count -1 do
        if (Classes[I].Address >= MaxAddress) then
          CodeItems.Add(Classes[I]);
      for I := 0 to TypeInfos.Count -1 do
        if (TypeInfos[I].Address >= MaxAddress) then
          CodeItems.Add(TypeInfos[I]);
      for I := 0 to Procs.Count -1 do
        if (Procs[I].Size <> 0) and (Procs[I].Address <> nil) and
           (Procs[I].Address >= MaxAddress) then
          CodeItems.Add(Procs[I]);
      for I := 0 to StringInfos.Count -1 do
        if (StringInfos[I].Address < Data) and
           (StringInfos[I].Address >= MaxAddress) then
          CodeItems.Add(StringInfos[I]);
      for I := 0 to Miscs.Count -1 do
        if (Miscs[I].Size <> 0) and
           (Miscs[I].Address >= MaxAddress) then
          CodeItems.Add(Miscs[I]);

      CodeItems.Sort(DecompItemSort);

      for I := 0 to CodeItems.Count -1 do
      begin
        if TDecompItem(CodeItems[I]).Address < MaxAddress then
        begin
          if TDecompItem(CodeItems[I]).Address + TDecompItem(CodeItems[I]).Size <= MaxAddress then
          begin
            // There is a decomp item inside another decomp item.
            if (TDecompItem(CodeItems[I]) is TProc) or
               ((TDecompItem(CodeItems[I]) is TStringInfo) and
                (TStringInfo(CodeItems[I]).StringType = stPAnsiChar)) then
            begin
              // If it is a proc or PChar inside the other decomp item, Delete it.
              TDecompItem(CodeItems[I]).Free;
              CodeItems[I] := nil;
              Continue;
            end
            else
            begin
              {$IFOPT D+}
                if LastDC <> nil then
                  SendDebugEx(Format('Not proc block inside another block %s %p %x, %s %p',
                     [LastDC.ClassName, Pointer(LastDC.Address), LastDC.Size,
                      TDecompItem(CodeItems[I]).ClassName, Pointer(TDecompItem(CodeItems[I]).Address)]), mtError)
                else
                  SendDebugEx(Format('Not proc block inside another block %s %p',
                     [TDecompItem(CodeItems[I]).ClassName, Pointer(TDecompItem(CodeItems[I]).Address)]), mtError)
              {$ELSE}
                raise EDecompilerError.CreateFmt('Not proc block inside another block %p %p',
                   [Pointer(MaxAddress), Pointer(TDecompItem(CodeItems[I]).Address)]);
              {$ENDIF}
            end;
          end
          else
          begin
            {$IFOPT D+}
              if LastDC <> nil then
                SendDebugEx(Format('Overlapping code items %s %p %x, %s %p',
                   [LastDC.ClassName, Pointer(LastDC.Address), LastDC.Size,
                    TDecompItem(CodeItems[I]).ClassName, Pointer(TDecompItem(CodeItems[I]).Address)]), mtError)
              else
                SendDebugEx(Format('Overlapping code items, %s %p',
                   [TDecompItem(CodeItems[I]).ClassName, Pointer(TDecompItem(CodeItems[I]).Address)]), mtError);
            {$ELSE}
              raise EDecompilerError.CreateFmt('Overlapping code items %p %p',