حماية البرنامج في بيئة الجهاز الافتراضي Virtual Machine

[أبو معاذ]

السلام عليكم.
بارك الله فيكم على التفاعل مع الموضوع.
سؤال فقط، 
هل هناك دالة للتأكد من ما إذا كان البرنامج يعمل في بيئة الجهاز الافتراضي او لا؟

---

السلام عليكم .
وجدت هذه الدالة  uDGVMUtils ،على الموقع :

PHP كود :

unit uDGVMUtils;

interface

(*******************************************************************************
  http://www.delphigeist.com/2011/01/udgvmutils-version-11-thanks-to-chee.html?m=1
  uDGVMUtils -- is an attempt to create one of the best virtual machine
    detector methods, feel free to contribute in any way you wish.

  Version 1.1, 2010-01-15

  Copyright© you are free to use it for comercial, private or both purposes

  Contributors:
    Dorin Duminica
    Chee Meng

*******************************************************************************)

type
  TVMWareVersion = (
    vvExpress = 1,
    vvESX,
    vvGSX,
    vvWorkstation,
    vvUnknown,
    vvNative);

const
  VMWARE_VERSION_STRINGS: array [TVMWareVersion] of string = (
    'Express',
    'ESX',
    'GSX',
    'Workstation',
    'Unknown',
    'Native');

type
  TVirtualMachineType = (
    vmNative,
    vmVMWare,
    vmWine,
    vmVirtualPC,
    vmVirtualBox);

const
  VIRTUALMACHINE_STRINGS: array[TVirtualMachineType] of string = (
    'Native',
    'VMWare',
    'Wine',
    'Virtual PC',
    'Virtual Box');

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean; overload;
function IsRunningVMWare: Boolean; overload;
function IsRunningWine(var AWineVersion: string): Boolean; overload;
function IsRunningWine: Boolean; overload;
function IsRunningVirtualPC: Boolean;
function IsRunningVBox: Boolean;
function IsRunningVM(var AVMVersion: string): Boolean; overload;
function IsRunningVM: Boolean; overload;

implementation

uses
  SysUtils,
  Windows;

function IsRunningVMWare(var AVMWareVersion: TVMWareVersion): Boolean;
const
  CVMWARE_FLAG = $564D5868;
var
  LFlag: Cardinal;
  LVersion: Cardinal;
begin
  LFlag := 0;
  try
    asm
      push eax
      push ebx
      push ecx
      push edx

      mov eax, 'VMXh'
      mov ecx, 0Ah
      mov dx, 'VX'

      in eax, dx

      mov LFlag, ebx
      mov LVersion, ecx

      pop edx
      pop ecx
      pop ebx
      pop eax
    end;
  except
//  uncomment next two lines if you wish to see exception
//    on E: Exception do
//      ShowMessage(E.message);
  end; // trye
  if LFlag = CVMWARE_FLAG then begin
    Result := True;
    case LVersion of
      1: AVMWareVersion := vvExpress;
      2: AVMWareVersion := vvESX;
      3: AVMWareVersion := vvGSX;
      4: AVMWareVersion := vvWorkstation;
      else
        AVMWareVersion := vvUnknown;
    end
  end else begin
    Result := False;
    AVMWareVersion := vvNative;
  end; // if LFlag = CVMWARE_FLAG then begin
end;

function IsRunningVMWare: Boolean;
var
  LVMWareVersion: TVMWareVersion;
begin
  Result := IsRunningVMWare(LVMWareVersion);
end;

function IsRunningWine(var AWineVersion: string): Boolean;
type
  TWineGetVersion = function: PAnsiChar;{$IFDEF Win32}stdcall;{$ENDIF}
  TWineNTToUnixFileName = procedure (P1: Pointer; P2: Pointer);{$IFDEF Win32}stdcall;{$ENDIF}
var
  LHandle: THandle;
  LWineGetVersion: TWineGetVersion;
  LWineNTToUnixFileName: TWineNTToUnixFileName;
