Made API calls optional with Settings.
Settings/Interpreter/ALlowSysCalls {True,False}
This commit is contained in:
Merlijn Wajer
parent
cf3c5c67c0
commit
5355117a10
|
|
@ -0,0 +1,74 @@
|
|||
object SettingsForm: TSettingsForm
|
||||
Left = 563
|
||||
Height = 558
|
||||
Top = 173
|
||||
Width = 360
|
||||
Caption = 'Simba Settings'
|
||||
ClientHeight = 558
|
||||
ClientWidth = 360
|
||||
OnCreate = FormCreate
|
||||
OnDestroy = FormDestroy
|
||||
OnMouseUp = MouseUp
|
||||
LCLVersion = '0.9.29'
|
||||
object SettingsTreeView: TTreeView
|
||||
Left = 16
|
||||
Height = 473
|
||||
Top = 16
|
||||
Width = 324
|
||||
Anchors = [akTop, akLeft, akRight, akBottom]
|
||||
DefaultItemHeight = 15
|
||||
ReadOnly = True
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 0
|
||||
OnDblClick = SettingsTreeViewDblClick
|
||||
OnKeyPress = OnKeyPress
|
||||
OnMouseUp = MouseUp
|
||||
Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips]
|
||||
end
|
||||
object SettingsFormButtonOK: TButton
|
||||
Left = 265
|
||||
Height = 25
|
||||
Top = 511
|
||||
Width = 75
|
||||
Anchors = [akRight, akBottom]
|
||||
Caption = 'OK'
|
||||
OnClick = SettingsFormButtonOKClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object SettingsFormButtonCancel: TButton
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 511
|
||||
Width = 75
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = 'Cancel'
|
||||
OnClick = SettingsFormButtonCancelClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object DeleteButton: TButton
|
||||
Left = 120
|
||||
Height = 25
|
||||
Top = 511
|
||||
Width = 120
|
||||
Anchors = [akBottom]
|
||||
Caption = 'Delete Selected'
|
||||
OnClick = DeleteSelected
|
||||
TabOrder = 3
|
||||
end
|
||||
object SettingsPopup: TPopupMenu
|
||||
left = 40
|
||||
top = 32
|
||||
object PopupRename: TMenuItem
|
||||
Caption = 'Rename'
|
||||
OnClick = PopupRenameClick
|
||||
end
|
||||
object PopupDelete: TMenuItem
|
||||
Caption = 'Delete'
|
||||
OnClick = PopupDeleteClick
|
||||
end
|
||||
object PopupCreate: TMenuItem
|
||||
Caption = 'Create subkey'
|
||||
OnClick = PopupCreateKey
|
||||
end
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,244 @@
|
|||
unit Simbasettings;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LResources, Forms, Controls,MufasaBase, Graphics, Dialogs,
|
||||
ComCtrls, StdCtrls, Menus, settings;
|
||||
|
||||
type
|
||||
|
||||
{ TSettingsForm }
|
||||
|
||||
TSettingsForm = class(TForm)
|
||||
DeleteButton: TButton;
|
||||
PopupCreate: TMenuItem;
|
||||
PopupRename: TMenuItem;
|
||||
PopupDelete: TMenuItem;
|
||||
SettingsPopup: TPopupMenu;
|
||||
SettingsFormButtonCancel: TButton;
|
||||
SettingsFormButtonOK: TButton;
|
||||
SettingsTreeView: TTreeView;
|
||||
Settings: TMMLSettings;
|
||||
procedure DeleteSelected(Sender: TObject);
|
||||
procedure MouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
procedure OnKeyPress(Sender: TObject; var Key: char);
|
||||
procedure PopupCreateKey(Sender: TObject);
|
||||
procedure PopupDeleteClick(Sender: TObject);
|
||||
procedure PopupRenameClick(Sender: TObject);
|
||||
procedure SettingsFormButtonCancelClick(Sender: TObject);
|
||||
procedure SettingsFormButtonOKClick(Sender: TObject);
|
||||
procedure DeleteANode(N: TTreeNode);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure SettingsTreeViewDblClick(Sender: TObject);
|
||||
{ private declarations }
|
||||
public
|
||||
procedure SaveCurrent;
|
||||
procedure Reload;
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
SettingsForm: TSettingsForm;
|
||||
SimbaSettingsFile : string;
|
||||
|
||||
implementation
|
||||
|
||||
uses LCLtype;
|
||||
|
||||
{ TSettingsForm }
|
||||
|
||||
procedure TSettingsForm.FormCreate(Sender: TObject);
|
||||
var
|
||||
FirstNode : TTreeNode;
|
||||
begin
|
||||
Settings := TMMLSettings.Create(SettingsTreeView.Items);
|
||||
if not FileExists(SimbaSettingsFile) then
|
||||
begin
|
||||
SettingsTreeView.Items.Clear;
|
||||
Settings.SaveToXML(SimbaSettingsFile);
|
||||
end;
|
||||
SettingsTreeView.Items.Clear;
|
||||
Settings.LoadFromXML(SimbaSettingsFile);
|
||||
FirstNode := SettingsTreeView.Items.GetFirstNode;
|
||||
if FirstNode <> nil then
|
||||
if FirstNode.Text = 'Settings' then
|
||||
FirstNode.Expand(false);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.SettingsFormButtonOKClick(Sender: TObject);
|
||||
begin
|
||||
Self.Settings.SaveToXML(SimbaSettingsFile);
|
||||
Self.ModalResult:=mrOK;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.SettingsFormButtonCancelClick(Sender: TObject);
|
||||
begin
|
||||
if not FileExists(SimbaSettingsFile) then
|
||||
begin
|
||||
Self.SettingsTreeView.Items.Clear;
|
||||
Self.Settings.SaveToXML(SimbaSettingsFile);
|
||||
Self.SettingsTreeView.Items.Clear;
|
||||
Self.Settings.LoadFromXML(SimbaSettingsFile);
|
||||
end;
|
||||
Self.ModalResult:=mrOK;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.MouseUp(Sender: TObject; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
var
|
||||
N: TTreeNode;
|
||||
begin
|
||||
if Button = mbRight then
|
||||
begin
|
||||
N := SettingsTreeView.GetNodeAt(X, Y);
|
||||
if N = nil then
|
||||
exit;
|
||||
SettingsTreeView.Selected := N;
|
||||
SettingsPopup.PopUp();
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.OnKeyPress(Sender: TObject; var Key: char);
|
||||
var
|
||||
N: TTreeNode;
|
||||
begin
|
||||
if (Ord(Key) = VK_DELETE) or (Ord(Key) = VK_BACK) then
|
||||
begin
|
||||
N := SettingsTreeView.Selected;
|
||||
if N = nil then
|
||||
exit;
|
||||
DeleteANode(N);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.PopupCreateKey(Sender: TObject);
|
||||
var
|
||||
KeyName, P: String;
|
||||
N, NN: TTreeNode;
|
||||
begin
|
||||
N := SettingsTreeView.Selected;
|
||||
if N = nil then
|
||||
exit;
|
||||
|
||||
if N.Data <> nil then
|
||||
exit;
|
||||
|
||||
if N.GetFirstChild <> nil then
|
||||
if N.GetFirstChild.Data <> nil then
|
||||
exit;
|
||||
|
||||
KeyName := InputBox('Create new Key', 'Please enter the key name', '');
|
||||
|
||||
if KeyName = '' then
|
||||
exit;
|
||||
P := Settings.GetNodePath(N);
|
||||
|
||||
if Settings.CreateKey(P + '/' + KeyName) then
|
||||
mDebugLn('Added key ' + KeyName);
|
||||
end;
|
||||
|
||||
|
||||
procedure TSettingsForm.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
Settings.Free;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.PopupDeleteClick(Sender: TObject);
|
||||
begin
|
||||
DeleteSelected(Sender);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.PopupRenameClick(Sender: TObject);
|
||||
var
|
||||
N: TTreeNode;
|
||||
MBox, Path: String;
|
||||
begin
|
||||
N := SettingsTreeView.Selected;
|
||||
if N = nil then
|
||||
exit;
|
||||
|
||||
Path := Settings.GetNodePath(N);
|
||||
|
||||
MBox := InputBox('Rename', 'Please fill in the new name', '');
|
||||
if MBox = '' then
|
||||
exit;
|
||||
|
||||
if Settings.RenameKey(Path, MBox) then
|
||||
N.Text := MBox;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.DeleteSelected(Sender: TObject);
|
||||
var
|
||||
N: TTreeNode;
|
||||
begin
|
||||
N := SettingsTreeView.Selected;
|
||||
if N = nil then
|
||||
exit;
|
||||
DeleteANode(N);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.DeleteANode(N: TTreeNode);
|
||||
var
|
||||
Path: String;
|
||||
begin
|
||||
if N = nil then
|
||||
exit;
|
||||
if MessageDlg('Delete a setting', 'Are you sure you want to delete this setting?', mtWarning, [mbYes, mbNo], 0) = mrNo then
|
||||
exit;
|
||||
|
||||
Path := Settings.GetNodePath(N);
|
||||
Settings.DeleteKey(Path);
|
||||
N.DeleteChildren;
|
||||
N.Delete;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.SettingsTreeViewDblClick(Sender: TObject);
|
||||
var
|
||||
p, pp: TPoint;
|
||||
N: TTreeNode;
|
||||
Path, NewVal: String;
|
||||
|
||||
begin
|
||||
p := Mouse.CursorPos;
|
||||
|
||||
pp := TTreeView(Sender).ScreenToClient(p);
|
||||
N := SettingsTreeView.GetNodeAt(pp.x, pp.y);
|
||||
if N <> nil then
|
||||
if assigned(N.Data) then
|
||||
begin
|
||||
Path := Settings.GetNodePath(N.Parent);
|
||||
NewVal := InputBox('Change Setting', 'Change value for ' + TSettingData(N.Data).Val,
|
||||
Settings.GetKeyValue(Path));
|
||||
mDebugLn('NewVal: ' + NewVal);
|
||||
Settings.SetKeyValue(Path, NewVal);
|
||||
N.Text := NewVal;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.SaveCurrent;
|
||||
begin
|
||||
Settings.SaveToXML(SimbaSettingsFile);
|
||||
end;
|
||||
|
||||
procedure TSettingsForm.Reload;
|
||||
begin
|
||||
if not FileExists(SimbaSettingsFile) then
|
||||
begin
|
||||
SettingsTreeView.Items.Clear;
|
||||
Settings.SaveToXML(SimbaSettingsFile);
|
||||
end;
|
||||
|
||||
SettingsTreeView.Items.Clear;
|
||||
Settings.LoadFromXML(SimbaSettingsFile);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$R *.lfm}
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -1466,9 +1466,16 @@ begin
|
|||
if assigned(Self.OCR_Fonts) and loadFontsOnScriptStart then
|
||||
Thread.Client.MOCR.Fonts := OCR_Fonts.Fonts;
|
||||
|
||||
Se := TMMLSettingsSandbox.Create(SettingsForm.Settings);
|
||||
Se.Prefix := 'Scripts/';
|
||||
Thread.SetSettings(Se);
|
||||
{
|
||||
We pass the entire settings to the script; it will then create a Sandbox
|
||||
for settings that are exported to the script. This way we can access all
|
||||
the settings from the PSTHread, and scripts can only access limited
|
||||
resources. Hopefully this won't cause any form / thread related problems?
|
||||
(Settings doesn't use the Settings form, iirc)
|
||||
Well, it was like this previously as well, we just passed a sandbox to it
|
||||
directly, but the sandbox still called Settings.
|
||||
}
|
||||
Thread.SetSettings(SettingsForm.Settings, SimbaSettingsFile);
|
||||
Thread.OpenConnectionEvent:=@ThreadOpenConnectionEvent;
|
||||
Thread.WriteFileEvent:=@ThreadWriteFileEvent;
|
||||
Thread.OpenFileEvent:=@ThreadOpenFileEvent;
|
||||
|
|
|
|||
|
|
@ -33,7 +33,7 @@ uses
|
|||
Classes, SysUtils, client, uPSComponent,uPSCompiler,
|
||||
uPSRuntime,stdCtrls, uPSPreProcessor,MufasaTypes,MufasaBase, web,
|
||||
bitmaps, plugins, libloader, dynlibs,internets,scriptproperties,
|
||||
settingssandbox;
|
||||
settings,settingssandbox;
|
||||
|
||||
|
||||
type
|
||||
|
|
@ -100,6 +100,8 @@ type
|
|||
Client : TClient;
|
||||
MInternet : TMInternet;
|
||||
StartTime : LongWord;
|
||||
Settings: TMMLSettings;
|
||||
SimbaSettingsFile: String;
|
||||
Sett: TMMLSettingsSandbox;
|
||||
|
||||
InputQueryData : TInputQueryData;//We need this for InputQuery
|
||||
|
|
@ -119,7 +121,7 @@ type
|
|||
procedure SetDebugClear( clearProc : TClearDebugProc );
|
||||
procedure SetDbgImg( DebugImageInfo : TDbgImgInfo);
|
||||
procedure SetPaths(ScriptP,AppP,IncludeP,PluginP,FontP : string);
|
||||
procedure SetSettings(S: TMMLSettingsSandbox);
|
||||
procedure SetSettings(S: TMMLSettings; SimbaSetFile: String);
|
||||
|
||||
procedure OnThreadTerminate(Sender: TObject);
|
||||
procedure SetScript(script: string); virtual; abstract;
|
||||
|
|
@ -427,9 +429,12 @@ begin
|
|||
FDebugImg := DebugImageInfo;
|
||||
end;
|
||||
|
||||
procedure TMThread.SetSettings(S: TMMLSettingsSandbox);
|
||||
procedure TMThread.SetSettings(S: TMMLSettings; SimbaSetFile: String);
|
||||
begin
|
||||
Self.Sett := S;
|
||||
Self.SimbaSettingsFile := SimbaSetFile;
|
||||
Self.Settings := S;
|
||||
Self.Sett := TMMLSettingsSandbox.Create(Self.Settings);
|
||||
Self.Sett.prefix := 'Scripts/';
|
||||
end;
|
||||
|
||||
procedure TMThread.SetPaths(ScriptP, AppP,IncludeP,PluginP,FontP: string);
|
||||
|
|
@ -641,7 +646,15 @@ begin
|
|||
SIRegister_Menus(x);
|
||||
SIRegister_ComCtrls(x);
|
||||
SIRegister_Dialogs(x);
|
||||
RegisterDll_Compiletime(x);
|
||||
if self.settings <> nil then
|
||||
begin
|
||||
if lowercase(self.settings.GetKeyValueDefLoad('Settings/Interpreter/AllowSysCalls',
|
||||
'False', Self.SimbaSettingsFile)) = 'true' then
|
||||
begin
|
||||
writeln('Allowing SysCalls');
|
||||
RegisterDll_Compiletime(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
with x do
|
||||
begin
|
||||
|
|
|
|||
Loading…
Reference in New Issue