////////////////////////////////////////////////////////////////////////////////
// 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:                                                                   //
// System identification routines.                                            //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230813 - Created (A.K.) using _stdapp                                    //
////////////////////////////////////////////////////////////////////////////////

unit _crw_sysid; // System identification 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, jwawindows, {$ENDIF}
 sysutils, classes, process, math, lazfileutils,
 _crw_alloc, _crw_cmdargs, _crw_environ, _crw_fpu, _crw_ef,
 _crw_str, _crw_fio, _crw_rtc, _crw_proc, _crw_base64,
 _crw_polling, _crw_guard, _crw_pio;

 { Return string identifier of current system. }
function GetSystemVersionString:LongString;

{ Return string identifier of current OS. }
function GetOSVersionString:LongString;

const // List of (id) values for GetCpuVersionInfo.
 CpuVersionInfoList='~MHz,ProcessorNameString,VendorIdentifier,Identifier,'
                   +'Architecture,Family,Model,Stepping';

 { Get CPU version by id=(~MHz,ProcessorNameString,VendorIdentifier,Identifier) }
function GetCpuVersionInfo(n:Integer; const id:LongString; const alter:LongString=''):LongString;

 { Get nominal frequency MHz of CPU #n from system registry. }
function GetCpuFreqMHzNominal(n:Integer=0):Integer;

const // Global memory parameters available for ReadProcMemInfo(id).
 MemInfoNameList='MemTotal,MemFree,MemAvailable,SwapTotal,SwapFree,'
                +'MemUsed,SwapUsed,MemLoad,SwapLoad';
 {
 Read /proc/meminfo parameter (id) in bytes.
 The (id) parameter name is from MemInfoNameList.
 }
function ReadProcMemInfo(id:LongString):QWord;

{$IFDEF UNIX}
const // Parameters avail for ReadSysDevicesVirtualDmiId(name).
 VirtualDmiIdNameList:LongString='sys_vendor,modalias,uevent,ec_firmware_release,'
 +'product_family,product_version,product_name,product_serial,product_uuid,product_sku,'
 +'bios_vendor,bios_date,bios_version,bios_release,'
 +'board_vendor,board_name,board_version,board_serial,board_asset_tag,'
 +'chassis_vendor,chassis_version,chassis_serial,chassis_type,chassis_asset_tag';
 {
 Read parameter(s) from /sys/devices/virtual/dmi/id/name.
 }
function ReadSysDevicesVirtualDmiId(name:LongString):LongString;
{$ENDIF ~UNIX}

 { Get system BIOS information from DMI or Registry. }
function GetSystemBiosInfo:LongString;

 { Get system model information from DMI or Registry. }
function GetSystemModelInfo:LongString;

 { Get video BIOS information from DMI or Registry. }
function GetVideoBiosInfo:LongString;

{$IFDEF WINDOWS}
 { Get version info on Window NT. }
function GetWinNtVersionInfo(const id:LongString; const alter:LongString=''):LongString;

 { Get CURRENT CONTROL SET parameter (id) from Registry. }
function GetCurrCtrlSetSysInfo(const id:LongString; const alter:LongString=''):LongString;
{$ENDIF ~WINDOWS}

{$IFDEF WINDOWS}
const                      // For GetGuiResources
 GR_GDIOBJECTS_PEAK  = 2;  // Return the peak count of GDI objects.  >= W7
 GR_USEROBJECTS_PEAK = 4;  // Return the peak count of USER objects. >= W7

 // Get counter of kernel handles (files,threads,mutexes etc) opened by process.
 // See http://msdn.microsoft.com/en-us/library/ms683214(v=VS.85).aspx
function GetProcessHandleCount(hProcess:THandle; var HandleCount:DWORD):BOOL stdcall;

// Get GDI, USER and KERNEL handle quota, i.e. maximum number of opened handles.
// GetGuiResources(GetCurrentProcess,GR_GDIOBJECTS)  <= GetGdiProcessHandleQuota
// GetGuiResources(GetCurrentProcess,GR_USEROBJECTS) <= GetUserProcessHandleQuota
// GetProcessHandleCount(GetCurrentProcess,Count)    <= GetKernelProcessHandleQuota
function GetGdiProcessHandleQuota:DWORD;
function GetUserProcessHandleQuota:DWORD;
function GetKernelProcessHandleQuota:DWORD;

 //////////////////////////////////////////////////////////////////////////////////////
 // Enumerate processes and threads. Callback on each process/thread running in system.
 // see https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497(v=vs.85).aspx
 //////////////////////////////////////////////////////////////////////////////////////
type
 TEnumModulesAction=function(const Entry:MODULEENTRY32; Custom:Pointer):Boolean;
 TEnumThreadsAction=function(const Entry:THREADENTRY32; Custom:Pointer):Boolean;
 TEnumProcessesAction=function(const Entry:PROCESSENTRY32; Custom:Pointer):Boolean;

function EnumModules(Action:TEnumModulesAction; Custom:Pointer; Pid:DWORD=0):Integer;
function EnumThreads(Action:TEnumThreadsAction; Custom:Pointer; Pid:DWORD=0):Integer;
function EnumProcesses(Action:TEnumProcessesAction; Custom:Pointer):Integer;
{$ENDIF ~WINDOWS}

  { Read list of modules of PID as List. }
function GetListOfModules(List:TStringList; Pid:DWORD=0):TStringList;

 { Read list of modules of PID as text. }
function GetListOfModulesAsText(Pid:DWORD=0):LongString;
function read_proc_pid_modules(pid:Integer):LongString;

 // Find information about parent process.
function FindParentProcessId:DWORD;
function FindParentProcessExe:LongString;
function FindParentProcessInfo(out pPid:DWORD; out pExe:LongString):Boolean;

{$IFDEF UNIX}
const // sysconf(..)
 _SC_ARG_MAX = 0;
 _SC_CHILD_MAX = 1;
 _SC_CLK_TCK = 2;
 _SC_NGROUPS_MAX = 3;
 _SC_OPEN_MAX = 4;
 _SC_STREAM_MAX = 5;
 _SC_TZNAME_MAX = 6;
 _SC_JOB_CONTROL = 7;
 _SC_SAVED_IDS = 8;
 _SC_REALTIME_SIGNALS = 9;
 _SC_PRIORITY_SCHEDULING = 10;
 _SC_TIMERS = 11;
 _SC_ASYNCHRONOUS_IO = 12;
 _SC_PRIORITIZED_IO = 13;
 _SC_SYNCHRONIZED_IO = 14;
 _SC_FSYNC = 15;
 _SC_MAPPED_FILES = 16;
 _SC_MEMLOCK = 17;
 _SC_MEMLOCK_RANGE = 18;
 _SC_MEMORY_PROTECTION = 19;
 _SC_MESSAGE_PASSING = 20;
 _SC_SEMAPHORES = 21;
 _SC_SHARED_MEMORY_OBJECTS = 22;
 _SC_AIO_LISTIO_MAX = 23;
 _SC_AIO_MAX = 24;
 _SC_AIO_PRIO_DELTA_MAX = 25;
 _SC_DELAYTIMER_MAX = 26;
 _SC_MQ_OPEN_MAX = 27;
 _SC_MQ_PRIO_MAX = 28;
 _SC_VERSION = 29;
 _SC_PAGESIZE = 30;
 _SC_RTSIG_MAX = 31;
 _SC_SEM_NSEMS_MAX = 32;
 _SC_SEM_VALUE_MAX = 33;
 _SC_SIGQUEUE_MAX = 34;
 _SC_TIMER_MAX = 35;
 _SC_BC_BASE_MAX = 36;
 _SC_BC_DIM_MAX = 37;
 _SC_BC_SCALE_MAX = 38;
 _SC_BC_STRING_MAX = 39;
 _SC_COLL_WEIGHTS_MAX = 40;
 _SC_EQUIV_CLASS_MAX = 41;
 _SC_EXPR_NEST_MAX = 42;
 _SC_LINE_MAX = 43;
 _SC_RE_DUP_MAX = 44;
 _SC_CHARCLASS_NAME_MAX = 45;
 _SC_2_VERSION = 46;
 _SC_2_C_BIND = 47;
 _SC_2_C_DEV = 48;
 _SC_2_FORT_DEV = 49;
 _SC_2_FORT_RUN = 50;
 _SC_2_SW_DEV = 51;
 _SC_2_LOCALEDEF = 52;
 _SC_PII = 53;
 _SC_PII_XTI = 54;
 _SC_PII_SOCKET = 55;
 _SC_PII_INTERNET = 56;
 _SC_PII_OSI = 57;
 _SC_POLL = 58;
 _SC_SELECT = 59;
 _SC_UIO_MAXIOV = 60;
 _SC_IOV_MAX = _SC_UIO_MAXIOV;
 _SC_PII_INTERNET_STREAM = (_SC_UIO_MAXIOV)+1;
 _SC_PII_INTERNET_DGRAM = (_SC_UIO_MAXIOV)+2;
 _SC_PII_OSI_COTS = (_SC_UIO_MAXIOV)+3;
 _SC_PII_OSI_CLTS = (_SC_UIO_MAXIOV)+4;
 _SC_PII_OSI_M = (_SC_UIO_MAXIOV)+5;
 _SC_T_IOV_MAX = (_SC_UIO_MAXIOV)+6;
 _SC_THREADS = (_SC_UIO_MAXIOV)+7;
 _SC_THREAD_SAFE_FUNCTIONS = (_SC_UIO_MAXIOV)+8;
 _SC_GETGR_R_SIZE_MAX = (_SC_UIO_MAXIOV)+9;
 _SC_GETPW_R_SIZE_MAX = (_SC_UIO_MAXIOV)+10;
 _SC_LOGIN_NAME_MAX = (_SC_UIO_MAXIOV)+11;
 _SC_TTY_NAME_MAX = (_SC_UIO_MAXIOV)+12;
 _SC_THREAD_DESTRUCTOR_ITERATIONS = (_SC_UIO_MAXIOV)+13;
 _SC_THREAD_KEYS_MAX = (_SC_UIO_MAXIOV)+14;
 _SC_THREAD_STACK_MIN = (_SC_UIO_MAXIOV)+15;
 _SC_THREAD_THREADS_MAX = (_SC_UIO_MAXIOV)+16;
 _SC_THREAD_ATTR_STACKADDR = (_SC_UIO_MAXIOV)+17;
 _SC_THREAD_ATTR_STACKSIZE = (_SC_UIO_MAXIOV)+18;
 _SC_THREAD_PRIORITY_SCHEDULING = (_SC_UIO_MAXIOV)+19;
 _SC_THREAD_PRIO_INHERIT = (_SC_UIO_MAXIOV)+20;
 _SC_THREAD_PRIO_PROTECT = (_SC_UIO_MAXIOV)+21;
 _SC_THREAD_PROCESS_SHARED = (_SC_UIO_MAXIOV)+22;
 _SC_NPROCESSORS_CONF = (_SC_UIO_MAXIOV)+23;
 _SC_NPROCESSORS_ONLN = (_SC_UIO_MAXIOV)+24;
 _SC_PHYS_PAGES = (_SC_UIO_MAXIOV)+25;
 _SC_AVPHYS_PAGES = (_SC_UIO_MAXIOV)+26;
 _SC_ATEXIT_MAX = (_SC_UIO_MAXIOV)+27;
 _SC_PASS_MAX = (_SC_UIO_MAXIOV)+28;
 _SC_XOPEN_VERSION = (_SC_UIO_MAXIOV)+29;
 _SC_XOPEN_XCU_VERSION = (_SC_UIO_MAXIOV)+30;
 _SC_XOPEN_UNIX = (_SC_UIO_MAXIOV)+31;
 _SC_XOPEN_CRYPT = (_SC_UIO_MAXIOV)+32;
 _SC_XOPEN_ENH_I18N = (_SC_UIO_MAXIOV)+33;
 _SC_XOPEN_SHM = (_SC_UIO_MAXIOV)+34;
 _SC_2_CHAR_TERM = (_SC_UIO_MAXIOV)+35;
 _SC_2_C_VERSION = (_SC_UIO_MAXIOV)+36;
 _SC_2_UPE = (_SC_UIO_MAXIOV)+37;
 _SC_XOPEN_XPG2 = (_SC_UIO_MAXIOV)+38;
 _SC_XOPEN_XPG3 = (_SC_UIO_MAXIOV)+39;
 _SC_XOPEN_XPG4 = (_SC_UIO_MAXIOV)+40;
 _SC_CHAR_BIT = (_SC_UIO_MAXIOV)+41;
 _SC_CHAR_MAX = (_SC_UIO_MAXIOV)+42;
 _SC_CHAR_MIN = (_SC_UIO_MAXIOV)+43;
 _SC_INT_MAX = (_SC_UIO_MAXIOV)+44;
 _SC_INT_MIN = (_SC_UIO_MAXIOV)+45;
 _SC_LONG_BIT = (_SC_UIO_MAXIOV)+46;
 _SC_WORD_BIT = (_SC_UIO_MAXIOV)+47;
 _SC_MB_LEN_MAX = (_SC_UIO_MAXIOV)+48;
 _SC_NZERO = (_SC_UIO_MAXIOV)+49;
 _SC_SSIZE_MAX = (_SC_UIO_MAXIOV)+50;
 _SC_SCHAR_MAX = (_SC_UIO_MAXIOV)+51;
 _SC_SCHAR_MIN = (_SC_UIO_MAXIOV)+52;
 _SC_SHRT_MAX = (_SC_UIO_MAXIOV)+53;
 _SC_SHRT_MIN = (_SC_UIO_MAXIOV)+54;
 _SC_UCHAR_MAX = (_SC_UIO_MAXIOV)+55;
 _SC_UINT_MAX = (_SC_UIO_MAXIOV)+56;
 _SC_ULONG_MAX = (_SC_UIO_MAXIOV)+57;
 _SC_USHRT_MAX = (_SC_UIO_MAXIOV)+58;
 _SC_NL_ARGMAX = (_SC_UIO_MAXIOV)+59;
 _SC_NL_LANGMAX = (_SC_UIO_MAXIOV)+60;
 _SC_NL_MSGMAX = (_SC_UIO_MAXIOV)+61;
 _SC_NL_NMAX = (_SC_UIO_MAXIOV)+62;
 _SC_NL_SETMAX = (_SC_UIO_MAXIOV)+63;
 _SC_NL_TEXTMAX = (_SC_UIO_MAXIOV)+64;
 _SC_XBS5_ILP32_OFF32 = (_SC_UIO_MAXIOV)+65;
 _SC_XBS5_ILP32_OFFBIG = (_SC_UIO_MAXIOV)+66;
 _SC_XBS5_LP64_OFF64 = (_SC_UIO_MAXIOV)+67;
 _SC_XBS5_LPBIG_OFFBIG = (_SC_UIO_MAXIOV)+68;
 _SC_XOPEN_LEGACY = (_SC_UIO_MAXIOV)+69;
 _SC_XOPEN_REALTIME = (_SC_UIO_MAXIOV)+70;
 _SC_XOPEN_REALTIME_THREADS = (_SC_UIO_MAXIOV)+71;
 _SC_ADVISORY_INFO = (_SC_UIO_MAXIOV)+72;
 _SC_BARRIERS = (_SC_UIO_MAXIOV)+73;
 _SC_BASE = (_SC_UIO_MAXIOV)+74;
 _SC_C_LANG_SUPPORT = (_SC_UIO_MAXIOV)+75;
 _SC_C_LANG_SUPPORT_R = (_SC_UIO_MAXIOV)+76;
 _SC_CLOCK_SELECTION = (_SC_UIO_MAXIOV)+77;
 _SC_CPUTIME = (_SC_UIO_MAXIOV)+78;
 _SC_THREAD_CPUTIME = (_SC_UIO_MAXIOV)+79;
 _SC_DEVICE_IO = (_SC_UIO_MAXIOV)+80;
 _SC_DEVICE_SPECIFIC = (_SC_UIO_MAXIOV)+81;
 _SC_DEVICE_SPECIFIC_R = (_SC_UIO_MAXIOV)+82;
 _SC_FD_MGMT = (_SC_UIO_MAXIOV)+83;
 _SC_FIFO = (_SC_UIO_MAXIOV)+84;
 _SC_PIPE = (_SC_UIO_MAXIOV)+85;
 _SC_FILE_ATTRIBUTES = (_SC_UIO_MAXIOV)+86;
 _SC_FILE_LOCKING = (_SC_UIO_MAXIOV)+87;
 _SC_FILE_SYSTEM = (_SC_UIO_MAXIOV)+88;
 _SC_MONOTONIC_CLOCK = (_SC_UIO_MAXIOV)+89;
 _SC_MULTI_PROCESS = (_SC_UIO_MAXIOV)+90;
 _SC_SINGLE_PROCESS = (_SC_UIO_MAXIOV)+91;
 _SC_NETWORKING = (_SC_UIO_MAXIOV)+92;
 _SC_READER_WRITER_LOCKS = (_SC_UIO_MAXIOV)+93;
 _SC_SPIN_LOCKS = (_SC_UIO_MAXIOV)+94;
 _SC_REGEXP = (_SC_UIO_MAXIOV)+95;
 _SC_REGEX_VERSION = (_SC_UIO_MAXIOV)+96;
 _SC_SHELL = (_SC_UIO_MAXIOV)+97;
 _SC_SIGNALS = (_SC_UIO_MAXIOV)+98;
 _SC_SPAWN = (_SC_UIO_MAXIOV)+99;
 _SC_SPORADIC_SERVER = (_SC_UIO_MAXIOV)+100;
 _SC_THREAD_SPORADIC_SERVER = (_SC_UIO_MAXIOV)+101;
 _SC_SYSTEM_DATABASE = (_SC_UIO_MAXIOV)+102;
 _SC_SYSTEM_DATABASE_R = (_SC_UIO_MAXIOV)+103;
 _SC_TIMEOUTS = (_SC_UIO_MAXIOV)+104;
 _SC_TYPED_MEMORY_OBJECTS = (_SC_UIO_MAXIOV)+105;
 _SC_USER_GROUPS = (_SC_UIO_MAXIOV)+106;
 _SC_USER_GROUPS_R = (_SC_UIO_MAXIOV)+107;
 _SC_2_PBS = (_SC_UIO_MAXIOV)+108;
 _SC_2_PBS_ACCOUNTING = (_SC_UIO_MAXIOV)+109;
 _SC_2_PBS_LOCATE = (_SC_UIO_MAXIOV)+110;
 _SC_2_PBS_MESSAGE = (_SC_UIO_MAXIOV)+111;
 _SC_2_PBS_TRACK = (_SC_UIO_MAXIOV)+112;
 _SC_SYMLOOP_MAX = (_SC_UIO_MAXIOV)+113;
 _SC_STREAMS = (_SC_UIO_MAXIOV)+114;
 _SC_2_PBS_CHECKPOINT = (_SC_UIO_MAXIOV)+115;
 _SC_V6_ILP32_OFF32 = (_SC_UIO_MAXIOV)+116;
 _SC_V6_ILP32_OFFBIG = (_SC_UIO_MAXIOV)+117;
 _SC_V6_LP64_OFF64 = (_SC_UIO_MAXIOV)+118;
 _SC_V6_LPBIG_OFFBIG = (_SC_UIO_MAXIOV)+119;
 _SC_HOST_NAME_MAX = (_SC_UIO_MAXIOV)+120;
 _SC_TRACE = (_SC_UIO_MAXIOV)+121;
 _SC_TRACE_EVENT_FILTER = (_SC_UIO_MAXIOV)+122;
 _SC_TRACE_INHERIT = (_SC_UIO_MAXIOV)+123;
 _SC_TRACE_LOG = (_SC_UIO_MAXIOV)+124;

 { System configuration. }
function sysconf(id:longint):longint;cdecl;external 'c' name 'sysconf';

 { System Clock Ticks per second. }
function SysClockTicksPerSec:Integer;

{$ENDIF ~UNIX}

 { Get system boot time in UnixTime units. }
function GetSystemBootTimeAsUnixTime:Int64;

 { Get process start time in FileTime units. }
function GetProcessStartTimeAsFileTime:Int64;

 {
 Get number of threads (Cur) by ProcessID (Pid).
 Return total number of threads over all processes in system.
 }
function GetNumberOfThreadsByPid(Pid:TPid; var Cur:Integer; Total:Boolean):Integer;

implementation

procedure AddInfoItem(var info:LongString; s:LongString; prefix:LongString=' ');
begin
 if IsEmptyStr(s) then Exit;
 if SameText(Trim(s),'To be filled by O.E.M.') then s:='UNKNOWN';
 if (info='') and (WordCount(prefix,ScanSpaces)=0)
 then info:=Trim(s) else info:=info+prefix+Trim(s);
end;

{$IF DEFINED(WINDOWS)}
function GetSystemVersionString:LongString;
var info:LongString;
begin
 info:='';
 AddInfoItem(info,ReadRegistryString(HKEY_LOCAL_MACHINE,'HARDWARE\DESCRIPTION\System','Identifier'));
 AddInfoItem(info,GetEnv('OS'),', ');
 AddInfoItem(info,GetEnv('PROCESSOR_ARCHITECTURE'),', ');
 Result:=Trim(info);
end;
{$ELSEIF DEFINED (UNIX)}
function GetSystemVersionString:LongString;
var info:LongString; s:LongString;
begin
 info:='';
 if RunCommand('lsb_release -ds',s) then AddInfoItem(info,s) else
 if RunCommand('uname -snrmo',s) then AddInfoItem(info,s);
 if RunCommand('uname -m',s) then AddInfoItem(info,s);
 Result:=Trim(info);
end;
{$ENDIF}

{$IF DEFINED(WINDOWS)}
function GetOSVersionString:LongString;
var s:String;
begin
 case Win32Platform of
  VER_PLATFORM_WIN32s        : s:='3x';
  VER_PLATFORM_WIN32_WINDOWS : s:='9x';
  VER_PLATFORM_WIN32_NT      : s:='NT';
  else                         s:='??';
 end;
 Result:=Format('WIN-%s %d.%d.%d - %s',
     [s,Win32MajorVersion,Win32MinorVersion,Win32BuildNumber,
      GetWinNtVersionInfo('ProductName')]);
end;
{$ELSEIF DEFINED (UNIX)}
function GetOSVersionString:LongString;
var s:LongString;
begin
 Result:='';
 if RunCommand('uname -a',s) then Result:=Trim(s);
end;
{$ENDIF}

function FetchParam(buff,id:LongString; Delims:TCharSet=JustSpaces):LongString;
var i:Integer;
begin
 Result:='';
 i:=WordIndex(id,buff,Delims);
 if (i>0) then Result:=ExtractWord(i+1,buff,Delims);
end;

{$IF DEFINED(WINDOWS)}
function GetCpuVersionInfo(n:Integer; const id:LongString; const alter:LongString=''):LongString;
begin
 if (Length(id)=1) and (Pos(id,'?*.')>0) then Exit(CpuVersionInfoList);
 if SameText(id,'Architecture') then Exit(GetEnv('PROCESSOR_ARCHITECTURE'));
 if SameText(id,'Family')   then Exit(FetchParam(GetEnv('PROCESSOR_IDENTIFIER'),id));
 if SameText(id,'Model')    then Exit(FetchParam(GetEnv('PROCESSOR_IDENTIFIER'),id));
 if SameText(id,'Stepping') then Exit(FetchParam(GetEnv('PROCESSOR_IDENTIFIER'),id));
 Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,'HARDWARE\DESCRIPTION\System\CentralProcessor\'+IntToStr(n),id);
 if (Result<>'') and SameText(id,'~MHz') then Result:=IntToStr(Dump2I(Result));
 if (Result='') then Result:=alter;
end;
{$ELSEIF DEFINED (UNIX)}
function GetCpuVersionInfo(n:Integer; const id:LongString; const alter:LongString=''):LongString;
var s:LongString;
begin
 Result:='';
 if (Length(id)=1) and (Pos(id,'?*.')>0) then Exit(CpuVersionInfoList);
 case WordIndex(id,CpuVersionInfoList,ScanSpaces) of
  1: Result:=IntToStr(Round(ReadNominalCpuFrequencyMhz(n)));
  2: Result:=Trim(ReadProcCpuInfo(GetBitMask(n),'model name'));
  3: Result:=Trim(ReadProcCpuInfo(GetBitMask(n),'vendor_id'));
  4: if RunCommand('uname -m',s) then begin
      Result:=Trim(s);
      s:=Trim(ReadProcCpuInfo(GetBitMask(n),'cpu family'));
      if (s<>'') then Result:=Result+' Family '+s;
      s:=Trim(ReadProcCpuInfo(GetBitMask(n),'model'));
      if (s<>'') then Result:=Result+' Model '+s;
      s:=Trim(ReadProcCpuInfo(GetBitMask(n),'stepping'));
      if (s<>'') then Result:=Result+' Stepping '+s;
     end;
  5: if RunCommand('uname -m',s) then Result:=Trim(s);
  6: Result:=Trim(ReadProcCpuInfo(GetBitMask(n),'cpu family'));
  7: Result:=Trim(ReadProcCpuInfo(GetBitMask(n),'model'));
  8: Result:=Trim(ReadProcCpuInfo(GetBitMask(n),'stepping'));
 end;
end;
{$ENDIF}

function GetCpuFreqMHzNominal(n:Integer=0):Integer;
begin
 Result:=StrToIntDef(GetCpuVersionInfo(n,'~MHz'),0);
end;

{$IFDEF WINDOWS}
type
 DWORDLONG = QWord;
 TMemoryStatusEx = record
  dwLength: DWord;
  dwMemoryLoad: DWord;
  ullTotalPhys: DWORDLONG;
  ullAvailPhys: DWORDLONG;
  ullTotalPageFile: DWORDLONG;
  ullAvailPageFile: DWORDLONG;
  ullTotalVirtual: DWORDLONG;
  ullAvailVirtual: DWORDLONG;
  ullAvailExtendedVirtual: DWORDLONG;
 end;
// information about the system's current usage of both physical and virtual memory
function GlobalMemoryStatusEx(var lpBuffer:TMemoryStatusEx):BOOL; stdcall; external kernel32;
function ReadGlobalMemInfo:LongString;
var ms:TMemoryStatusEx;
begin
 Result:='';
 SafeFillChar(ms,SizeOf(ms),0);
 ms.dwLength:=SizeOf(ms);
 if not GlobalMemoryStatusEx(ms) then Exit;
 Result:='MemTotal='+IntToStr(ms.ullTotalPhys)+EOL
        +'MemFree=0'+EOL
        +'MemAvailable='+IntToStr(ms.ullAvailPhys)+EOL
        +'SwapTotal='+IntToStr(ms.ullTotalPageFile)+EOL
        +'SwapFree='+IntToStr(ms.ullAvailPageFile)+EOL;
end;
{$ENDIF ~WINDOWS}

function ReadProcMemInfo(id:LongString):QWord;
var buff:LongString; qt,qf,qa,qr:QWord;
 function GetMemInfo(buff,id:LongString):QWord;
 var line,w1,w2:LongString; qr:QWord;
 begin
  Result:=0;
  if (buff='') then Exit;
  line:=CookieScan(buff,id);
  w1:=ExtractWord(1,line,ScanSpaces);
  w2:=ExtractWord(2,line,ScanSpaces);
  if TryStrToQWord(w1,qr) then begin
   if SameText(w2,'kB') then qr:=qr*KiloByte else
   if SameText(w2,'MB') then qr:=qr*MegaByte else
   if SameText(w2,'GB') then qr:=qr*GigaByte;
   Exit(qr);
  end;
 end;
begin
 Result:=0; buff:='';
 id:=Trim(id); if (id='') then Exit;
 {$IFDEF UNIX}
 buff:=Trim(StringFromFile('/proc/meminfo',0));
 buff:=StringReplace(buff,':','=',[rfReplaceAll]);
 {$ENDIF ~UNIX}
 {$IFDEF WINDOWS}
 buff:=ReadGlobalMemInfo;
 {$ENDIF ~WINDOWS}
 if (buff='') then Exit;
 if SameText(id,'MemUsed') then begin
  qt:=GetMemInfo(buff,'MemTotal');
  qf:=GetMemInfo(buff,'MemFree');
  qa:=GetMemInfo(buff,'MemAvailable');
  if (qt>0) then qr:=(qt-(qf+qa)) else qr:=0;
  Exit(qr);
 end else
 if SameText(id,'MemLoad') then begin
  qt:=GetMemInfo(buff,'MemTotal');
  qf:=GetMemInfo(buff,'MemFree');
  qa:=GetMemInfo(buff,'MemAvailable');
  if (qt>0) then qr:=(((qt-(qf+qa))*100) div qt) else qr:=0;
  Exit(qr);
 end else
 if SameText(id,'SwapUsed') then begin
  qt:=GetMemInfo(buff,'SwapTotal');
  qf:=GetMemInfo(buff,'SwapFree');
  if (qt>0) then qr:=(qt-qf) else qr:=0;
  Exit(qr);
 end else
 if SameText(id,'SwapLoad') then begin
  qt:=GetMemInfo(buff,'SwapTotal');
  qf:=GetMemInfo(buff,'SwapFree');
  if (qt>0) then qr:=(((qt-qf)*100) div qt) else qr:=0;
  Exit(qr);
 end;
 Result:=GetMemInfo(buff,id);
end;

{$IFDEF UNIX}
function ReadSysDevicesVirtualDmiId(name:LongString):LongString;
const dmidir='/sys/devices/virtual/dmi/id/';
var i:Integer; s,w:LongString;
begin
if (Length(name)=1) and (Pos(StrFetch(name,1),'?*.')>0) then begin
  if (VirtualDmiIdNameList='') then begin
   if RunCommand('find '+dmidir+' -type f',s) then
   for i:=1 to WordCount(s,ScanSpaces) do begin
    w:=ExtractWord(i,s,ScanSpaces);
    if not FileIsReadable(w) then continue;
    VirtualDmiIdNameList:=VirtualDmiIdNameList+' '+ExtractFileName(w);
   end;
   VirtualDmiIdNameList:=Trim(VirtualDmiIdNameList);
   VirtualDmiIdNameList:=StringReplace(VirtualDmiIdNameList,' ',',',[rfReplaceAll]);
  end;
  Result:=VirtualDmiIdNameList;
  Exit;
 end;
 if (name<>'')
 then Result:=Trim(StringFromFile(dmidir+name,0))
 else Result:='';
end;
{$ENDIF ~UNIX}

{$IFDEF WINDOWS}
function GetWinNtVersionInfo(const id:LongString; const alter:LongString=''):LongString;
begin
 Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion',id);
 if Length(Result)=0 then Result:=alter;
end;
function GetCurrCtrlSetSysInfo(const id:LongString; const alter:LongString=''):LongString;
begin
 Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,'SYSTEM\CurrentControlSet\Control\SystemInformation',id);
 if Length(Result)=0 then Result:=alter;