begin
  Result := False;
  AWineVersion := 'Unknown';
  LHandle := LoadLibrary('ntdll.dll');
  if LHandle > 32 then begin
    LWineGetVersion := GetProcAddress(LHandle, 'wine_get_version');
    LWineNTToUnixFileName := GetProcAddress(LHandle, 'wine_nt_to_unix_file_name');
    if Assigned(LWineGetVersion) or Assigned(LWineNTToUnixFileName) then begin
      Result := True;
      if Assigned(LWineGetVersion) then
        AWineVersion := StrPas(LWineGetVersion);
    end; // if Assigned(LWineGetVersion) or ...
    FreeLibrary(LHandle);
  end; // if LHandle > 32 then begin
end;

function IsRunningWine: Boolean;
var
  LWineVersion: string;
begin
  Result := IsRunningWine(LWineVersion);
end;

function IsRunningVirtualPC: Boolean;
asm
  push ebp;
  mov ebp, esp;

  mov ecx, offset @exception_handler;

  push ebx;
  push ecx;

  push dword ptr fs:[0];
  mov dword ptr fs:[0], esp;

  mov ebx, 0; // Flag
  mov eax, 1; // VPC function number

  // call VPC
  db $0F, $3F, $07, $0B

  mov eax, dword ptr ss:[esp];
  mov dword ptr fs:[0], eax;

  add esp, 8;

  test ebx, ebx;

  setz al;

  lea esp, dword ptr ss:[ebp-4];
  mov ebx, dword ptr ss:[esp];
  mov ebp, dword ptr ss:[esp+4];

  add esp, 8;

  jmp @ret1;

  @exception_handler:
  mov ecx, [esp+0Ch];
  mov dword ptr [ecx+0A4h], -1; // EBX = -1 ->; not running, ebx = 0 -> running
  add dword ptr [ecx+0B8h], 4; // ->; skip past the call to VPC
  xor eax, eax; // exception is handled

  @ret1:
end;

function IsRunningVBox: Boolean;

  function Test1: Boolean;
  var
    LHandle: Cardinal;
  begin
    Result := False;
    try
      LHandle := LoadLibrary('VBoxHook.dll');
      Result := (LHandle <> 0);
      if Result then
        FreeLibrary(LHandle);
    except
    end; // trye
  end; // function Test1: Boolean;

  function Test2: Boolean;
  var
    LHandle: Cardinal;
  begin
    Result := False;
    try
      LHandle := CreateFile(
        '\\\\.\\\VBoxMiniRdrDN',
        GENERIC_READ,
        FILE_SHARE_READ,
        NIL,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
        0);
      Result := (LHandle <> INVALID_HANDLE_VALUE);
      if Result then
        CloseHandle(LHandle);
    except
    end; // trye
  end; // function Test2: Boolean;

begin
  Result := Test1 or Test2;
end;

function IsRunningVM(var AVMVersion: string): Boolean;
begin
  AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];
  Result := True;
  if IsRunningWine then
    AVMVersion := VIRTUALMACHINE_STRINGS[vmWine]
  else
    if IsRunningVMWare then
      AVMVersion := VIRTUALMACHINE_STRINGS[vmVMWare]
    else
      if IsRunningVirtualPC then
        AVMVersion := VIRTUALMACHINE_STRINGS[vmWine]
      else
        if IsRunningVBox then
          AVMVersion := VIRTUALMACHINE_STRINGS[vmVirtualBox]
        else begin
          AVMVersion := VIRTUALMACHINE_STRINGS[vmNative];
          Result := False;
        end;
end;

function IsRunningVM: Boolean;
var
  LVMVersion: string;
begin
  Result := IsRunningVM(LVMVersion);
end;

end. 


أنا لست مثبت جهاز افتراضي ،
حبذا لو يتكرم  بعض الإخوة بتجربة الكود ،

جزاكم الله خيرا.