procs.pas

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

  EndAddress: PChar;
  DisAsm: TDisAsm;
  Size: Integer;
  TempAddress: PChar;
  I: Integer;
  AAddress: PChar;
  AProc: TProc;
  Jumps: TList;
begin
  Result := False;
  DisAsm := TDisAsm.Create;
  try
    Jumps := TList.Create;
    try
      AAddress := Proc.Address;
      DisAsm.OnJumpInstr := SaveJumpAddress;
      DisAsm.OnCallInstr := SaveJumpAddress;
      DisAsm.Param := @TempAddress;

      EndAddress := AAddress + Proc.Size;
      while AAddress < EndAddress do
      begin
        // if it is a pointer to something add it to the list and skip, otherwise
        // decompile the instruction.
        if TPEFileClass(PEFileClass).Fixups.FindFixup(AAddress) <> -1 then
        begin
          Size := 4;
          if (PPChar(AAddress)^ >= PEFileClass.Code) and (PPChar(AAddress)^ < PEFileClass.Code + PEFileClass.CodeSize) then
            Jumps.Add(PPChar(AAddress)^);
        end
        else
        begin
          TempAddress := nil;
          DisAsm.GetInstruction(AAddress, Size);
          if TempAddress <> nil then
          begin
            // Check to see if it is a jump to HandleOnException.
            if (TPEFileClass(PEFileClass).FindSystemProc(HandleOnExceptionProcName) <> nil) and
               (TempAddress = TPEFileClass(PEFileClass).FindSystemProc(HandleOnExceptionProcName).Address) then
            begin
              TempAddress := PChar(High(Integer));
              for I := 1 to PDWord(AAddress + 5)^ do
              begin
                if PPChar(AAddress + 5 + I * 8)^ < TempAddress then
                  TempAddress := PPChar(AAddress + 5 + I * 8)^;
                if (PPChar(AAddress + 5 + I * 8)^ < PEFileClass.Code) or
                   (PPChar(AAddress + 5 + I * 8)^ >= PEFileClass.Code + PEFileClass.CodeSize) then
                  raise EDecompilerError.CreateFmt('Jump to outside the code section (2). %p %p',
                    [Pointer(AAddress + 5 + I * 8), Pointer(PPChar(AAddress + 5 + I * 8)^)]);
                Jumps.Add(PPChar(AAddress + 5 + I * 8)^);
              end;
              AAddress := TempAddress;
              Size := 0;
            end
            else
            begin
              // Save the address to which is jumped.
              if (TempAddress < PEFileClass.Code) or
                 (TempAddress >= PEFileClass.Code + PEFileClass.CodeSize) then
                raise EDecompilerError.CreateFmt('Jump to outside the code section. %p %p (3)',
                   [Pointer(AAddress), Pointer(TempAddress)]);
              Jumps.Add(TempAddress);
            end;
          end;
        end;
        Inc(AAddress, Size);
        if AAddress > PEFileClass.Code + PEFileClass.CodeSize then
          raise EDecompilerError.Create('Function outside Code section');
      end;
      // Check to see if the jumps are to code otherwise decompile it.
      Jumps.Sort(ListSimpleSort);
      for I := 0 to Jumps.Count -1 do
      begin
        AProc := FindProc(Jumps[I]);
        Proc.Comments.Add(Format('Jump with %p', [Pointer(Jumps[I])]));
        if AProc = nil then
        begin
          if (Jumps[I] < PEFileClass.Code) or (Jumps[I] >= PEFileClass.Code + PEFileClass.CodeSize) then
            Break;
//            raise EDecompilerError.CreateFmt('Jump to outside the code section (1). %p',
//              [Pointer(Jumps[I])]);
          Result := True;
          AProc := Add(Jumps[I]);
          AProc.Comments.Add('Jump created as an proc');
          AProc.PossProcTypes := ptAllStatic;
          AProc.Size := GetProcSize(AProc.Address);
          AProc.ProcSize := AProc.Size;
          AProc.AUnit := TPEFileClass(PEFileClass).Units.FindInUnitUsingFInit(AProc.Address);
          AnalyzeProc(AProc);
        end;
        if AProc <> Proc then
        begin
          // If the Proc doesn't jump/call to the beginning of the Proc is must Append.
          if AProc.Address <> Jumps[I] then
          begin
            if AProc.Address > Proc.Address then
            begin
              Proc.Comments.Add(Format('Append after set because of analyse proc at %p', [Pointer(AProc.Address)]));
              Proc.AppendAfter := atMust;
              AProc.Comments.Add(Format('Append after set because of jump to a middle of a proc at %p', [Pointer(Proc.Address)]));
              AProc.AppendBefore := atMust;
            end
            else
              if Proc.AppendBefore <> atMayNot then
              begin
                Proc.Comments.Add(Format('Append before set because of analyse proc at %p', [Pointer(AProc.Address)]));
                Proc.AppendBefore := atMust;
                AProc.Comments.Add(Format('Append before set because jump to a middle of a proc at %p', [Pointer(Proc.Address)]));
                AProc.AppendAfter := atMust;
              end;
          end;
          Proc.AddReq(AProc, Jumps[I]);
        end;
      end;
    finally
      Jumps.Free;
    end;
  finally
    DisAsm.Free;
  end;
