unit ASPropStores;

{ **************************************************************************** }
{ Rejbrand AlgoSim Property Stores                                             }
{ Copyright © 2018 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Types, Classes, ASNum, ASTree, ASKernelDefs, ASObjects, ASObjStore,
  ASStructs, ASExpression, Generics.Defaults, Generics.Collections, ASPropMan;

type
  TGlobalPropStore = class(TPropertyStore)
  public
    constructor Create; override;
  end;

  TWindowsPropStore = class(TMultiProcPropertyStore)
  strict private
    class function GetUserName: TAlgosimObject; static;
    class function GetComputerName: TAlgosimObject; static;
    class function GetWindowsVersion: TAlgosimObject; static;
    class function GetMemoryStatus: TAlgosimObject; static;
    class function GetCursorPos: TAlgosimObject; static;
    class function GetFonts: TAlgosimObject; static;
  public
    constructor Create; override;
  end;

  TWindowsKeyboardPropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

  TWindowsSysColorsPropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

  TWindowsSysMetricsPropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

  TMonitorPropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

  TRegistryPropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

  TEnvironmentVariablePropStore = class(TSingleProcPropertyStore)
  strict protected
    function LocalGetValue(const AKey: string): TAlgosimObject; override;
  public
    constructor Create; override;
  end;

implementation

uses
  Windows, Messages, Graphics, Forms, Controls, ShellAPI, ShlObj, Math,
  StrUtils, System.Win.Registry, Clipbrd;

{ TWindowsPropStore }

constructor TWindowsPropStore.Create;
begin
  inherited;

  FName := 'os';

  AddValue('UserName', GetUserName);
  AddValue('ComputerName', GetComputerName);
  AddValue('WindowsVersion', GetWindowsVersion);
  AddValue('MemoryStatus', GetMemoryStatus);
  AddValue('CPUCount', function: TAlgosimObject
    begin
      Result := ASOInt(CPUCount)
    end);
  AddValue('DesktopWindow', function: TAlgosimObject
    begin
      Result := ASOInt(Windows.GetDesktopWindow, 16)
    end);
  AddValue('LastError', function: TAlgosimObject
    begin
      Result := ASOInt(Windows.GetLastError)
    end);
  AddValue('focus', function: TAlgosimObject
    begin
      Result := ASOInt(Windows.GetFocus, 16)
    end);
  AddValue('ForegroundWindow', function: TAlgosimObject
    begin
      Result := ASOInt(Windows.GetForegroundWindow, 16)
    end);
  AddValue('ActiveWindow', function: TAlgosimObject
    begin
      Result := ASOInt(Windows.GetActiveWindow, 16)
    end);
  AddValue('CursorPos', GetCursorPos);
  AddValue('MonitorCount', function: TAlgosimObject
    begin
      Result := ASOInt(Screen.MonitorCount);
    end);
  AddValue('fonts', GetFonts);
  AddValue('clipboard', function: TAlgosimObject
    begin
      Result := ASO(Clipboard.AsText);
    end);

  AddSubstore(TWindowsSysColorsPropStore.Create);
  AddSubstore(TWindowsSysMetricsPropStore.Create);
  AddSubstore(TWindowsKeyboardPropStore.Create);
  AddSubstore(TMonitorPropStore.Create);
  AddSubstore(TRegistryPropStore.Create);
  AddSubstore(TEnvironmentVariablePropStore.Create);

end;

class function TWindowsPropStore.GetComputerName: TAlgosimObject;
var
  buf: string;
  len: Cardinal;
begin
  SetLength(buf, MAX_COMPUTERNAME_LENGTH + 1);
  len := buf.Length;
  if Windows.GetComputerName(PChar(buf), len) then
  begin
    SetLength(buf, len);
    Result := ASO(buf);
  end
  else
    Result := ASO(failure);
end;

class function TWindowsPropStore.GetCursorPos: TAlgosimObject;
var
  P: TPoint;
begin
  if Windows.GetCursorPos(P) then
    Result := TAlgosimStructure.CreateWithValue(
      [sm('x', ASOInt(P.X)), sm('y', ASOInt(P.Y))]
    )
  else
    Result := ASO(failure);
end;

class function TWindowsPropStore.GetFonts: TAlgosimObject;
var
  i: Integer;
begin
  Result := TAlgosimArray.Create;
  try
    Result.Capacity := Screen.Fonts.Count;
    for i := 0 to Screen.Fonts.Count - 1 do
      Result.AddElement(ASO(Screen.Fonts[i]));
  except
    Result.Free;
    raise;
  end;
end;

class function TWindowsPropStore.GetMemoryStatus: TAlgosimObject;

  function GPISM: TAlgosimObject;
  type
    TGetPhysicallyInstalledSystemMemory = function(var TotalMemoryInKilobytes: Uint64): BOOL; stdcall;
  var
    hModule: Windows.HMODULE;
    GetPhysicallyInstalledSystemMemory: TGetPhysicallyInstalledSystemMemory;
    amt: UInt64;
  begin
    hModule := LoadLibrary(kernel32);
    try
      @GetPhysicallyInstalledSystemMemory := GetProcAddress(hModule, 'GetPhysicallyInstalledSystemMemory'); // Introduced in Windows Vista SP1
      if Assigned(GetPhysicallyInstalledSystemMemory) and GetPhysicallyInstalledSystemMemory(amt) then
        Exit(ASO(amt / (1024*1024)))
      else
        Exit(ASO(null))
    finally
      FreeLibrary(hModule);
    end;
  end;

var
  MS: TMemoryStatusEx;
begin
  FillChar(MS, sizeof(MS), 0);
  MS.dwLength := sizeof(MS);
  if GlobalMemoryStatusEx(MS) then
    Result := TAlgosimStructure.CreateWithValue(
      [
        sm('installed', GPISM),
        sm('load', ASOInt(MS.dwMemoryLoad)),
        sm('TotalPhys', ASOInt(MS.ullTotalPhys)),
        sm('AvailPhys', ASOInt(MS.ullAvailPhys))
      ]
    )
  else
    Result := ASO(failure);
end;

class function TWindowsPropStore.GetUserName: TAlgosimObject;
var
  buf: string;
  len: cardinal;
begin
  SetLength(buf, 256 + 1);
  len := buf.Length;
  if Windows.GetUserName(PChar(buf), len) and (len >= 1) then
  begin
    SetLength(buf, len - 1);
    Result := ASO(buf);
  end
  else
    Result := ASO(failure);
end;

class function TWindowsPropStore.GetWindowsVersion: TAlgosimObject;
var
  OSVersionInfo: TOSVersionInfoEx;
begin
  FillChar(OSVersionInfo, sizeof(OSVersionInfo), 0);
  OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo);
  if Windows.GetVersionEx(OSVersionInfo) then
    Result := TAlgosimStructure.CreateWithValue(
      [
        sm('major', ASOInt(OSVersionInfo.dwMajorVersion)),
        sm('minor', ASOInt(OSVersionInfo.dwMinorVersion)),
        sm('BuildNumber', ASOInt(OSVersionInfo.dwBuildNumber)),
        sm('PlatformID', ASOInt(OSVersionInfo.dwPlatformId)),
        sm('ServicePackMajor', ASOInt(OSVersionInfo.wServicePackMajor)),
        sm('ServicePackMinor', ASOInt(OSVersionInfo.wServicePackMinor)),
        sm('SuiteMask', ASOInt(OSVersionInfo.wSuiteMask)),
        sm('ProductType', ASOInt(OSVersionInfo.wProductType))
      ]
    )
  else
    Result := ASO(failure);
