dedeclasses.pas

dede 的源代码 3.10b

  FConverter.ImageBase:=FCodeBase;
  FConverter.PhysOffset:=PhysOffset;
  FConverter.CodeRVA:=CodeRVA;
end;
*)
{ TPEStream }

procedure TPEStream.BeginSearch;
begin
  FlBackupPos:=Position;
end;

procedure TPEStream.DumpCodeToFile(FromO, ToO: DWORD; sFileName: String; HT : THeaderType);
Var TmpStream : TMemoryStream;
    b : Byte;
    i : DWORD;
begin
  TmpStream:=TMemoryStream.Create;
  Try
   //Puts DFM Header
   If HT=htDFM Then For i:=0 To 15 Do TmpStream.WriteBuffer(arrDFM_HEADER[i],1);

   Try
    Seek(FromO,soFromBeginning);
    For i:=0 To ToO-FromO Do
      Begin
        b:=ReadByte;
        TmpStream.WriteBuffer(b,1);
      End;
    TmpStream.SaveToFile(sFileName);
   Except
   End;
  Finally
    TmpStream.Free;
  End;
end;

procedure TPEStream.EndSearch;
begin
   Position:=FlBackupPos;
end;

function TPEStream.PatternMach(APattern: TPaternQuery): Boolean;
var b  : Byte;
    bi : Integer;
    bMatch : Boolean;
    i : LongInt;
begin
   i:=0;
   bMatch:=True;
   While (bMatch) and (i<APattern.size) Do
    begin
     try
       ReadBuffer(b,1);
     except
       If MessageDlg(err_read_beyond+IntToStr(position),
               mtError,[mbIgnore,mbAbort],0)=mrAbort Then Begin
                    Result:=False;
                    GlobAbort:=True;
                    Exit;
                 End;
     end;
     bi:=APattern.GetByte(i);
     bMatch:=(b=bi) or (bi=-10);
     Inc(i);
    end;

   Result:=bMatch;
end;

procedure TPEStream.ReadBufferA(var buffer: array of byte; size: Dword);
begin
   ReadBuffer(buffer,size);
   Seek(-size,soFromCurrent)
end;

function TPEStream.ReadByte: Byte;
var b : Byte;
begin
  ReadBuffer(b,1);
  Result:=b;
end;

function TPEStream.ReadByteA: Byte;
var b : Byte;
begin
  ReadBuffer(b,1);
  Seek(-1,soFromCurrent);
  Result:=b;
end;

function TPEStream.ReadDWord: DWord;
Var dw : DWORD;
    //b1,b2,b3,b4 : Byte;
begin
  ReadBuffer(dw,4);
  Result:=dw;
end;

function TPEStream.ReadDWordA: DWord;
var buffer : Array of Byte;
begin
  SetLength(buffer,4);
  Read(buffer,4);
  Seek(-4,soFromCurrent);
  Result:=BA2DWORD(buffer);
end;

function TPEStream.ReadDWordF: DWord;
var d : DWORD;
begin
  ReadBuffer(d,4);
  Result:=d;
end;

function TPEStream.ReadDWordFA: DWord;
var d : DWORD;
begin
  ReadBuffer(d,4);
  Seek(-4,soFromCurrent);
  Result:=d;
end;

function TPEStream.ReadWord: Word;
var buffer : Array of Byte;
begin
  SetLength(buffer,2);
  Read(buffer,2);
  Result:=BA2WORD(buffer);
end;

function TPEStream.ReadWordA: Word;
var buffer : Array of Byte;
begin
  SetLength(buffer,2);
  Read(buffer,2);
  Seek(-2,soFromCurrent);
  Result:=BA2WORD(buffer);end;

function TPEStream.ReadWordF: Word;
var w : Word;
begin
  ReadBuffer(w,2);
  Result:=w;
end;

function TPEStream.ReadWordFA: Word;
var w : Word;
begin
  ReadBuffer(w,2);
  Seek(-2,soFromCurrent);
  Result:=w;
end;

procedure TPEStream.WriteBufferA(var buffer: array of byte; size: Dword);
begin
   WriteBuffer(buffer,size);
   Seek(-size,soFromCurrent)
end;

{ TPaternQuery }

function TPaternQuery.GetByte(Index: LongInt): Integer;
begin
  If index>size then
     Result:=-1
     Else If not mask[index]
        then Result:=-10
        else Result:=buffer[index];
end;

function TPaternQuery.GetPattern: String;
var i : Integer;
begin
  Result:='';
  For i:=0 To Size-1 Do
    If mask[i] then Result:=Result+Byte2HEX(buffer[i])
               else Result:=Result+'xx';
End;

procedure TPaternQuery.SetPattern(AsPattern: String);
Var sHex : String;
    i  : Integer;
