使用 Delphi 64 位檢測虛擬化環境？

Question

// VMware detection as described by Elias Bachaalany
function IsInsideVMware: Boolean;
begin
  Result := True;

  try
    asm
      push edx;
      push ecx;
      push ebx;

      mov eax, 'VMXh';
      mov ebx, 0;
      mov ecx, 10;
      mov edx, 'VX';

      in eax, dx;

      cmp ebx, 'VMXh';
      setz [Result];

      pop ebx;
      pop ecx;
      pop edx;
    end;
  except
    Result := False;
  end;
end;


function IsRunningUnderHyperV: BOOL; stdcall;
var
  VMBranding: array[0..12] of AnsiChar;
begin
  asm
    mov eax, $40000000;
    cpuid;
        mov dword ptr [VMBranding+0], ebx;  // Get the VM branding string
        mov dword ptr [VMBranding+4], ecx;
        mov dword ptr [VMBranding+8], edx;
  end;
  VMBranding[12] := #0;
  Result := CompareText(String(VMBranding), 'Microsoft Hv') = 0;
end;

如何為 64 位 Delphi 應用程序完成此操作？

如果我嘗試將其編譯為 64 位，我會收到消息“Unsupported language feature: ASM”和“Operand size mismatch”。 我知道您需要將 asm 代碼與 pascal 代碼和寄存器分開，但不知道該怎么做？

Answer 1

最后，我將此解決方案用於 32/64 位。

var
  LFlag: Cardinal;

//================================= VMWare =====================================

procedure TryVMWare;
{$IFDEF CPUX86}
  asm
    push eax
    push ebx
    push ecx
    push edx
    mov eax, 'VMXh'
    mov ecx, 0Ah
    mov dx, 'VX'
    in eax, dx
    mov LFlag, ebx
    pop edx
    pop ecx
    pop ebx
    pop eax
  end;
{$ENDIF CPUX86}
{$IFDEF CPUX64}
  asm
    push rax
    push rbx
    push rcx
    push rdx
    mov eax, 'VMXh'
    mov ecx, 0Ah
    mov dx, 'VX'
    in eax, dx
    mov LFlag, ebx
    pop rdx
    pop rcx
    pop rbx
    pop rax
  end;
{$ENDIF CPUX64}

function IsInsideVMware: Boolean;
begin
  LFlag := 0;
  try
    TryVMWare;
  except
  end;
  Result := LFlag = $564D5868;
end;

至於在 64 位中檢測其他 VM 品牌，我使用了以下代碼：

https://github.com/JBontes/FastCode/blob/master/FastcodeCPUID.pas

代碼已更新以作為 x64 位運行和編譯並檢測虛擬機品牌。

Answer 2

JEDI JclSysInfo.GetCpuInfo() function 幾乎可以獲取您想要了解的有關 CPU 的所有信息，並返回物理設備的特性，無論您是在 VM 中還是在根操作系統中。 檢測大多數 VM 的最簡單方法是獲取 CPUID 字符串：

function GetVMBranding: String;
var
  VMBranding: array[0..12] of AnsiChar;
begin
  asm
    mov eax, $40000000;
    cpuid;
    mov dword ptr [VMBranding+0], ebx;  // Get the VM branding string
    mov dword ptr [VMBranding+4], ecx;
    mov dword ptr [VMBranding+8], edx;
  end;
  VMBranding[12] := #0;
  Result := String(VMBranding);
end;

然后將其與已知字符串進行比較（可以在https://en.wikipedia.org/wiki/CPUID#:~:text=In%20the%20x86%20architecture%2C%20the,and%20SL%2Denhanced% 找到列表20486%20個處理器）但是，有幾個重要的警告：

1. 如果安裝了 Hyper-V，CPUID 查詢將返回 Hyper-V 簽名，無論您是在根操作系統上還是在虛擬機中運行。 這是因為一旦安裝了 Hyper-V，它的虛擬機管理程序甚至會為根操作系統管理線程。 我還沒有找到一種方法來檢測實際在 Hyper-V VM 中運行。

2. VirtualBox 和 WINE 需要不同的檢測方法。 WINE在NTDLL.DLL中添加了一些函數，因此尋找這些函數是檢測WINE的可靠方法。 對於 VirtualBox，您必須在正在運行的進程列表中查找它的服務。

function CheckWine: Boolean;
var
  hnd: THandle;
  wine_get_version: function : pchar; {$IFDEF Win32} stdcall; {$ENDIF}
  wine_unix2fn: procedure (p1:pointer; p2:pointer); {$IFDEF Win32} stdcall; {$ENDIF}
begin
  Result := False;
  hnd := LoadLibrary('ntdll.dll');
  if hnd > 32 then begin
    wine_get_version := GetProcAddress(hnd, 'wine_get_version');
    wine_unix2fn := GetProcAddress(hnd, 'wine_nt_to_unix_file_name');
    if assigned(wine_get_version) or assigned(wine_unix2fn) then
       Result := True;
    FreeLibrary(hnd);
  end;
end;

//uses WinApi.TlHelp32
function CheckVirtualBox: Boolean;
var
  handle: THandle;
  procinfo: ProcessEntry32;
begin
  Result   := False;
  handle   := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  procinfo.dwSize := sizeof(PROCESSENTRY32);
  while(Process32Next(handle, procinfo)) do begin
    if (POS('VBoxService.exe', procinfo.szExeFile) > 0) then begin
      Result := True;
      Break;
    end;
  end;
  CloseHandle(handle);
end;