procs.pas

这是个反向工程delphi的程序的全部源代码.能分析几乎所有的结构 Revendepro is a program to reverse engineer Delphi program. Reven

              InUnit.Name := NMInfo.UnitName;
              InUnit.Comments.AddComment('Unit name set because of export item ' + PEExports[I].Name, ctDebug);
              if (NMInfo.ItemName <> 'Finalization') then
              begin
                // Create the proc.
                Proc := FindProc(PEExports[I].Address);
                if Proc = nil then
                  Proc := Add(PEExports[I].Address);
                with Proc do
                begin
                  AUnit := InUnit;
                  Comments.AddComment('Exported proc ' + PEExports[I].Name, ctInfo);
                  if NMInfo.NMType = eitProc then
                  begin
                    PossProcTypes := [ptProcedure];
                    // move the proc the the interface part unless it is in the package unit
                    if TUnit(AUnit).UnitType <> utProgram then
                      IntfImpl := iiInterface;
                  end
                  else
                  begin
                    AClass := AClassInfo;
                    // there is no name it this is a constructor.
                    if NMInfo.ItemName = '' then
                      PossProcTypes := PossProcTypes * [ptConstructor, ptDestructor]
                    else
                      PossProcTypes := PossProcTypes * ptMethods;
                  end;
                  AppendBefore := atMayNot;
                  if Address <= Units.SystemUnit.FInit.Address then
                  begin
                    // Make it a proc of size 0 if it is in the system unit.
                    AppendAfter := atMayNot;
                    if NMInfo.ItemName <> '' then
                      Name := NMInfo.ItemName;
                  end
                  else
                    // there is no name it this is a constructor.
                    if (NMInfo.ItemName <> '') and
                       (AnsiCompareText(Proc.Name, NMInfo.ItemName) <> 0) then
                    begin
                      // If a proc with this name already exists add the address to the name.
                      J := FindProcByName(NMInfo.ItemName);
                      if (J = -1) or (Proc.Index = J) then
                        Name := NMInfo.ItemName
                      else
                        Name := Format('%s%p', [NMInfo.ItemName, Pointer(PEExports[I].Address)]);
                    end;
                  // Add the name including the methods as a comment.
                  Comments.AddComment(NMInfo.ItemProp, ctInfo);
                  // There are some strange procs in coride40.bpl which are in full capital
                  // Just thread them as proc markers (I don't known what else to do with them).
                  if NMInfo.ItemProp[1] = 'Q' then
                    AppendAfter := atMayNot;
                end;
              end;
            end;
          end;
        end;
    end;
end;

function TProcs.AnalyzeProc(Proc: TProc): Boolean;
var
  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.AddComment(Format('Jump to %p', [Pointer(Jumps[I])]), ctDebug);
        if AProc = nil then
        begin
          if (Jumps[I] < PEFileClass.Code) or (Jumps[I] >= PEFileClass.Code + PEFileClass.CodeSize) then
            Break;
          if TPEFileClass(PEFileClass).FindDecompItemByBlock(Jumps[I]) <> nil then
          begin
            Proc.AddReq(TPEFileClass(PEFileClass).FindDecompItemByBlock(Jumps[I]), Jumps[I]);
          end
          else
          begin
            Result := True;
            AProc := Add(Jumps[I]);
            AProc.Comments.AddComment('Jump created as an proc', ctInfo);
            AProc.PossProcTypes := ptAllStatic;
            AProc.Size := GetProcSize(AProc.Address);
            AProc.ProcSize := AProc.Size;
            AProc.AUnit := TPEFileClass(PEFileClass).Units.FindInUnitUsingFInit(AProc.Address);
            AnalyzeProc(AProc);
          end;
        end;
        if AProc <> nil then
        begin
          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.AddComment(Format('Append after set because of analyse proc at %p', [Pointer(AProc.Address)]), ctDebug);
                Proc.AppendAfter := atMust;
                AProc.Comments.AddComment(Format('Append after set because of jump to a middle of a proc at %p', [Pointer(Proc.Address)]), ctDebug);
                AProc.AppendBefore := atMust;
              end
              else
                if Proc.AppendBefore <> atMayNot then
                begin
                  Proc.Comments.AddComment(Format('Append before set because of analyse proc at %p', [Pointer(AProc.Address)]), ctDebug);
                  Proc.AppendBefore := atMust;
                  AProc.Comments.AddComment(Format('Append before set because jump to a middle of a proc at %p', [Pointer(Proc.Address)]), ctDebug);
                  AProc.AppendAfter := atMust;
                end;
            end;
            Proc.AddReq(AProc, Jumps[I]);
          end;
        end;
      end;
    finally
      Jumps.Free;
    end;
  finally
    DisAsm.Free;
  end;
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 vir