end;

{ TGlobalPropStore }

constructor TGlobalPropStore.Create;
begin
  inherited;
  FName := 'global';
  AddSubstore(TWindowsPropStore.Create);
end;

{ TWindowsSysColorsPropStore }

constructor TWindowsSysColorsPropStore.Create;
begin
  inherited;
  FName := 'colors';
end;

function TWindowsSysColorsPropStore.LocalGetValue(
  const AKey: string): TAlgosimObject;
type
  TSysColorIdent = record
    Ident: string;
    Val: Cardinal;
  end;
const
  SysColorIdents: array[0..35] of TSysColorIdent =
    (
      (Ident: '3DDKSHADOW'; Val: 21),
      (Ident: '3DFACE'; Val: 15),
      (Ident: '3DHIGHLIGHT'; Val: 20),
      (Ident: '3DHILIGHT'; Val: 20),
      (Ident: '3DLIGHT'; Val: 22),
      (Ident: '3DSHADOW'; Val: 16),
      (Ident: 'ACTIVEBORDER'; Val: 10),
      (Ident: 'ACTIVECAPTION'; Val: 2),
      (Ident: 'APPWORKSPACE'; Val: 12),
      (Ident: 'BACKGROUND'; Val: 1),
      (Ident: 'BTNFACE'; Val: 15),
      (Ident: 'BTNHIGHLIGHT'; Val: 20),
      (Ident: 'BTNHILIGHT'; Val: 20),
      (Ident: 'BTNSHADOW'; Val: 16),
      (Ident: 'BTNTEXT'; Val: 18),
      (Ident: 'CAPTIONTEXT'; Val: 9),
      (Ident: 'DESKTOP'; Val: 1),
      (Ident: 'GRADIENTACTIVECAPTION'; Val: 27),
      (Ident: 'GRADIENTINACTIVECAPTION'; Val: 28),
      (Ident: 'GRAYTEXT'; Val: 17),
      (Ident: 'HIGHLIGHT'; Val: 13),
      (Ident: 'HIGHLIGHTTEXT'; Val: 14),
      (Ident: 'HOTLIGHT'; Val: 26),
      (Ident: 'INACTIVEBORDER'; Val: 11),
      (Ident: 'INACTIVECAPTION'; Val: 3),
      (Ident: 'INACTIVECAPTIONTEXT'; Val: 19),
      (Ident: 'INFOBK'; Val: 24),
      (Ident: 'INFOTEXT'; Val: 23),
      (Ident: 'MENU'; Val: 4),
      (Ident: 'MENUHILIGHT'; Val: 29),
      (Ident: 'MENUBAR'; Val: 30),
      (Ident: 'MENUTEXT'; Val: 7),
      (Ident: 'SCROLLBAR'; Val: 0),
      (Ident: 'WINDOW'; Val: 5),
      (Ident: 'WINDOWFRAME'; Val: 6),
      (Ident: 'WINDOWTEXT'; Val: 8)
    );
