////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// That is library to detect VBOX runtime - VirtualBox Guest Additions.       //
// VBOX is acronym of "VirtualBox". See https://www.virtualbox.org            //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 2022xxxx - Created by A.K.                                                 //
// 20230801 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_vbox; // VBOX detecting library.

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 {$IFDEF WINDOWS} registry, {$ENDIF}
 sysutils, classes, process,
 _crw_alloc, _crw_environ, _crw_proc;

/////////////////////////////////////////////////////////////////////////
// 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:LongString):Integer; // Detect VBOX version (>0) or error (<=0)
function detect_vbox_number:Integer;                  // Detect VBOX version as Integer like 5120
function detect_vbox_string:LongString;               // Detect VBOX version as String  like 5.1.20
function detect_vbox_host:Boolean;                    // Detect VBOX host is running

function ReadVirtualBoxGuestAdditionsVersion:LongString;

implementation

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

function detect_vbox_host:Boolean;
var dummy:LongString;
begin
 dummy:='';
 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:LongString;
begin
 dummy:='';
 if (vbox_version_number<>STATUS_VBOX_UNASSIGNED)
 then Result:=vbox_version_number
 else Result:=detect_vbox(dummy);
end;

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

{$IFDEF WINDOWS}
function ReadVirtualBoxGuestAdditionsVersion:LongString;
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;
{$ENDIF WINDOWS}

{$IFDEF UNIX}
function ReadVirtualBoxGuestAdditionsVersion:LongString;
const exe='VBoxClient'; cmd=exe+' --version';
var s:LongString; p:Integer;
begin
 Result:='';
 if (FileSearch(exe,GetEnv('PATH'),false)<>'') then
 if RunCommand(cmd,s) then begin
  s:=Trim(s); p:=Pos('r',s);
  if (p>0) then s:=Copy(s,1,p-1);
  Result:=Trim(s);
 end;
end;
{$ENDIF ~UNIX}

procedure SplitVersion(s:LongString; out sh,sm,sl:LongString);
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:LongString):Integer;
var h,m,l,ch,cm,cl:Integer; sh,sm,sl:LongString;
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;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_vbox;
begin
end;

procedure Free_crw_vbox;
begin
end;

initialization

 Init_crw_vbox;

finalization

 Free_crw_vbox;

end.

//////////////
// END OF FILE
//////////////

