Detect virtualized environment with Delphi 64-bit? - delphi

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;
How can this be done for 64-bit Delphi application?
If I try to compile it as 64-bit I get message "Unsupported language feature: ASM" and "Operand size mismatch". I know that you need to separate asm code from pascal code and registers are different but have no idea how to do it?

Answer 1

At end, I have used this solution for 32/64-bit.
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;
As for detecting other VM brands in 64-bit I have used code from:
https://github.com/JBontes/FastCode/blob/master/FastcodeCPUID.pas
Code is updated to run and compile as x64 bit and detect virtual machines brands.

Answer 2

The JEDI JclSysInfo.GetCpuInfo() function gets just about everything you'd ever want to know about the CPU, and returns the physical device's characteristics regardless of whether you're in a VM or on the root OS. The easiest way to detect most VMs is to get the CPUID string:
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;
Then compare it to known strings (a list can be found at https://en.wikipedia.org/wiki/CPUID#:~:text=In%20the%20x86%20architecture%2C%20the,and%20SL%2Denhanced%20486%20processors) However, there are a couple of important caveats:
The CPUID query will return the Hyper-V signature if Hyper-V is installed, whether or not you're running on the root OS or in a VM. This is because once Hyper-V is installed, its hypervisor is managing threads even for the root OS. I have not found a way yet to detect actually running inside a Hyper-V VM.
VirtualBox and WINE require separate methods of detection. WINE adds some functions to NTDLL.DLL, so looking for those functions is a reliable way to detect WINE. For VirtualBox, you have to look for its service in the list of running processes.
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;