end;
{$ENDIF ~WINDOWS}

function GetSystemBiosInfo:LongString;
var info:LongString;
begin
 info:='';
 {$IFDEF WINDOWS}
 AddInfoItem(info,Trim(ExtractWord(1,ReadRegistryMultiStrings(HKEY_LOCAL_MACHINE,'HARDWARE\DESCRIPTION\System','SystemBiosVersion'),[ASCII_CR,ASCII_LF])));
 AddInfoItem(info,Trim(ReadRegistryString(HKEY_LOCAL_MACHINE,'HARDWARE\DESCRIPTION\System','SystemBiosDate')));
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 AddInfoItem(info,ReadSysDevicesVirtualDmiId('bios_version'));
 AddInfoItem(info,ReadSysDevicesVirtualDmiId('bios_release'));
 AddInfoItem(info,ReadSysDevicesVirtualDmiId('bios_date'));
 AddInfoItem(info,ReadSysDevicesVirtualDmiId('bios_vendor'));
 {$ENDIF ~UNIX}
 Result:=Trim(info);
end;

function GetSystemModelInfo:LongString;
var info:LongString;
begin
 info:='';
 {$IFDEF WINDOWS}
 AddInfoItem(info,GetCurrCtrlSetSysInfo('SystemManufacturer'),', ');
 AddInfoItem(info,GetCurrCtrlSetSysInfo('BIOSVersion'),' BIOS ');
 AddInfoItem(info,GetCurrCtrlSetSysInfo('BIOSReleaseDate'),', ');
 AddInfoItem(info,GetCurrCtrlSetSysInfo('SystemProductName'),', ');
 AddInfoItem(info,GetCurrCtrlSetSysInfo('ComputerHardwareId'),', ');
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 AddInfoItem(info,ReadSysDevicesVirtualDmiId('product_name'));
 {$ENDIF ~UNIX}
 Result:=Trim(info);