end;

procedure TProcs.GenerateInstrs;
var
  I: Integer;
begin
  for I := 0 to Count -1 do
    Items[I].GenerateInstr;
end;

function TProcs.Add(Address: PChar): TProc;
begin
  Result := TProc.Create(Self, Address);
end;

function TProcs.FindProc(Address: PChar): TProc;
var
  I, L, H, C: Integer;
begin
  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
    Result := TProc(inherited GetItem(I));
    if (Result.Address = Address) or
       ((Result.Address <= Address) and
        (Result.Address + Result.Size > Address)) then
      Exit;
  end;
  Result := nil;
end;

function TProcs.FindProcByName(const Name: string): Integer;
begin
  for Result := 0 to Count -1 do
    if Items[Result].Name = Name then
      exit;
  Result := -1;
end;

function TProcs.FindProcIndex(Address: PChar; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  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
    begin
      H := I - 1;
      if C = 0 then
        Result := True;
    end;
  end;
  Index := L;
end;

function TProcs.GetItem(Index: Integer): TProc;
begin
  Result := TProc(inherited GetItem(Index));
end;

procedure TProcs.SetItem(Index: Integer; Value: TProc);
begin
  inherited SetItem(Index, Value);
end;

{ TClassInfo }

constructor TClassInfo.Create(ClassInfos: TClassInfos; AClass: TClass);
var
  InterfaceTable: PInterfaceTable;
  I, J: Integer;
  MethodCount: Integer;
resourcestring
  SErrorAncestorClassNotFound = 'Ancestor class from %s not found';
begin
  inherited Create(ClassInfos);
  FClass := AClass;
  FMethods := TList.Create;
  FInterfaces := TList.Create;
  InterfaceTable := AClass.GetInterfaceTable;
  FClassDef := TStringList.Create;
  // Find the ancestor class.
  for I := 0 to ClassInfos.Count -1 do
    if ClassInfos[I].AClass = AClass.ClassParent then
      FAncestorClass := ClassInfos[I];
  if FAncestorClass = nil then
    with TPEFileClass(PEFileClass).DecompThread do
      for J := 0 to PEFileClassCount -1 do
        for I := 0 to TPEFileClass(PEFileClasses[J]).Classes.Count -1 do
          if TPEFileClass(PEFileClasses[J]).Classes[I].AClass = AClass.ClassParent then
          begin
            FAncestorClass := TPEFileClass(PEFileClasses[J]).Classes[I];
            Break;
          end;
  if (FAncestorClass = nil) and (AClass.ClassName <> 'TObject') then
    raise EDecompilerError.CreateFmt(SErrorAncestorClassNotFound, [AClass.ClassName]);

  if InterfaceTable <> nil then
  begin
    for I := 0 to InterfaceTable.EntryCount -1 do
    begin
      MethodCount := Integer(InterfaceTable) -
         Integer(InterfaceTable.Entries[I].VTable);
      for J := I+1 to InterfaceTable.EntryCount -1 do
        if Integer(InterfaceTable.Entries[I].VTable) <
            Integer(InterfaceTable.Entries[J].VTable) then
        begin
          MethodCount := Integer(InterfaceTable.Entries[J].VTable) -
            Integer(InterfaceTable.Entries[I].VTable);
          break;
        end;
      FInterfaces.Add(TPEFileClass(ClassInfos.PEFileClass).Interfaces.Add(
         InterfaceTable.Entries[I].IID, MethodCount));
    end;
  end;

  // First address used is InterfaceVMT method or otherwise start VMT.
  Address := PChar(AClass) + vmtSelfPtr;
  if InterfaceTable <> nil then
  begin
    J := 0;
    // Get the first VTable.
    while J < InterfaceTable.EntryCount do
    begin
      I := Integer(InterfaceTable.Entries[J].VTable);
      if I <> 0 then
      begin
        while I < Integer(InterfaceTable) do
        begin
          if PInteger(I)^ < Integer(Address) then
            Address := PPChar(I)^;
          Inc(I, 4);
        end;
        break;
      end;
      Inc(J);
    end;
  end;
  // Address is 4 byte aligned
  Address := Address - Integer(Address) mod 4;

  // Size is address to end ClassName.
  Size := ((PInteger(Integer(AClass) + vmtClassName)^ + Length(AClass.ClassName)) div 4) * 4 + 4 - Integer(Address);
end;

procedure TClassInfo.AnaClass;

  procedure LoadVirtualMethods;
  var
    J: Integer;
    ParentClassCount: Integer;
    Address: PChar;
    Proc: TProc;
  const
    StdVirtualMethodNames: array[-8..-1] of string =
       ('SafeCallException', 'AfterConstruction', 'BeforeDestruction',
        'Dispatch', 'DefaultHandler', 'NewInstance', 'FreeInstance', 'Destroy');
    StdVirtualMethodParams: array[-8..-1] of string =
       ('ExceptObject: TObject; ExceptAddr: Pointer', '', '',
        'var Message', 'var Message', '', '', '');
    StdVirtualMethodResults: array[-8..-1] of string =
       ('HResult', '', '', '', '', 'TObject', '', '');
    StdVirtualMethodTypes: array[-8..-1] of TProcTypes =
      ([ptMethodProcedure], [ptMethodProcedure], [ptMethodProcedure],
       [ptMethodProcedure], [ptMethodProcedure], [ptClassProcedure],
       [ptMethodProcedure], [ptDestructor]);
  resourcestring
    SVirtualMethodInsideAnother = 'VirtualMethod at %p is inside another method at %p';
  begin
    if AClass.ClassParent <> nil then
      ParentClassCount := GetVirtualMethodCount(AClass.ClassParent)
    else
      ParentClassCount := -9;
    // J = -8 to start with the virtual Methods in the VMT.
    for J := -8 to GetVirtualMethodCount(AClass) -1 do
    begin
      Address := VMTUtils.GetVirtualMethod(AClass, J);
      // Search for an already existing proc.
      if (Address <> nil) then
        Proc := TPEFileClass(PEFileClass).Procs.FindProc(Address)
      else
        Proc := nil;
      // Don't add a virtual method if this is the same as the parents virtual method
      if (J >= ParentClassCount) or ((VMTUtils.GetVirtualMethod(AClass.ClassParent, J) <> Address) and
          ((Proc = nil) or (not Proc.ImportInfo.Imported))) then
      begin
        // Compare the Method with AbstractError procedure.
        if (TPEFileClass(PEFileClass).FindSystemProc(AbstractErrorProcName) <> nil) and
           (TPEFileClass(PEFileClass).FindSystemProc(AbstractErrorProcName).Address = Address) then
        begin
          // Set the address to nil to indicate that it is a abstract method.
          Address := nil;
          Proc := nil;
        end;
        if Proc = nil then
          Proc := TPEFileClass(PEFileClass).Procs.Add(Address);
        if Proc.Address <> Address then
          raise EDecompilerError.CreateFmt(SVirtualMethodInsideAnother, [Pointer(Address), Pointer(Proc.Address)]);
        with Proc do
        begin
          Comments.Add('Virtual method');
          PossProcTypes := PossProcTypes * ptMethods;
          MethodBindingType := mbtVirtual;
          AClass := Self;
          if Address = nil then
            AddReq(TPEFileClass(PEFileClass).FindSystemProc(AbstractErrorProcName), nil);
          MethodIndex := J;
          if J < ParentClassCount then
            Overrides := True;
          // If the proc is a standard proc, set the it values.
          if J < 0 then
          begin
            Name := StdVirtualMethodNames[J];
            Parameters.Parameters := StdVirtualMethodParams[J];
            Parameters.FuncResult := StdVirtualMethodResults[J];
            PossProcTypes := StdVirtualMethodTypes[J];
          end;
        end;
      end;
    end;
  end;

  procedure LoadFieldsProp;
  var
    PropCount: Integer;
    I: Integer;

    procedure AnaProc(Proc: PChar; ParamStr, ResultStr: string; TypeInfo: PTypeInfo);
    var
      AProc: TProc;
      CarProc: Cardinal absolute Proc;
    begin
      if Proc = nil then Exit;
      if CarProc < $FE000000 then
      begin
        // Static Proc.
        AProc := TPEFileClass(PEFileClass).Procs.FindProc(Proc);
        if AProc = nil then
          AProc := TPEFileClass(PEFileClass).Procs.Add(Proc);
        AProc.Comments.Add('Field property getter/setter');
        AProc.Parameters.Parameters := ParamStr;
        AProc.Parameters.FuncResult := ResultStr;
        AProc.AClass := Self;
        AProc.PossProcTypes := [ptMethodProcedure];
      end
      else if CarProc > $FF000000 then
      begin
        // Fields.
        CarP