var
  i: Integer;
begin

  Result := inherited;

  if TryStrToInt(AKey, i) then
    Exit(ASOInt(Windows.GetSysColor(i)))
  else
    for i := 0 to High(SysColorIdents) do
      if SameStr(AKey, SysColorIdents[i].Ident) then
        Exit(ASOColor(TColor(Windows.GetSysColor(SysColorIdents[i].Val))));

end;

{ TWindowsSysMetricsPropStore }

constructor TWindowsSysMetricsPropStore.Create;
begin
  inherited;
  FName := 'metrics';
end;

function TWindowsSysMetricsPropStore.LocalGetValue(
  const AKey: string): TAlgosimObject;
type
  TSysMetricIdent = record
    Ident: string;
    Val: Cardinal;
  end;
const
  SysMetricIdents: array[0..94] of TSysMetricIdent =
    (
      (Ident: 'SM_ARRANGE'; Val: 56),
      (Ident: 'SM_CLEANBOOT'; Val: 67),
      (Ident: 'SM_CMONITORS'; Val: 80),
      (Ident: 'SM_CMOUSEBUTTONS'; Val: 43),
      (Ident: 'SM_CONVERTIBLESLATEMODE'; Val: $2003),
      (Ident: 'SM_CXBORDER'; Val: 5),
      (Ident: 'SM_CXCURSOR'; Val: 13),
      (Ident: 'SM_CXDLGFRAME'; Val: 7),
      (Ident: 'SM_CXDOUBLECLK'; Val: 36),
      (Ident: 'SM_CXDRAG'; Val: 68),
      (Ident: 'SM_CXEDGE'; Val: 45),
      (Ident: 'SM_CXFIXEDFRAME'; Val: 7),
      (Ident: 'SM_CXFOCUSBORDER'; Val: 83),
      (Ident: 'SM_CXFRAME'; Val: 32),
      (Ident: 'SM_CXFULLSCREEN'; Val: 16),
      (Ident: 'SM_CXHSCROLL'; Val: 21),
      (Ident: 'SM_CXHTHUMB'; Val: 10),
      (Ident: 'SM_CXICON'; Val: 11),
      (Ident: 'SM_CXICONSPACING'; Val: 38),
      (Ident: 'SM_CXMAXIMIZED'; Val: 61),
      (Ident: 'SM_CXMAXTRACK'; Val: 59),
      (Ident: 'SM_CXMENUCHECK'; Val: 71),
      (Ident: 'SM_CXMENUSIZE'; Val: 54),
      (Ident: 'SM_CXMIN'; Val: 28),
      (Ident: 'SM_CXMINIMIZED'; Val: 57),
      (Ident: 'SM_CXMINSPACING'; Val: 47),
      (Ident: 'SM_CXMINTRACK'; Val: 34),
      (Ident: 'SM_CXPADDEDBORDER'; Val: 92),
      (Ident: 'SM_CXSCREEN'; Val: 0),
      (Ident: 'SM_CXSIZE'; Val: 30),
      (Ident: 'SM_CXSIZEFRAME'; Val: 32),
      (Ident: 'SM_CXSMICON'; Val: 49),
      (Ident: 'SM_CXSMSIZE'; Val: 52),
      (Ident: 'SM_CXVIRTUALSCREEN'; Val: 78),
      (Ident: 'SM_CXVSCROLL'; Val: 2),
      (Ident: 'SM_CYBORDER'; Val: 6),
      (Ident: 'SM_CYCAPTION'; Val: 4),
      (Ident: 'SM_CYCURSOR'; Val: 14),
      (Ident: 'SM_CYDLGFRAME'; Val: 8),
      (Ident: 'SM_CYDOUBLECLK'; Val: 37),
      (Ident: 'SM_CYDRAG'; Val: 69),
      (Ident: 'SM_CYEDGE'; Val: 46),
      (Ident: 'SM_CYFIXEDFRAME'; Val: 8),
      (Ident: 'SM_CYFOCUSBORDER'; Val: 84),
      (Ident: 'SM_CYFRAME'; Val: 33),
      (Ident: 'SM_CYFULLSCREEN'; Val: 17),
      (Ident: 'SM_CYHSCROLL'; Val: 3),
      (Ident: 'SM_CYICON'; Val: 12),
      (Ident: 'SM_CYICONSPACING'; Val: 39),
      (Ident: 'SM_CYKANJIWINDOW'; Val: 18),
      (Ident: 'SM_CYMAXIMIZED'; Val: 62),
      (Ident: 'SM_CYMAXTRACK'; Val: 60),
      (Ident: 'SM_CYMENU'; Val: 15),
      (Ident: 'SM_CYMENUCHECK'; Val: 72),
      (Ident: 'SM_CYMENUSIZE'; Val: 55),
      (Ident: 'SM_CYMIN'; Val: 29),
      (Ident: 'SM_CYMINIMIZED'; Val: 58),
      (Ident: 'SM_CYMINSPACING'; Val: 48),
      (Ident: 'SM_CYMINTRACK'; Val: 35),
      (Ident: 'SM_CYSCREEN'; Val: 1),
      (Ident: 'SM_CYSIZE'; Val: 31),
      (Ident: 'SM_CYSIZEFRAME'; Val: 33),
      (Ident: 'SM_CYSMCAPTION'; Val: 51),
      (Ident: 'SM_CYSMICON'; Val: 50),
      (Ident: 'SM_CYSMSIZE'; Val: 53),
      (Ident: 'SM_CYVIRTUALSCREEN'; Val: 79),
      (Ident: 'SM_CYVSCROLL'; Val: 20),
      (Ident: 'SM_CYVTHUMB'; Val: 9),
      (Ident: 'SM_DBCSENABLED'; Val: 42),
      (Ident: 'SM_DEBUG'; Val: 22),
      (Ident: 'SM_DIGITIZER'; Val: 94),
      (Ident: 'SM_IMMENABLED'; Val: 82),
      (Ident: 'SM_MAXIMUMTOUCHES'; Val: 95),
      (Ident: 'SM_MEDIACENTER'; Val: 87),
      (Ident: 'SM_MENUDROPALIGNMENT'; Val: 40),
      (Ident: 'SM_MIDEASTENABLED'; Val: 74),
      (Ident: 'SM_MOUSEPRESENT'; Val: 19),
      (Ident: 'SM_MOUSEHORIZONTALWHEELPRESENT'; Val: 91),
      (Ident: 'SM_MOUSEWHEELPRESENT'; Val: 75),
      (Ident: 'SM_NETWORK'; Val: 63),
      (Ident: 'SM_PENWINDOWS'; Val: 41),
      (Ident: 'SM_REMOTECONTROL'; Val: $2001),
      (Ident: 'SM_REMOTESESSION'; Val: $1000),
      (Ident: 'SM_SAMEDISPLAYFORMAT'; Val: 81),
      (Ident: 'SM_SECURE'; Val: 44),
      (Ident: 'SM_SERVERR2'; Val: 89),
      (Ident: 'SM_SHOWSOUNDS'; Val: 70),
      (Ident: 'SM_SHUTTINGDOWN'; Val: $2000),
      (Ident: 'SM_SLOWMACHINE'; Val: 73),
      (Ident: 'SM_STARTER'; Val: 88),
      (Ident: 'SM_SWAPBUTTON'; Val: 23),
      (Ident: 'SM_SYSTEMDOCKED'; Val: $2004),
      (Ident: 'SM_TABLETPC'; Val: 86),
      (Ident: 'SM_XVIRTUALSCREEN'; Val: 76),
      (Ident: 'SM_YVIRTUALSCREEN'; Val: 77)
    );