end;

function GetVideoBiosInfo:LongString;
var info:LongString;
begin
 info:='';
 {$IFDEF WINDOWS}
 AddInfoItem(info,ExtractWord(1,ReadRegistryMultiStrings(HKEY_LOCAL_MACHINE,'HARDWARE\DESCRIPTION\System','VideoBiosVersion'),[ASCII_CR,ASCII_LF]),', ');
 {$ENDIF ~WINDOWS}
 {$IFDEF UNIX}
 {$ENDIF ~UNIX}
 Result:=Trim(info);
end;

{$IFDEF WINDOWS}
function GetProcessHandleCountStub(hProcess:THandle; var HandleCount:DWORD):BOOL stdcall;
begin
 Result:=False;
 if Assigned(@HandleCount) then HandleCount:=0;
 Windows.SetLastError(ERROR_CALL_NOT_IMPLEMENTED);
end;
function GetProcessHandleCount(hProcess:THandle; var HandleCount:DWORD):BOOL stdcall;
const GetProcessHandleCountProc:function(hProcess:THandle; var HandleCount:DWORD):BOOL stdcall = nil;
var hModule:THandle;
begin
 if not Assigned(GetProcessHandleCountProc) then begin
  hModule:=GetModuleHandle('kernel32.dll');
  if hModule<>0 then @GetProcessHandleCountProc:=GetProcAddress(hModule,'GetProcessHandleCount');
  if not Assigned(GetProcessHandleCountProc) then GetProcessHandleCountProc:=GetProcessHandleCountStub;
 end;
 if Assigned(GetProcessHandleCountProc)
 then Result:=GetProcessHandleCountProc(hProcess,HandleCount)
 else Result:=GetProcessHandleCountStub(hProcess,HandleCount);
