Herausfinden ob Prozess/Anwendung mit Delphi compiliert ist

[ErazerZ]

hey,
ich hab da was heute gemacht, ich habs getestet mit ein paar delphi programmen und es scheint zu funktionieren, es ist ähnlich wie peid, prüft werte nach dem EntryPoint der datei und vergleicht sie mit fertigen signaturen, natürlich kann ich net versprechen das es immer funktioniert, jedoch hats hier mit Delphi6 + Delphi7 funktioniert, einwandfrei

Delphi-Quellcode:

const
  // 0 ist sozusagen der Joker, wenn man nicht weiß was für ein byte dannach folgt ..
  DelphiBorland: Array[0..5] of Byte = (
    $55, $8B, $EC, $83, $C4, $F4);

  BorlandDelphiComponent: Array[0..7] of Byte = (
    $C3, $E9, 0, 0, 0, $FF, $8D, $40);

  BorlandDelphiDLL: Array[0..22] of Byte = (
    $55, $8B, $EC, $83, $C4, $B4, $B8, 0, 0, 0
    , 0, $E8, 0, 0, 0, 0, $E8, 0, 0, 0
    , 0, $8D, $40);

  BorlandDelphi3: Array[0..40] of Byte = (
    $50, $6A, 0, $E8, 0, 0, $FF, $FF, $BA, 0
    , 0, 0, 0, $52, $89, $05, 0, 0, 0, 0
    , $89, $42, $04, $E8, 0, 0, 0, 0, $5A, $58
    , $E8, 0, 0, 0, 0, $C3, $55, $8B, $EC, $33
    , $C0);

  BorlandDelphi3_2: Array[0..176] of Byte = (
    $55, $8B, $EC, $83, $C4, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, $00);

  BorlandDelphi4_5: Array[0..49] of Byte = (
    $50, $6A, 0, $E8, 0, 0, $FF, $FF, $BA, 0
    , 0, 0, 0, $52, $89, $05, 0, 0, 0, 0
    , $89, $42, $04, $C7, $42, $08, 0, 0, 0, 0
    , $C7, $42, $0C, 0, 0, 0, 0, $E8, 0, 0
    , 0, 0, $5A, $58, $E8, 0, 0, 0, 0, $C3);

  BorlandDelphi4_5_2: Array[0..176] of Byte = (
    $55, $8B, $EC, $83, $C4, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, $20);

  BorlandDelphi4_5_3: Array[0..49] of Byte = (
    $50, $6A, $00, $E8, 0, 0, $FF, $FF, $BA, 0
    , 0, 0, 0, $52, $89, $05, 0, 0, 0, 0
    , $89, $42, $04, $C7, $42, $08, $00, $00, $00, $00
    , $C7, $42, $0C, $00, $00, $00, $00, $E8, 0, 0
    , 0, 0, $5A, $58, $E8, 0, 0, 0, 0, $C3);

  BorlandDelphi5_KOL: Array[0..38] of Byte = (
    $55, $8B, $EC, $83, $C4, $F0, $B8, 0, 0, $40
    , $00, $E8, 0, 0, $FF, $FF, $E8, 0, 0, $FF
    , $FF, $E8, 0, 0, $FF, $FF, $8B, $C0, $00, $00
    , $00, $00, $00, $00, $00, $00, $00, $00, $00);

  BorlandDelphi6_KOL: Array[0..47] of Byte = (
    $55, $8B, $EC, $83, $C4, $F0, $B8, 0, 0, $40
    , $00, $E8, 0, 0, $FF, $FF, $A1, 0, $72, $40
    , $00, $33, $D2, $E8, 0, 0, $FF, $FF, $A1, 0
    , $72, $40, $00, $8B, $00, $83, $C0, $14, $E8, 0
    , 0, $FF, $FF, $E8, 0, 0, $FF, $FF);

  DelphiBorland6_7: Array[0..87] of Byte = (
    $55, $8B, $EC, 0, $C4, 0, 0, 0, 0, 0     // 4ter wert geändert ..
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    , 0, 0, 0, 0, 0, 0, 0, 0, $00, $00
    , $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
    , $00, $00, $00, $00, $00, $00, $00, $00);

  DelphiBorland6_7_2: Array[0..46] of Byte = (
    $53, $8B, $D8, $33, $C0, $A3, $00, 0, 0, 0
    , $06, $A0, $0E, $80, 0, 0, $0F, $FA, $30, 0
    , 0, 0, $0A, $10, 0, 0, 0, $0A, $30, 0
    , 0, 0, $03, $3C, $0A, $30, 0, 0, 0, $03
    , $3C, $0A, $30, 0, 0, 0, $E8);

  DelphiBorland6_7_3: Array[0..70] of Byte = (
    $55, $8B, $EC, $83, $C4, $F0, $B8, 0, 0, 0
    , 0, $E8, 0, 0, $FB, $FF, $A1, 0, 0, 0
    , 0, $8B, 0, $E8, 0, 0, $FF, $FF, $8B, $0D
    , 0, 0, 0, 0, $A1, 0, 0, 0, 0, $8B
    , $00, $8B, $15, 0, 0, 0, 0, $E8, 0, 0
    , $FF, $FF, $A1, 0, 0, 0, 0, $8B, 0, $E8
    , 0, 0, $FF, $FF, $E8, 0, 0, $FB, $FF, $8D
    , $40);

  DelphiBorland6_7_4: Array[0..31] of Byte = (
    $BA, 0, 0, 0, 0, $83, $7D, $0C, $01, $75
    , 0, $50, $52, $C6, $05, 0, 0, 0, 0, 0
    , $8B, $4D, $08, $89, $0D, 0, 0, 0, 0, $89
    , $4A, $04);

  DelphiBorland6: Array[0..29] of Byte = (
    $55, $8B, $EC, $83, $C4, $F0, $B8, 0, 0, $45
    , $00, $E8, 0, 0, 0, $FF, $A1, 0, 0, $45
    , $00, $8B, $00, $E8, 0, 0, $FF, $FF, $8B, $0D);

  DelphiBorland6_2: Array[0..46] of Byte = (
    $53, $8B, $D8, $33, $C0, $A3, 0, 0, 0, 0
    , $6A, $00, $E8, 0, 0, 0, $FF, $A3, 0, 0
    , 0, 0, $A1, 0, 0, 0, 0, $A3, 0, 0
    , 0, 0, $33, $C0, $A3, 0, 0, 0, 0, $33
    , $C0, $A3, 0, 0, 0, 0, $E8);

  DelphiBorland2: Array[0..44] of Byte = (
    $E8, 0, 0, 0, 0, $6A, 0, $E8, 0, 0
    , 0, 0, $89, $05, 0, 0, 0, 0, $E8, 0
    , 0, 0, 0, $89, $05, 0, 0, 0, 0, $C7
    , $05, 0, 0, 0, 0, $0A, 0, 0, 0, $B8
    , 0, 0, 0, 0, $C3);

