1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 08:18:52 -05:00

Made API calls optional with Settings.

Settings/Interpreter/ALlowSysCalls {True,False}
This commit is contained in:
Merlijn Wajer 2010-07-09 11:36:44 +02:00
parent cf3c5c67c0
commit 5355117a10
4 changed files with 346 additions and 8 deletions

View File

@ -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

View File

@ -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.

View File

@ -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;

View File

@ -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);
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