end;

function ReadIntRegKey(RootKey:HKEY; const Key,Name:LongString):DWORD;
var Reg:TRegistry;
begin
 Result:=0;
 try
  Reg:=TRegistry.Create;
  try
   Reg.RootKey:=RootKey;
   if Reg.KeyExists(Key) then begin
    Reg.OpenKeyReadOnly(Key);
    if Reg.ValueExists(Name) then
    case Reg.GetDataType(Name) of
     rdString       : Result:=StrToIntDef(Reg.ReadString(Name),0);
     rdExpandString : Result:=StrToIntDef(Reg.ReadString(Name),0);
     rdInteger      : Result:=Reg.ReadInteger(Name);
    end;
   end;
  finally
   Reg.Destroy;
  end;
 except
  on E:Exception do BugReport(E,nil,'ReadIntRegKey');
 end;
end;
function GetGdiProcessHandleQuota:DWORD;
begin
 Result:=ReadIntRegKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows','GDIProcessHandleQuota');
end;
function GetUserProcessHandleQuota:DWORD;
begin
 Result:=ReadIntRegKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows','USERProcessHandleQuota');
end;
function GetKernelProcessHandleQuota:DWORD;
begin
 Result:=1 shl 24;
end;

function EnumThreads(Action:TEnumThreadsAction; Custom:Pointer; Pid:DWORD=0):Integer;
var hThreadSnap:THandle; te32:THREADENTRY32;
begin
 Result:=0;
 try
  hThreadSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD,0);
  if(hThreadSnap<>0) and (hThreadSnap<>INVALID_HANDLE_VALUE) then
  try
   ZeroMemory(@te32,sizeof(te32));
   te32.dwSize:=sizeof(te32);
   if Thread32First(hThreadSnap,te32) then
   repeat
    if (Pid=0) or (Pid=te32.th32OwnerProcessID) then begin
     inc(Result);
     if Assigned(Action) then
     if not Action(te32,Custom) then break;
    end;
   until not Thread32Next(hThreadSnap,te32);
  finally
   CloseHandle(hThreadSnap);
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumThreads');
 end;
