Ist Anwendung 32 oder 64 Bit

[Luckie]

Zitat von mkinzler:

Der Pfad dürfte zudem egal sein

Ich bin ordnungsliebend. Da kommt nichts einfach "irgendwo" hin.

[Amateurprofi]

Zitat von Luckie:

Zitat von mkinzler:

Der Pfad dürfte zudem egal sein

Ich bin ordnungsliebend. Da kommt nichts einfach "irgendwo" hin.

Auch keine 5?

[ringli]

Ich werfe mal diese Funktion in den (virtuellen) Raum:

Delphi-Quellcode:

const
  SCS_32BIT_BINARY = 0;
  SCS_64BIT_BINARY = 6;
  SCS_DOS_BINARY   = 1;
  SCS_OS216_BINARY = 5;
  SCS_PIF_BINARY   = 3;
  SCS_POSIX_BINARY = 4;
  SCS_WOW_BINARY   = 2;

  KERNEL32_DLL     = 'kernel32.dll';

  // Typ eines Binaries erkennen
  // DYNAMISCHER FUNKTIONSIMPORT !!!
type
  TGetBinaryType = function (lpApplicationName: PWideChar; out lpBinaryType: DWORD): Boolean; stdcall;

function GetBinaryType(lpApplicationName: PWideChar; out lpBinaryType: DWORD): Boolean;
var
  DLL_Handle        : THandle;        // für dynamischen Funktionsimport!
  DLL_GetBinaryType : TGetBinaryType; // für dynamischen Funktionsimport!
begin
  // Handle für die KERNEL32.DLL erhalten
  DLL_Handle := LoadLibraryW(PWideChar(KERNEL32_DLL));
  // Wenn Handle vorhanden, Adressen der Funktionen ermitteln
  if DLL_Handle <> 0 then
    begin
      try
        @DLL_GetBinaryType := GetProcAddress(DLL_Handle, 'GetBinaryTypeW');
        // Wurde GetBinaryTypeW in der DLL gefunden?
        if @DLL_GetBinaryType <> nil then
          begin
            Result := DLL_GetBinaryType(lpApplicationName, lpBinaryType);
          end
        else
          begin
            RaiseLastOSError;
            Result := False;
          end;
      finally
        FreeLibrary(DLL_Handle);
      end;
    end
  else
    begin
      RaiseLastOSError;
      Result := False;
    end;
end;

Das dürfte der offizielle Weg sein. Optimierungspotenzial nicht ausgeschlossen.

[himitsu]

Delphi-Quellcode:

function IsExecutable32Bit(const Filename: String): Boolean;
var
  hFile : THandle;
  bRead : {$IF Defined(NativeUInt)}NativeUInt{$ELSE}LongWord{$IFEND};
  Buffer : array[0..1024*64-1] of Byte; // Warning: Assuming both headers are in there!
  DosHeader : TImageDosHeader absolute Buffer;
  NtHeader : PImageNtHeaders;
begin
  Result := False;
  hFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, NIL, OPEN_EXISTING, 0, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    try
      if ReadFile(hFile, Buffer, SizeOf(Buffer), bRead, NIL)
          and (DosHeader.e_magic = IMAGE_DOS_SIGNATURE)
          and (DosHeader._lfanew + SizeOf(TImageNtHeaders) <= bRead) then
        begin
          NtHeader := PImageNtHeaders(@Buffer[DosHeader._lfanew]);
          if NtHeader.Signature = IMAGE_NT_SIGNATURE then
            Result := NtHeader.FileHeader.Machine and IMAGE_FILE_32BIT_MACHINE <> 0;
        end; {
        else
          raise Exception.Create('File is not a valid executable.'); }
    finally
      CloseHandle(hFile);
    end;
  end; {
  else
    raise Exception.Create('File is not readable.'); }
end;

Bissl aufgeräumt und die Position des NTHeaders geprüft.
Auch für NonVCL-Programme unter 32 KB.

Und zum Offiziellen:

Delphi-Quellcode:

type
  TBinaryType = (tbUnknown, btDLL, tbWin32, btDOS, btWOW, btPIF, btPOSIX, btOS2_16, btWin64);

function GetBinaryType(Filename: string): TBinaryType;
type
  TGetBinaryType = function(Filename: PChar; var BinaryType: DWORD): BOOL; stdcall;
var
  GetBinaryTypeProc: TGetBinaryType;
  Value: DWORD;
begin
  GetBinaryTypeProc := GetProcAddress(GetModuleHandle('kernel32.dll'),
    {$IF SizeOf(Char) = 1}'GetBinaryTypeA'{$ELSE}'GetBinaryTypeW'{$IFEND});
  Value := 0;
  if not Assigned(GetBinaryTypeProc) then
    Result := tbUnknown
  else if GetBinaryTypeProc(PChar(Filename), Value) then
    Result := TBinaryType(Value + Ord(tbWin32))
  else if GetLastError = ERROR_BAD_EXE_FORMAT then
    Result := btDLL
  else
    Result := tbUnknown;
end;

(die kernel32.dll ist im Prinzip immer geladen)