unit ASPropStores;
{$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;
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');
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;
constructor TGlobalPropStore.Create;
begin
inherited;
FName := 'global';
AddSubstore(TWindowsPropStore.Create);
end;
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;
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;
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;
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;
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;
constructor TEnvironmentVariablePropStore.Create;
begin
inherited;
FName := 'environment';
end;
function TEnvironmentVariablePropStore.LocalGetValue(const AKey: string): TAlgosimObject;
begin
Result := ASO(SysUtils.GetEnvironmentVariable(AKey));
end;
end.