function GetFieldOffset(const Struct; const Field): Cardinal;
begin
  Result := Cardinal(@Field) - Cardinal(@Struct);
end;

function GetImageFirstSection(NTHeader: PImageNtHeaders): PImageSectionHeader;
begin
  Result := PImageSectionHeader(Cardinal(NTHeader) + GetFieldOffset(NTHeader^, NTHeader^.OptionalHeader) + NTHeader^.FileHeader.SizeOfOptionalHeader);
end;

function CompareBytes(FirstBytes: Array of Byte; Signature: Array of Byte): Boolean;
var
  i: Integer;
  b: Boolean;
begin
  b := False;
  for i := 0 to sizeof(FirstBytes) -1 do
  begin
    if i >= sizeof(Signature) then
      break;
    if Signature[i] <> Byte(0) then
    begin
      if (FirstBytes[i] = Signature[i]) then
        b := True
      else
      begin
        b := False;
        break;
      end;
    end else
      continue;
  end;
  Result := b;
end;

function IsDelphiApplication(FileName: String): Boolean;
var
  b: Boolean;
  lpData: Pointer;
  i: Integer;
  hFile: THandle;
  DosHeader: PImageDosHeader;
  NtHeader: PImageNtHeaders;
  SectionHeader: PImageSectionHeader;
  dwReadBytes, dwFileSize, dwEP, dwFileEP: DWORD;
  FirstBytes: Array[0..200] of Byte;
begin
  Result := False;
  dwFileEP := 0;
  hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  if hFile <> 0 then
  begin
    dwFileSize := GetFileSize(hFile, nil);
    lpData := GetMemory(dwFileSize);
    ReadFile(hFile, lpData^, dwFileSize, dwReadBytes, nil);
    if dwReadBytes = dwFileSize then
    begin
      DosHeader := lpData;
      if DosHeader.e_magic = IMAGE_DOS_SIGNATURE then
      begin
        NTHeader := Pointer(Integer(lpData) + DosHeader._lfanew);
        if NTHeader.Signature = IMAGE_NT_SIGNATURE then
        begin
          dwEP := StrToInt(FloatToStr(NtHeader.OptionalHeader.AddressOfEntryPoint));
          SectionHeader := GetImageFirstSection(NtHeader);
          for i := 0 to NTHeader.FileHeader.NumberOfSections -1 do
          begin
            if (dwEP >= SectionHeader.VirtualAddress) and (dwEP <= SectionHeader.VirtualAddress + SectionHeader.SizeOfRawData) then
            begin
              dwFileEP := dwEP - SectionHeader.VirtualAddress + SectionHeader.PointerToRawData;
            end;
            SectionHeader := Pointer(DWORD(SectionHeader) + sizeof(TImageSectionHeader));
          end;
        end;
        if dwFileEP <> 0 then
        begin
          SetFilePointer(hFile, dwFileEP, nil, FILE_BEGIN);
          ReadFile(hFile, FirstBytes, sizeof(FirstBytes), dwReadBytes, nil);
          
          b := CompareBytes(FirstBytes, DelphiBorland);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphiComponent);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphiDLL);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi3);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi3_2);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi4_5);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi4_5_2);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi4_5_3);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi5_KOL);
          if not b then
            b := CompareBytes(FirstBytes, BorlandDelphi6_KOL);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6_7);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6_7_2);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6_7_3);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6_7_4);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland6_2);
          if not b then
            b := CompareBytes(FirstBytes, DelphiBorland2);

          CloseHandle(hFile);
          Result := b;
        end else
          CloseHandle(hFile);
      end else
        CloseHandle(hFile);
    end else
      CloseHandle(hFile);
  end else
    CloseHandle(hFile);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    if IsDelphiApplication(OpenDialog1.FileName) then
      ShowMessage('delphi programm')
    else
      ShowMessage('kein delphi programm');
end;

naja, ich geh mal pennen, ich schau noch ob ich es irgendwie verbessern kann

ps: die signaturen sind nicht von mir, sondern von netz irgendwo her (glaub war für peid, weiß net mehr genau)

cya, ErazerZ