var
  i: Integer;
begin

  Result := inherited;

  if TryStrToInt(AKey, i) then
    Exit(ASOInt(Windows.GetSystemMetrics(i)))
  else
    for i := 0 to High(SysMetricIdents) do
      if SameStr(AKey, SysMetricIdents[i].Ident) then
        Exit(ASOInt(Windows.GetSystemMetrics(SysMetricIdents[i].Val)));

end;

{ TWindowsKeyboardPropStore }

constructor TWindowsKeyboardPropStore.Create;
begin
  inherited;
  FName := 'keys';
end;

function TWindowsKeyboardPropStore.LocalGetValue(
  const AKey: string): TAlgosimObject;
type
  TVirtKeyCodeIdent = record
    Ident: string;
    Val: Cardinal;
  end;
const
  VirtKeyCodeIdents: array[0..136] of TVirtKeyCodeIdent =
    (
      (Ident: 'VK_LBUTTON'; Val: $01),
      (Ident: 'VK_RBUTTON'; Val: $02),
      (Ident: 'VK_CANCEL'; Val: $03),
      (Ident: 'VK_MBUTTON'; Val: $04),
      (Ident: 'VK_XBUTTON1'; Val: $05),
      (Ident: 'VK_XBUTTON2'; Val: $06),
      (Ident: 'VK_BACK'; Val: $08),
      (Ident: 'VK_TAB'; Val: $09),
      (Ident: 'VK_CLEAR'; Val: $0C),
      (Ident: 'VK_RETURN'; Val: $0D),
      (Ident: 'VK_SHIFT'; Val: $10),
      (Ident: 'VK_CONTROL'; Val: $11),
      (Ident: 'VK_MENU'; Val: $12),
      (Ident: 'VK_PAUSE'; Val: $13),
      (Ident: 'VK_CAPITAL'; Val: $14),
      (Ident: 'VK_KANA'; Val: $15),
      (Ident: 'VK_HANGUEL'; Val: $15),
      (Ident: 'VK_HANGUL'; Val: $15),
      (Ident: 'VK_JUNJA'; Val: $17),
      (Ident: 'VK_FINAL'; Val: $18),
      (Ident: 'VK_HANJA'; Val: $19),
      (Ident: 'VK_KANJI'; Val: $19),
      (Ident: 'VK_ESCAPE'; Val: $1B),
      (Ident: 'VK_CONVERT'; Val: $1C),
      (Ident: 'VK_NONCONVERT'; Val: $1D),
      (Ident: 'VK_ACCEPT'; Val: $1E),
      (Ident: 'VK_MODECHANGE'; Val: $1F),
      (Ident: 'VK_SPACE'; Val: $20),
      (Ident: 'VK_PRIOR'; Val: $21),
      (Ident: 'VK_NEXT'; Val: $22),
      (Ident: 'VK_END'; Val: $23),
      (Ident: 'VK_HOME'; Val: $24),
      (Ident: 'VK_LEFT'; Val: $25),
      (Ident: 'VK_UP'; Val: $26),
      (Ident: 'VK_RIGHT'; Val: $27),
      (Ident: 'VK_DOWN'; Val: $28),
      (Ident: 'VK_SELECT'; Val: $29),
      (Ident: 'VK_PRINT'; Val: $2A),
      (Ident: 'VK_EXECUTE'; Val: $2B),
      (Ident: 'VK_SNAPSHOT'; Val: $2C),
      (Ident: 'VK_INSERT'; Val: $2D),
      (Ident: 'VK_DELETE'; Val: $2E),
      (Ident: 'VK_HELP'; Val: $2F),
      (Ident: 'VK_LWIN'; Val: $5B),
      (Ident: 'VK_RWIN'; Val: $5C),
      (Ident: 'VK_APPS'; Val: $5D),
      (Ident: 'VK_SLEEP'; Val: $5F),
      (Ident: 'VK_NUMPAD0'; Val: $60),
      (Ident: 'VK_NUMPAD1'; Val: $61),
      (Ident: 'VK_NUMPAD2'; Val: $62),
      (Ident: 'VK_NUMPAD3'; Val: $63),
      (Ident: 'VK_NUMPAD4'; Val: $64),
      (Ident: 'VK_NUMPAD5'; Val: $65),
      (Ident: 'VK_NUMPAD6'; Val: $66),
      (Ident: 'VK_NUMPAD7'; Val: $67),
      (Ident: 'VK_NUMPAD8'; Val: $68),
      (Ident: 'VK_NUMPAD9'; Val: $69),
      (Ident: 'VK_MULTIPLY'; Val: $6A),
      (Ident: 'VK_ADD'; Val: $6B),
      (Ident: 'VK_SEPARATOR'; Val: $6C),
      (Ident: 'VK_SUBTRACT'; Val: $6D),
      (Ident: 'VK_DECIMAL'; Val: $6E),
      (Ident: 'VK_DIVIDE'; Val: $6F),
      (Ident: 'VK_F1'; Val: $70),
      (Ident: 'VK_F2'; Val: $71),
      (Ident: 'VK_F3'; Val: $72),
      (Ident: 'VK_F4'; Val: $73),
      (Ident: 'VK_F5'; Val: $74),
      (Ident: 'VK_F6'; Val: $75),
      (Ident: 'VK_F7'; Val: $76),
      (Ident: 'VK_F8'; Val: $77),
      (Ident: 'VK_F9'; Val: $78),
      (Ident: 'VK_F10'; Val: $79),
      (Ident: 'VK_F11'; Val: $7A),
      (Ident: 'VK_F12'; Val: $7B),
      (Ident: 'VK_F13'; Val: $7C),
      (Ident: 'VK_F14'; Val: $7D),
      (Ident: 'VK_F15'; Val: $7E),
      (Ident: 'VK_F16'; Val: $7F),
      (Ident: 'VK_F17'; Val: $80),
      (Ident: 'VK_F18'; Val: $81),
      (Ident: 'VK_F19'; Val: $82),
      (Ident: 'VK_F20'; Val: $83),
      (Ident: 'VK_F21'; Val: $84),
      (Ident: 'VK_F22'; Val: $85),
      (Ident: 'VK_F23'; Val: $86),
      (Ident: 'VK_F24'; Val: $87),
      (Ident: 'VK_NUMLOCK'; Val: $90),
      (Ident: 'VK_SCROLL'; Val: $91),
      (Ident: 'VK_LSHIFT'; Val: $A0),
      (Ident: 'VK_RSHIFT'; Val: $A1),
      (Ident: 'VK_LCONTROL'; Val: $A2),
      (Ident: 'VK_RCONTROL'; Val: $A3),
      (Ident: 'VK_LMENU'; Val: $A4),
      (Ident: 'VK_RMENU'; Val: $A5),
      (Ident: 'VK_BROWSER_BACK'; Val: $A6),
      (Ident: 'VK_BROWSER_FORWARD'; Val: $A7),
      (Ident: 'VK_BROWSER_REFRESH'; Val: $A8),
      (Ident: 'VK_BROWSER_STOP'; Val: $A9),
      (Ident: 'VK_BROWSER_SEARCH'; Val: $AA),
      (Ident: 'VK_BROWSER_FAVORITES'; Val: $AB),
      (Ident: 'VK_BROWSER_HOME'; Val: $AC),
      (Ident: 'VK_VOLUME_MUTE'; Val: $AD),
      (Ident: 'VK_VOLUME_DOWN'; Val: $AE),
      (Ident: 'VK_VOLUME_UP'; Val: $AF),
      (Ident: 'VK_MEDIA_NEXT_TRACK'; Val: $B0),
      (Ident: 'VK_MEDIA_PREV_TRACK'; Val: $B1),
      (Ident: 'VK_MEDIA_STOP'; Val: $B2),
      (Ident: 'VK_MEDIA_PLAY_PAUSE'; Val: $B3),
      (Ident: 'VK_LAUNCH_MAIL'; Val: $B4),
      (Ident: 'VK_LAUNCH_MEDIA_SELECT'; Val: $B5),
      (Ident: 'VK_LAUNCH_APP1'; Val: $B6),
      (Ident: 'VK_LAUNCH_APP2'; Val: $B7),
      (Ident: 'VK_OEM_1'; Val: $BA),
      (Ident: 'VK_OEM_PLUS'; Val: $BB),
      (Ident: 'VK_OEM_COMMA'; Val: $BC),
      (Ident: 'VK_OEM_MINUS'; Val: $BD),
      (Ident: 'VK_OEM_PERIOD'; Val: $BE),
      (Ident: 'VK_OEM_2'; Val: $BF),
      (Ident: 'VK_OEM_3'; Val: $C0),
      (Ident: 'VK_OEM_4'; Val: $DB),
      (Ident: 'VK_OEM_5'; Val: $DC),
      (Ident: 'VK_OEM_6'; Val: $DD),
      (Ident: 'VK_OEM_7'; Val: $DE),
      (Ident: 'VK_OEM_8'; Val: $DF),
      (Ident: 'VK_OEM_102'; Val: $E2),
      (Ident: 'VK_PROCESSKEY'; Val: $E5),
      (Ident: 'VK_PACKET'; Val: $E7),
      (Ident: 'VK_ATTN'; Val: $F6),
      (Ident: 'VK_CRSEL'; Val: $F7),
      (Ident: 'VK_EXSEL'; Val: $F8),
      (Ident: 'VK_EREOF'; Val: $F9),
      (Ident: 'VK_PLAY'; Val: $FA),
      (Ident: 'VK_ZOOM'; Val: $FB),
      (Ident: 'VK_NONAME'; Val: $FC),
      (Ident: 'VK_PA1'; Val: $FD),
      (Ident: 'VK_OEM_CLEAR'; Val: $FE)
    );