end;

function EnumProcesses(Action:TEnumProcessesAction; Custom:Pointer):Integer;
var hProcessSnap:THandle; pe32:PROCESSENTRY32;
begin
 Result:=0;
 try
  hProcessSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
  if(hProcessSnap<>0) and (hProcessSnap<>INVALID_HANDLE_VALUE) then
  try
   ZeroMemory(@pe32,sizeof(pe32));
   pe32.dwSize:=sizeof(pe32);
   if Process32First(hProcessSnap,pe32) then
   repeat
    inc(Result);
    if Assigned(Action) then
    if not Action(pe32,Custom) then break;
   until not Process32Next(hProcessSnap,pe32);
  finally
   CloseHandle(hProcessSnap);
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumProcesses');
 end;
end;

function EnumModules(Action:TEnumModulesAction; Custom:Pointer; Pid:DWORD=0):Integer;
var hModuleSnap:THandle; me32:MODULEENTRY32;
begin
 Result:=0;
 try
  hModuleSnap:=CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,Pid);
  if(hModuleSnap<>0) and (hModuleSnap<>INVALID_HANDLE_VALUE) then
  try
   ZeroMemory(@me32,sizeof(me32));
   me32.dwSize:=sizeof(me32);
   if Module32First(hModuleSnap,me32) then
   repeat
    if (Pid=0) or (Pid=me32.th32ProcessID) then begin
     inc(Result);
     if Assigned(Action) then
     if not Action(me32,Custom) then break;
    end;
   until not Module32Next(hModuleSnap,me32);
  finally
   CloseHandle(hModuleSnap);
  end;
 except
  on E:Exception do BugReport(E,nil,'EnumModules');
 end;