begin
  Size:=Length(AsPattern) div 2;
  SetLength(buffer,Size);
  SetLength(mask,Size);
  For i:=0 to (Length(AsPattern) div 2)-1 Do
    Begin
      sHex:=Copy(AsPattern,(i*2)+1,2);
      If AnsiUpperCase(sHex)='XX' Then
        Begin
          buffer[i]:=0;
          mask[i]:=false;
        End
        Else Begin
          buffer[i]:=HEX2Byte(sHex);
          mask[i]:=true;
        End;
    End;
end;

procedure TPaternQuery.SetString(AsString: String);
Var i  : Integer;
begin
  Size:=Length(AsString);
  SetLength(buffer,Size);
  SetLength(mask,Size);
  For i:=0 to Length(AsString)-1 Do
    Begin
      buffer[i]:=ORD(AsString[i+1]);
      mask[i]:=true;
    End;
end;

{ TRVAConverter }

function TRVAConverter.GetPhys(AsRVA: DWORD): DWORD;
begin
  Result:=AsRVA-ImageBase-CodeRVA+PhysOffset;
end;

function TRVAConverter.GetRVA(AsPhys: DWORD): DWORD;
begin
  Result:=AsPhys+ImageBase+CodeRVA-PhysOffset;
end;

function TRVAConverter.GetPhys(AsRVA: String): String;
begin
  Result:=DWORD2HEX(HEX2DWORD(AsRVA)-ImageBase-CodeRVA+PhysOffset);
end;

function TRVAConverter.GetRVA(AsPhys: String): String;
begin
  Result:=DWORD2HEX(HEX2DWORD(AsPhys)+ImageBase+CodeRVA-PhysOffset);
end;


{ TDFMProjectHeader }


constructor TDFMProjectHeader.Create;
begin
   Inherited Create;

   FPASList:=TStringList.Create;
   FDFMList:=TStringList.Create;
end;

destructor TDFMProjectHeader.Destroy;
begin
   FPASList.Free;
   FDFMList.Free;

   Inherited Destroy;
end;

procedure TDFMProjectHeader.Dump(PEStream: TPEStream; Offset: Integer);
var b1,b2,b3,b4 : Byte;
    s : String;
    c : Word;
    i,j : LongInt;
    bAddUnit : Boolean;
begin
  // Should be improved to search for system and sysconst units, and from there to
  // to get the project header, not from the compiler ident !!!!
  // Rerteive Information
  With PEStream Do
   Begin
     BeginSearch;
     Seek(Offset+iPROJECT_OFFSET-$10,soFromBeginning);
     GlobError:=err_proj_header_incorrect;
     Try
       ReadBuffer(b1,1);ReadBuffer(b2,1);ReadBuffer(b3,1);ReadBuffer(b4,1);
       Characteristic1:=b1+b2*256+(b3+b4*256)*256*256;
       ReadBuffer(b1,1);ReadBuffer(b2,1);ReadBuffer(b3,1);ReadBuffer(b4,1);
       Characteristic2:=b1+b2*256+(b3+b4*256)*256*256;
       SetLength(UnitEntries,Characteristic2);
       UnitEntriesCount:=Characteristic2-1;
       For i:=0 To UnitEntriesCount Do
        Begin
         ReadBuffer(b1,1);ReadBuffer(b2,1);
         c:=b1+b2*256;
         ReadBuffer(b1,1);
         s:='';
         While b1<>0 Do
          Begin
           s:=s+CHR(b1);
           ReadBuffer(b1,1);
          End;
         If i=0 Then
           Begin
             // Application Data
             ProjectName:=s;
             ProjectChar:=c;
           End
           Else Begin
             // Unit Data
             UnitEntries[i].Name:=s;
             UnitEntries[i].Characteristic:=c;
           End;
       End;
     Finally
       EndSearch;
     End;
   End;

   // Processing Files

   // Adding PAS files to create
   FPASList.Clear;
   FDFMList.Clear;
   GlobError:=err_invalid_unit_flag;
   For i:=1 To UnitEntriesCount Do
     If UnitEntries[i].Characteristic AND $10 = 0
       Then Begin
          bAddUnit:=True;
          For j:=1 To iMAX_STANDART_UNITS_COUNT Do
             If arrPROJECT_STANDART_UNITS[j]=UnitEntries[i].Name
               Then begin
                 bAddUnit:=False;
                 Break;
               End;
          If bAddUnit
             Then FPASList.Add(UnitEntries[i].Name+'.PAS');
        End;
end;

Function GetDelphiVersion(PEFile : ThePEFile) : String;
const IDS='TControl';
const VER_ARR : Array [0..1,0..2] of String =
       (('0','114','120'),('D3','D4','D5'));
var delta, dw, dw1, bkup : DWord;
    b1,b2 : Byte;
    s : String;

    function InCODE(DW : DWORD) : boolean;
    begin
     result:=(dw>PEHeader.IMAGE_BASE+(PEHeader.Objects[1].RVA)) and (dw<PEHeader.IMAGE_BASE+(PEHeader.Objects[1].RVA)+PEHeader.Objects[1].PHYSICAL_SIZE)
    end;