var
  i: Integer;
begin

  Result := inherited;

  if TryStrToInt(AKey, i) then
    Exit(ASOInt(Windows.GetKeyState(i)))
  else
    for i := 0 to High(VirtKeyCodeIdents) do
      if SameStr(AKey, VirtKeyCodeIdents[i].Ident) then
        Exit(ASOInt(Windows.GetKeyState(VirtKeyCodeIdents[i].Val)));

end;

{ TMonitorPropStore }

constructor TMonitorPropStore.Create;
begin
  inherited;
  FName := 'monitor';
end;

function TMonitorPropStore.LocalGetValue(const AKey: string): TAlgosimObject;
var
  i: Integer;
begin

  Result := inherited;

  if TryStrToInt(AKey, i) and InRange(i, 0, Screen.MonitorCount - 1) then
    Result := TAlgosimStructure.CreateWithValue(
      [
        sm('left', ASOInt(Screen.Monitors[i].Left)),
        sm('top', ASOInt(Screen.Monitors[i].Top)),
        sm('width', ASOInt(Screen.Monitors[i].Width)),
        sm('height', ASOInt(Screen.Monitors[i].Height)),
        sm('primary', ASO(Screen.Monitors[i].Primary)),
        sm('workspace', ASO(
          [
            sm('left', ASOInt(Screen.Monitors[i].WorkareaRect.Left)),
            sm('top', ASOInt(Screen.Monitors[i].WorkareaRect.Top)),
            sm('right', ASOInt(Screen.Monitors[i].WorkareaRect.Right)),
            sm('bottom', ASOInt(Screen.Monitors[i].WorkareaRect.Bottom))
          ]
        ))
      ]);

