Ist Anwendung 32 oder 64 Bit

[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)