end;

function IterateModules(const Entry:MODULEENTRY32; Custom:Pointer):Boolean;
begin
 Result:=true;
 if Assigned(Custom) then
 TStringList(Custom).Add(Entry.szExePath);
end;

function GetListOfModules(List:TStringList; Pid:DWORD=0):TStringList;
begin
 Result:=List;
 if Assigned(List) then
 try
  EnumModules(IterateModules,List,Pid);
 except
  on E:Exception do BugReport(E,nil,'GetListOfModules');
 end;
end;

function GetListOfModulesAsText(Pid:DWORD=0):LongString;
var List:TStringList;
begin
 Result:='';
 try
  List:=GetListOfModules(TStringList.Create,Pid);
  try
   Result:=List.Text;
  finally
   Kill(List);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetListOfModulesAsText');
 end;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function GetListOfModules(List:TStringList; Pid:DWORD=0):TStringList;
begin
 Result:=List;
 if Assigned(List) then
 try
  List.Text:=GetListOfModulesAsText(Pid);
 except
  on E:Exception do BugReport(E,nil,'GetListOfModules');
 end;
end;
function GetListOfModulesAsText(Pid:DWORD=0):LongString;
begin
 Result:=read_proc_pid_modules(pid);
end;
{$ENDIF ~UNIX}