end;

{ TRegistryPropStore }

constructor TRegistryPropStore.Create;
begin
  inherited;
  FName := 'registry';
end;

function _RegGetValueDataType(ARegistry: TRegistry; const AValueName: string;
  out AType: DWORD): Boolean;
begin
  Result := RegQueryValueEx(ARegistry.CurrentKey, PChar(AValueName), nil,
    @AType, nil, nil) = ERROR_SUCCESS;
end;

{$WARN SYMBOL_PLATFORM OFF}
function RegGetValue(Key: HKEY; SubKey, Value: PWideChar; Flags: DWORD;
  DataType: PDWORD; Data: PByte; Len: PDWORD): Integer; stdcall; external advapi32 name 'RegGetValueW' delayed;

const
  RRF_RT_ANY = $0000ffff;
  RRF_RT_DWORD = $00000018;
  RRF_RT_QWORD = $00000048;
  RRF_RT_REG_BINARY = $00000008;
  RRF_RT_REG_DWORD = $00000010;
  RRF_RT_REG_EXPAND_SZ = $00000004;
  RRF_RT_REG_MULTI_SZ = $00000020;
  RRF_RT_REG_NONE = $00000001;
  RRF_RT_REG_QWORD = $00000040;
  RRF_RT_REG_SZ = $00000002;

  RRF_NOEXPAND = $10000000;
  RRF_ZEROONFAILURE = $20000000;

