So, this form is buggered.
Can anyone help me out here? It just doesn't work as it should. It should open the form, ask for input, then allow/disallow the connection.
Thanks for any help.
pascal Code:
program Fire_FileWall;
{$DEFINE TESTING}
var
Allowed_URLs, Allowed_Dirs, Allowed_Files: TStringArray;
NonAllowed_URLs, NonAllowed_Directories, NonAllowed_Files: TStringArray;
Local_Allowed_URLs, Local_Allowed_Files: TStringArray;
MenuHead, MenuCheck, MenuEdit: TMenuItem;
function InStrArray(s: String; a: TStringArray): Boolean;
var
i, h: Integer;
begin
Result := True;
h := High(a);
for i := 0 to h do
if (s = a[i]) then
Exit;
Result := False;
end;
function LastPos(SubStr, Str: string): integer;
var
i, p: integer;
s, ss: string;
begin
for i := Length(str) downto 1 do
S := S + Str[i];
for i := Length(substr) downto 1 do
ss := ss + substr[i];
Writeln(S);
p := Pos(ss, S);
if P > 0 then
Result := Length(Str) - p
else
Result := -1;
end;
var
OptionForm: TForm;
Option_RadGrp: TRadioGroup;
Option_Label_Path: TLabel;
Option_Button_Okay: TButton;
//InputGiven : Boolean;
procedure OptionOkayClick(Sender: TObject);
begin
OptionForm.MODALRESULT := mrOk;
OptionForm.Free;
end;
procedure LoadOptionDialog(const isURL: Boolean; const path: String);
var
dir: String;
begin
OptionForm := TForm.Create(nil);
//OptionForm.Focused := True;
OptionForm.BringToFront;
OptionForm.Visible := True;
OptionForm.SetBounds({L} 100, {T} 100, {W} 200, {H} 400);
Option_RadGrp := TRadioGroup.create(OptionForm);
Option_RadGrp.Parent := OptionForm;
Option_RadGrp.SetBounds({L} 10, {T} 50, {W} 190, {H} 300);
Option_RadGrp.Visible := True;
Option_Label_Path := TLabel.Create(OptionForm);
Option_Label_Path.Parent := OptionForm;
Option_Label_Path.Left := 10;
Option_Label_Path.Top := 5;
Option_Label_Path.Visible := True;
Option_Button_Okay := TButton.Create(OptionForm);
Option_Button_Okay.Parent := OptionForm;
Option_Button_Okay.CAPTION := 'OKAY';
Option_Button_Okay.Left := 10;
Option_Button_Okay.Top := 360;
Option_Button_Okay.Visible := True;
Option_Button_Okay.ONCLICK := @OptionOkayClick;
Option_Label_Path.CAPTION := Path;
if (isURL) then
begin
Option_RadGrp.ITEMS.Add('Allow This Session.');
Option_RadGrp.ITEMS.Add('Always Allow.');
Option_RadGrp.ITEMS.Add('Never allow.');
Option_RadGrp.ITEMINDEX := 2;
end else
begin
dir := copy(Path, 1, lastpos('\', Path));
Option_RadGrp.ITEMS.Add('Allow This Session.');
Option_RadGrp.ITEMS.Add('Always Allow for File');
Option_RadGrp.ITEMS.Add('Always allow for Directory ' + dir);
Option_RadGrp.ITEMS.Add('Never Allow for File');
Option_RadGrp.ITEMS.Add('Never allow for Directory ' + dir);
Option_RadGrp.ITEMINDEX := 4;
end;
end;
{$IFDEF TESTING}
procedure ShowOptionForm;
begin
OptionForm.SHOW;
end;
function safeshowoptionform: Integer;
var
V: TVariantArray;
begin
V := [];
result := ThreadSafeCall('showoptionform', V);
end;
{$ENDIF}
procedure ShowOptionDialog(const isURL: Boolean; const path: String);
var
dir: String;
{$IFDEF TESTING}
V: TVariantArray;
{$ENDIF}
begin
{$IFDEF TESTING}
V := [isURL, path];
ThreadSafeCall('LoadOptionDialog', V);
if (OptionForm.modalResult = mrOk) then
{$ELSE}
LoadOptionDialog;
if (OptionForm.modalResult = mrOk) then
{$ENDIF}
writeln(Option_RadGrp.ITEMINDEX);
// Result := Option_RadGrp.ITEMINDEX
end;
function trimParams(url: String): String;
var
qPos: Integer;
begin
qPos := pos('?', url);
if (qPos <> -1) then
Result := Copy(url, 1, qPos)
else
Result := url;
end;
procedure onOpenConnection(var url : string; var Cont : boolean);
var
i: Integer;
tmp_url: String;
begin
{
check if in either Allowed_URLs, or Local_Allowed_URL
}
tmp_url := trimParams(lowercase(url));
Writeln(url);
{ Check the Loaded URLs }
if InStrArray(tmp_url, Allowed_URLs) then
begin
Cont := True;
Exit;
end;
if InStrArray(tmp_url, NonAllowed_URLs) then
begin
Cont := False;
Exit;
end;
if InStrArray(tmp_url, Local_Allowed_URLs) then
begin
Cont := True;
Exit;
end;
writeln('not already allowed.');
{
ask what to do with it.
}
ShowOptionDialog(True, url);
Writeln('Opening url: ' + url);
Writeln('We shall allow this.. For now!! Gna Gna!');
Cont := True;
end;
procedure onWriteFile(var FileName : string; var Cont : boolean);
begin
Writeln('So.. You want to write to file: ' + FileName);
Writeln('Well for this time only!');
Cont := True;
end;
procedure onOpenFile(var FileName : string; var Cont : boolean);
begin
Writeln('So you want to open this file: ' + filename);
Writeln('Well I don''t care much, lets see what the other hooks think!');
//Not set Cont as we don't care, while other hooks might
end;
{$IFNDEF TESTING}
procedure OnMenuCheckClick(Sender: TObject);
begin
MenuCheck.checked := not MenuCheck.checked;
Settings.setKeyValue('SecurityEnabled', toStr(MenuCheck.checked));
end;
{$ENDIF}
procedure Init;
var
i: Integer;
ToolsMenu : TMenuItem;
begin;
{$IFNDEF TESTING}
for i := 0 to Simba_MainMenu.Items.count - 1 do
begin
if (Simba_MainMenu.Items.items[i].caption = '&Tools') then
begin
ToolsMenu := Simba_MainMenu.Items.items[i];
Break;
end;
end;
if (ToolsMenu = nil) then
begin
Writeln('Could not find tools menu.');
Exit;
end;
MenuHead := TMenuItem.Create(ToolsMenu);
MenuHead.caption := 'S&ecurity';
ToolsMenu.Add(MenuHead);
MenuCheck := TMenuItem.CREATE(MenuHead);
MenuCheck.caption := 'Security &Enabled';
MenuCheck.checked := LowerCase(Settings.getKeyValueDef('SecurityEnabled',
'true')) = 'true';
MenuCheck.OnClick := @OnMenuCheckClick;
MenuHead.add(MenuCheck);
MenuEdit := TMenuItem.CREATE(MenuHead);
MenuEdit.caption := '&Settings';
//MenuEdit.OnClick := @LoadEditForm;
MenuHead.Add(MenuEdit);
{$ENDIF}
end;
procedure Free;
begin
//if (started) then
//Timer.Enabled := False;//Freeing the components is not needed, as they will be freed upon the freeing of Simba.
end;
procedure Attach;
begin;
Writeln('Security Extention started.');
MenuHead.Visible := True;
//Timer.Enabled := AutoUpdate.Checked;
end;
procedure Detach;
begin
MenuHead.Visible := False;
end;
function GetName : string;
begin;
result := 'File/Fire Wall';
end;
function GetVersion : string;
begin;
result := '0.1';
end;
var
cont: Boolean;
URL: String;
begin
URL := 'google.ca';
onOpenConnection(URL, cont);
end.
cheers.