function read_proc_pid_modules(pid:Integer):LongString;
var list,temp:TStringList; i:Integer; s:LongString;
const delims=[ASCII_CR,ASCII_LF,' ',ASCII_TAB,#0];
begin
 Result:='';
 try
  if IsWindows then begin
   Result:=GetListOfModulesAsText(pid);
  end else
  if IsUnix then begin
   list:=TStringList.Create;
   temp:=TStringList.Create;
   try
    temp.Text:=read_proc_pid_file(pid,'maps');
    for i:=0 to temp.Count-1 do begin
     s:=Trim(SkipWords(5,temp.Strings[i],delims));
     if (StrFetch(s,1)<>'/') then continue;
     if (list.IndexOf(s)>=0) then continue;
     if not FileExists(s) then continue;
     list.Add(s);
    end;
    Result:=list.Text;
   finally
    list.Free;
    temp.Free;
   end;
  end;
 except
  on E:Exception do BugReport(E,nil,'read_proc_pid_modules');
 end;
end;


{$IFDEF UNIX}
function SysClockTicksPerSec:LongInt;
begin
 Result:=sysconf(_SC_CLK_TCK);
end;

function GetSystemBootTimeAsUnixTime:Int64;
var s:LongString; p:Integer; t:Int64;
begin
 Result:=0;
 try
  s:=Trim(StringFromFile('/proc/stat',0));
  p:=Pos(EOL+'btime ',s);
  if (p>0) then s:=Copy(s,p,Length(s)) else Exit;
  s:=ExtractWord(2,s,JustSpaces); if (s='') then Exit;
  if TryStrToInt64(s,t) then Result:=t;
 except
  on E:Exception do BugReport(E,nil,'GetSystemBootTimeAsUnixTime');
 end;
end;

function GetProcessStartTimeAsFileTime:Int64;
var s:LongString; t,scale:Int64; ut,ms,ft:Double;
begin
 Result:=0;
 try
  s:=Trim(StringFromFile('/proc/self/stat',0));
  if TryStrToInt64(ExtractWord(22,s,JustSpaces),t) then begin
   scale:=SysClockTicksPerSec;
   ut:=GetSystemBootTimeAsUnixTime+t/scale;
   ms:=UnixTimeToMs(ut);
   ft:=MsToFileTime(ms);
   Result:=Round(ft);
  end;
 except
  on E:Exception do BugReport(E,nil,'GetProcessStartTimeAsFileTime');
 end;
end;
{$ENDIF ~UNIX}

{$IFDEF WINDOWS}
function GetSystemBootTimeAsUnixTime:Int64;
begin
 Result:=Round(MsToUnixTime(mSecNow-GetTickCount64));
end;

function GetProcessStartTimeAsFileTime:Int64;
var ct,et,kt,ut:TFileTime;
begin
 Result:=0; Int64(ct):=0; Int64(et):=0; Int64(kt):=0; Int64(ut):=0;
 if GetProcessTimes(GetCurrentProcess,ct,et,kt,ut) then Result:=Int64(ct);
end;
{$ENDIF ~WINDOWS}

function FindParentProcessId:DWORD;
begin
 Result:=GetParentProcessId;
end;

function FindParentProcessExe:LongString;
begin
 Result:=GetParentProcessName;
end;

function FindParentProcessInfo(out pPid:DWORD; out pExe:LongString):Boolean;
begin
 pPid:=GetParentProcessId;
 pExe:=GetParentProcessName;
 Result:=(pPid<>0) and (pExe<>'');
end;

type
 TGetNumThreadsRec = record
  Pid:TPid;
  Cur:Integer;
  Tot:Integer;
 end;

{$IFDEF WINDOWS}
function GetNumThreadsAction(const Entry:THREADENTRY32; Custom:Pointer):Boolean;
begin
 Result:=true;
 if Assigned(Custom) then
 with TGetNumThreadsRec(Custom^) do begin
  if (TPid(Entry.th32OwnerProcessID)=Pid) then Inc(Cur);
  Inc(Tot);
 end;
end;

function GetNumberOfThreadsByPid(Pid:TPid; var Cur:Integer; Total:Boolean):Integer;
var R:TGetNumThreadsRec;
begin
 R.Pid:=Pid; R.Cur:=0; R.Tot:=0;
 EnumThreads(GetNumThreadsAction,@R);
 Cur:=R.Cur; Result:=R.Tot;
end;
{$ENDIF ~WINDOWS}

{$IFDEF UNIX}
function GetNumThreadsAction(n:SizeInt;Line:LongString;Custom:Pointer):Boolean;
var aPid,nThreads:Integer; sThreads:LongString;
begin
 Result:=true;
 if Assigned(Custom) then with TGetNumThreadsRec(Custom^) do
 if Str2Int(ExtractWord(1,Line,ScanSpaces),aPid) and (aPid>0) then begin
  sThreads:=read_proc_pid_file(aPid,'status','Threads');
  if Str2Int(CookieScan(sThreads,'Threads'),nThreads) then begin
   if (nThreads>0) and (Pid=aPid) then Inc(Cur,nThreads);
   if (nThreads>0) then Inc(Tot,nThreads);
  end;
 end;
end;

function GetNumberOfThreadsByPid(Pid:TPid; var Cur:Integer; Total:Boolean):Integer;
var R:TGetNumThreadsRec; Buff:LongString;
begin
 R.Pid:=Pid; R.Cur:=0; R.Tot:=0;
 Buff:=GetListOfProcesses(IfThen(Total,0,Pid),0,'');
 ForEachStringLine(Buff,GetNumThreadsAction,@R);
 Cur:=R.Cur; Result:=R.Tot;
end;
{$ENDIF ~UNIX}

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

procedure Init_crw_sysid;
begin
end;

procedure Free_crw_sysid;
begin
end;

initialization

 Init_crw_sysid;

finalization

 Free_crw_sysid;

end.

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