function _RegGetMultiString(ARegistry: TRegistry; const AValueName: string): TArray<string>;
var
  buf: TBytes;
  len: DWORD;
  s: string;
  list: TList<string>;
  p, pprev, pfin: PChar;
begin

  Result := [];

  len := 0;
  if RegGetValue(ARegistry.CurrentKey, nil, PChar(AValueName),
    RRF_RT_REG_MULTI_SZ or RRF_ZEROONFAILURE, nil, nil, @len) <> ERROR_SUCCESS
  then
    Exit;
  if (len = 0) or Odd(len) then
    Exit;

  SetLength(buf, len);
  if RegGetValue(ARegistry.CurrentKey, nil, PChar(AValueName),
    RRF_RT_REG_MULTI_SZ or RRF_ZEROONFAILURE, nil, Pointer(buf), @len) <> ERROR_SUCCESS
  then
    Exit;

  list := TList<string>.Create;
  try
    p := PChar(buf);
    pprev := p;
    pfin := PChar(@buf[Pred(High(buf))]);
    while p <= pfin do
    begin
      if p^ = #0 then
        if pprev <> p then
        begin
          SetString(s, pprev, p-pprev);
          list.Add(s);
          pprev := p + 1;
        end
      else
        Break;
      Inc(p);
    end;
    Result := list.ToArray;
  finally
    list.Free;
  end;

