///////////////////////////////////////////////////////////////////////
// Copyright(c) 2022-2022 Alexey Kuryakin kouriakine@mail.ru under MIT.
// That is library to detect VBOX runtime - VirtualBox Guest Additions.
// VBOX is acronym of "VirtualBox". See https://www.virtualbox.org
///////////////////////////////////////////////////////////////////////

unit _VBOX; // VBOX detecting library.

{$IFDEF FPC}{$mode objfpc}{$ENDIF}{$H+}

interface

uses windows,sysutils,registry;

/////////////////////////////////////////////////////////////////////////
// Library based on registry value:
// HKEY_LOCAL_MACHINE\SOFTWARE\Oracle\VirtualBox Guest Additions\Version
/////////////////////////////////////////////////////////////////////////

const                           // detect_vbox() codes:
 STATUS_NO_VBOX         = 0;    // VBOX is not detected.
 STATUS_BAD_VBOX        = -1;   // Invalid VBOX version ID.
 STATUS_VBOX_UNASSIGNED = -2;   // VBOX is not assigned yet.

 /////////////////////////////////////////////
 // Detecting VBOX runtime and return version.
 // Return positive value like 5120 when VBOX
 // is running and return version like 5.1.20.
 // Return value <=0 when VBOX is not running.
 /////////////////////////////////////////////
function detect_vbox(var version:String):Integer;   // Detect VBOX version (>0) or error (<=0)
function detect_vbox_number:Integer;                // Detect VBOX version as Integer like 5120
function detect_vbox_string:String;                 // Detect VBOX version as String  like 5.1.20
function detect_vbox_host:Boolean;                  // Detect VBOX host is running

function ReadVirtualBoxGuestAdditionsVersion:String;

implementation

const vbox_version_string : String = '';
const vbox_version_number : integer= STATUS_VBOX_UNASSIGNED;

function detect_vbox_host:Boolean;
var dummy:String;
begin
 if (vbox_version_number<>STATUS_VBOX_UNASSIGNED)
 then Result:=(vbox_version_number>0)
 else Result:=(detect_vbox(dummy)>0);
end;

function detect_vbox_number:Integer;
var dummy:String;
begin
 if (vbox_version_number<>STATUS_VBOX_UNASSIGNED)
 then Result:=vbox_version_number
 else Result:=detect_vbox(dummy);
end;

function detect_vbox_string:String;
begin
 if (vbox_version_number<>STATUS_VBOX_UNASSIGNED)
 then Result:=vbox_version_string
 else detect_vbox(Result);
end;

function ReadVirtualBoxGuestAdditionsVersion:String;
const Key='SOFTWARE\Oracle\VirtualBox Guest Additions';
const Name='Version';
var Reg:TRegistry;
begin
 Result:='';
 Reg:=TRegistry.Create;
 try
  Reg.RootKey:=HKEY_LOCAL_MACHINE;
  if Reg.KeyExists(Key) then begin
   Reg.OpenKeyReadOnly(Key);
   case Reg.GetDataType(Name) of
    rdString : Result:=Reg.ReadString(Name);
   end;
  end;
 finally
  Reg.Free;
 end;
end;

procedure SplitVersion(s:String; var sh,sm,sl:String);
var p:Integer;
begin
 sh:=''; sm:=''; sl:='';
 p:=Pos('.',s);
 if (p>0) then begin
  sh:=Copy(s,1,p-1);
  Delete(s,1,p);
  p:=Pos('.',s);
  if (p>0) then begin
   sm:=Copy(s,1,p-1);
   Delete(s,1,p);
   sl:=s;
  end;
 end;
end;

function detect_vbox(var version:String):Integer;
var h,m,l,ch,cm,cl:Integer; sh,sm,sl:String;
begin
 version:='';
 if (vbox_version_number<>STATUS_VBOX_UNASSIGNED) then begin
  version:=vbox_version_string;
  Result:=vbox_version_number;
  Exit;
 end;
 version:=Trim(ReadVirtualBoxGuestAdditionsVersion);
 if (version = '') then begin
  vbox_version_number := STATUS_NO_VBOX;
  Result:=vbox_version_number;
  Exit;
 end;
 h:=0; m:=0; l:=0;
 ch:=1; cm:=1; cl:=1;
 vbox_version_string:=version;
 SplitVersion(version,sh,sm,sl);
 if (sh<>'') and (sm<>'') and (sl<>'') then begin
  Val(sh,h,ch); Val(sm,m,cm); Val(sl,l,cl);
 end;
 if (ch<>0) or (cm<>0) or (cl<>0) or (h<0) or (m<0) or (l<0) then begin
  vbox_version_number := STATUS_BAD_VBOX;
  Result:=vbox_version_number;
  Exit;
 end;
 vbox_version_number := h * 1000 + (m mod 10)*100 + (l mod 100);
 Result:=vbox_version_number;
end;

end.