Begin
  Result:='<check failed>';
  /////////////////////////////
  // No need to call this ?
  //PEHeader.Dump(PEFile);
  delta:=PEHeader.IMAGE_BASE+(PEHeader.Objects[1].RVA)-PEHeader.Objects[1].PHYSICAL_OFFSET;
  PEFile.PEStream.Seek(PEHeader.Objects[1].PHYSICAL_OFFSET,soFromBeginning);
  Repeat
    PEFile.PEStream.ReadBuffer(dw,4);
    bkup:=PEFile.PEStream.Position;
    If dw-delta=PEFile.PEStream.Position Then
      Begin
        PEFile.PEStream.ReadBuffer(b1,1);
        if b1<=16 Then
         begin
            PEFile.PEStream.ReadBuffer(b2,1);
            SetLength(s,b2);
            PEFile.PEStream.ReadBuffer(s[1],b2);
            PEFile.PEStream.ReadBuffer(dw,4);
            If InCODE(dw) then
              begin
               dw1:=dw-PEHeader.IMAGE_BASE-(PEHeader.Objects[1].RVA)+PEHeader.Objects[1].PHYSICAL_OFFSET;
               PEFile.PEStream.Seek(dw1-40,soFromBeginning);
               PEFile.PEStream.ReadBuffer(dw,4);
               If s=IDS then begin
                 case dw of
                  $0   : Result:='D3';
                  $B4,  {cbuilder}
                  $114 : if GlobCBuilder then Result:='BCB4'
                                         else Result:='D4';
                  $120 : if GlobCBuilder then Result:='BCB5'
                                         else Result:='D5';
                  $138 : if bELF then Result:='Kylix';

                  $128 : if GlobCBuilder then Result:='BCB6?'
                                         else Result:='D6 CLX';
                  $15C, $160
                        : if GlobCBuilder then Result:='BCB6?'
                                         else Result:='D6';
                  else Result:='<unknown version>';
                 end;
                 Exit;
               end;
              end;
          end;
       end;
       PEFile.PEStream.seek(bkup,soFromBeginning);
  Until (PEFile.PEStream.Position>=PEHeader.Objects[1].PHYSICAL_OFFSET+PEHeader.Objects[1].PHYSICAL_SIZE);
  If GlobDelphi2 Then Result:='D2';
End;

Function GetDelphiVersionFromImports(sFileName : String; lImpOffset,lImpRVA : DWORD) : String;
var PEImportData : TPEImportData;
    TmpList : TStringList;
    idx : Integer;
    s : String;
Begin
  Result:='<unknown>';
  if PEHeader.GetSectionIndexEx('BSS')=-1 then Exit;

  Result:='Console';
  PEImportData.FileName:=sFileName;

  TmpList:=TStringList.Create;
  Try
    Try
      PEImportData.CollectInfo(lImpOffset, lImpRVA, TmpList);
    Except
    End;

    If TmpList.IndexOf('VCL30.bpl')<>-1 Then Result:='3';
    If TmpList.IndexOf('VCL30.dpl')<>-1 Then Result:='3';
    If TmpList.IndexOf('VCL40.bpl')<>-1 Then Result:='4';
    If TmpList.IndexOf('VCL40.dpl')<>-1 Then Result:='4';
    If TmpList.IndexOf('VCL50.bpl')<>-1 Then Result:='5';
    If TmpList.IndexOf('VCL50.dpl')<>-1 Then Result:='5';
    If TmpList.IndexOf('VCL60.bpl')<>-1 Then Result:='6';
    If TmpList.IndexOf('VCL60.dpl')<>-1 Then Result:='6';

    idx:=PEHeader.GetSectionIndexEx('CODE');
    PEFile.PEStream.BeginSearch;
    Try
      PEFile.PEStream.Seek(PEHeader.Objects[idx].PHYSICAL_OFFSET+5,soFromBeginning);
      SetLength(s,3);
      PEFile.PEStream.ReadBuffer(s[1],3);
    Finally
      PEFile.PEStream.EndSearch;
    End;

    if s='C++' then Result:='BCB'+Result
               else Result:='D'  +Result;
  Finally
    TmpList.Free;
  End;
End;


{ TFieldData }

procedure TFieldData.AddField(Name : String; ID : DWORD; Flag : Word);
var Field : TFieldRec;
begin
  Field:=TFieldRec.Create;
  Field.sName:=Name;
  Field.dwID:=ID;
  Field.wFlag:=Flag;
  Fields.Add(Field);
end;

Function TFieldData.GetFieldName(ID : DWORD) : String;
var Field : TFieldRec;
    i : Integer;
begin
  Result:='';
  For i:=0 to Fields.Count-1 Do
    begin
      Field:=TFieldRec(Fields[i]);
      if Field.dwID=ID then
        begin
          Result:=Field.sName;
          Break;
        end;
    end;
end;