end;

function _RegGetQWord(ARegistry: TRegistry; const AValueName: string): Int64;
var
  len: DWORD;
begin
  len := Sizeof(Result);
  if RegGetValue(ARegistry.CurrentKey, nil, PChar(AValueName),
    RRF_RT_QWORD or RRF_ZEROONFAILURE, nil, @Result, @len) <> ERROR_SUCCESS
  then
    raise Exception.Create('Couldn''t read registry QWORD value.');
end;

function TRegistryPropStore.LocalGetValue(const AKey: string): TAlgosimObject;
type
  TRootKeyIdent = record
    Ident: string;
    Val: Cardinal;
  end;
const
  RootKeyIdents: array[0..6] of TRootKeyIdent =
    (
      (Ident: 'HKEY_CLASSES_ROOT'; Val: HKEY_CLASSES_ROOT),
      (Ident: 'HKEY_CURRENT_USER'; Val: HKEY_CURRENT_USER),
      (Ident: 'HKEY_LOCAL_MACHINE'; Val: HKEY_LOCAL_MACHINE),
      (Ident: 'HKEY_USERS'; Val: HKEY_USERS),
      (Ident: 'HKEY_PERFORMANCE_DATA'; Val: HKEY_PERFORMANCE_DATA),
      (Ident: 'HKEY_CURRENT_CONFIG'; Val: HKEY_CURRENT_CONFIG),
      (Ident: 'HKEY_DYN_DATA'; Val: HKEY_DYN_DATA)
    );
var
  Reg: TRegistry;
  p1, p2: Integer;
  RegRootKey,
  RegPath,
  RegValue: string;
  RegRootKeyVal: DWORD;
  i: Integer;
  c: Integer;
  RegValType: DWORD;
begin

  Result := inherited;

  p1 := 1;
  p2 := AKey.Length;

  for i := 1 to AKey.Length do
    if AKey[i] = '\' then
    begin
      p1 := i;
      Break;
    end;

  for i := AKey.Length downto p1 do
    if AKey[i] = '\' then
    begin
      p2 := i;
      Break;
    end;

  RegRootKey := Copy(AKey, 1, p1 - 1);
  RegPath := Copy(AKey, p1 + 1, p2 - p1 - 1);
  RegValue := Copy(AKey, p2 + 1);

  RegRootKeyVal := 0;
  for i := 0 to High(RootKeyIdents) do
    if SameText(RegRootKey, RootKeyIdents[i].Ident) then
    begin
      RegRootKeyVal := RootKeyIdents[i].Val;
      Break;
    end;

  if RegRootKeyVal <> 0 then
  begin
    Reg := TRegistry.Create;
    try
      Reg.RootKey := HKEY(RegRootKeyVal);
      if Reg.OpenKey(RegPath, False) and _RegGetValueDataType(Reg, RegValue, RegValType) then
        case RegValType of
          REG_SZ, REG_EXPAND_SZ:
            Result := ASO(Reg.ReadString(RegValue));
          REG_MULTI_SZ:
            Result := TAlgosimArray.CreateWithValue(_RegGetMultiString(Reg, RegValue));
          REG_DWORD:
            Result := ASOInt(Reg.ReadInteger(RegValue));
          REG_QWORD:
            Result := ASOInt(_RegGetQWord(Reg, RegValue));
          REG_NONE, REG_BINARY:
            begin
              c := Reg.GetDataSize(RegValue);
              if c <> -1 then
              begin
                Result := TAlgosimBinaryData.Create;
                try
                  TAlgosimBinaryData(Result).DataLength := c;
                  Reg.ReadBinaryData(RegValue, TAlgosimBinaryData(Result).Data^, c);
                except
                  Result.Free;
                  raise;
                end;
              end;
            end;
        end;
    finally
      Reg.Free;
    end;
  end;

end;

{ TEnvironmentVariablePropStore }

constructor TEnvironmentVariablePropStore.Create;
begin
  inherited;
  FName := 'environment';
end;

function TEnvironmentVariablePropStore.LocalGetValue(const AKey: string): TAlgosimObject;
begin
  Result := ASO(SysUtils.GetEnvironmentVariable(AKey));
end;

end.
