* Fix output, add better file serving options for new http app

This commit is contained in:
Michaël Van Canneyt 2021-12-17 13:05:19 +01:00
parent 82518bf64d
commit e2d630da1d
3 changed files with 90 additions and 44 deletions

View File

@ -1,39 +1,39 @@
object NewHTTPApplicationForm: TNewHTTPApplicationForm object NewHTTPApplicationForm: TNewHTTPApplicationForm
Left = 521 Left = 521
Height = 310 Height = 374
Top = 280 Top = 280
Width = 384 Width = 462
Caption = 'New HTTP server application' Caption = 'New HTTP server application'
ClientHeight = 310 ClientHeight = 374
ClientWidth = 384 ClientWidth = 462
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '0.9.31' LCLVersion = '2.3.0.0'
object DEDocumentroot: TDirectoryEdit object DEDocumentroot: TDirectoryEdit
Left = 40 Left = 40
Height = 22 Height = 27
Top = 128 Top = 160
Width = 272 Width = 272
DialogTitle = 'Select directory' DialogTitle = 'Select directory'
ShowHidden = False ShowHidden = False
ButtonWidth = 23 ButtonWidth = 23
NumGlyphs = 0 NumGlyphs = 1
Enabled = False Enabled = False
MaxLength = 0 MaxLength = 0
TabOrder = 0 TabOrder = 0
end end
object CBRegisterFiles: TCheckBox object CBRegisterFiles: TCheckBox
Left = 16 Left = 16
Height = 21 Height = 23
Top = 14 Top = 14
Width = 228 Width = 239
Caption = 'Register location to serve files from' Caption = 'Register location to serve files from'
OnChange = CBRegisterFilesChange OnChange = CBRegisterFilesChange
TabOrder = 1 TabOrder = 1
end end
object SEPort: TSpinEdit object SEPort: TSpinEdit
Left = 40 Left = 34
Height = 22 Height = 27
Top = 192 Top = 232
Width = 98 Width = 98
MaxValue = 65355 MaxValue = 65355
TabOrder = 2 TabOrder = 2
@ -41,57 +41,67 @@ object NewHTTPApplicationForm: TNewHTTPApplicationForm
end end
object ButtonPanel1: TButtonPanel object ButtonPanel1: TButtonPanel
Left = 6 Left = 6
Height = 34 Height = 38
Top = 270 Top = 330
Width = 372 Width = 450
OKButton.Name = 'OKButton' OKButton.Name = 'OKButton'
OKButton.DefaultCaption = True
HelpButton.Name = 'HelpButton' HelpButton.Name = 'HelpButton'
HelpButton.DefaultCaption = True
CloseButton.Name = 'CloseButton' CloseButton.Name = 'CloseButton'
CloseButton.DefaultCaption = True
CancelButton.Name = 'CancelButton' CancelButton.Name = 'CancelButton'
CancelButton.DefaultCaption = True
TabOrder = 3 TabOrder = 3
ShowButtons = [pbOK, pbCancel] ShowButtons = [pbOK, pbCancel]
end end
object LSEPort: TLabel object LSEPort: TLabel
Left = 22 Left = 16
Height = 15 Height = 16
Top = 160 Top = 200
Width = 153 Width = 157
Caption = 'Port to listen for requests:' Caption = 'Port to listen for requests:'
FocusControl = SEPort FocusControl = SEPort
ParentColor = False
end end
object ELocation: TEdit object ELocation: TEdit
Left = 40 Left = 40
Height = 22 Height = 27
Top = 72 Top = 64
Width = 80 Width = 80
Enabled = False Enabled = False
TabOrder = 4 TabOrder = 4
end end
object LELocation: TLabel object LELocation: TLabel
Left = 40 Left = 40
Height = 15 Height = 16
Top = 48 Top = 40
Width = 52 Width = 55
Caption = 'Location:' Caption = 'Location:'
FocusControl = ELocation FocusControl = ELocation
ParentColor = False
end end
object LDEDocumentRoot: TLabel object LDEDocumentRoot: TLabel
Left = 40 Left = 18
Height = 15 Height = 16
Top = 104 Top = 136
Width = 52 Width = 171
Caption = '&Directory' Caption = '&Directory to serve files from:'
FocusControl = DEDocumentroot FocusControl = DEDocumentroot
ParentColor = False
end end
object CBthreads: TCheckBox object CBthreads: TCheckBox
Left = 24 Left = 18
Height = 21 Height = 23
Top = 232 Top = 272
Width = 213 Width = 217
Caption = 'Use threads to serve requests in' Caption = 'Use threads to serve requests in'
TabOrder = 5 TabOrder = 5
end end
object CBDefaultFileLocation: TCheckBox
Left = 16
Height = 23
Top = 98
Width = 178
Caption = 'Default route serves files'
OnChange = CBDefaultFileLocationChange
TabOrder = 6
end
end end

View File

@ -16,12 +16,14 @@ type
ButtonPanel1: TButtonPanel; ButtonPanel1: TButtonPanel;
CBRegisterFiles: TCheckBox; CBRegisterFiles: TCheckBox;
CBthreads: TCheckBox; CBthreads: TCheckBox;
CBDefaultFileLocation: TCheckBox;
DEDocumentroot: TDirectoryEdit; DEDocumentroot: TDirectoryEdit;
ELocation: TEdit; ELocation: TEdit;
LSEPort: TLabel; LSEPort: TLabel;
LELocation: TLabel; LELocation: TLabel;
LDEDocumentRoot: TLabel; LDEDocumentRoot: TLabel;
SEPort: TSpinEdit; SEPort: TSpinEdit;
procedure CBDefaultFileLocationChange(Sender: TObject);
procedure CBRegisterFilesChange(Sender: TObject); procedure CBRegisterFilesChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
private private
@ -29,6 +31,7 @@ type
function GetL: String; function GetL: String;
function GetP: Integer; function GetP: Integer;
function GetS: Boolean; function GetS: Boolean;
function GetSD: Boolean;
function Gett: Boolean; function Gett: Boolean;
procedure LocalizeForm; procedure LocalizeForm;
{ private declarations } { private declarations }
@ -39,7 +42,8 @@ type
Property Directory : String Read GetD; Property Directory : String Read GetD;
Property Port: Integer Read GetP; Property Port: Integer Read GetP;
Property Threaded : Boolean Read Gett; Property Threaded : Boolean Read Gett;
end; Property ServeFilesDefault : Boolean Read GetSD;
end;
var var
NewHTTPApplicationForm: TNewHTTPApplicationForm; NewHTTPApplicationForm: TNewHTTPApplicationForm;
@ -66,6 +70,20 @@ begin
B:=GetS; B:=GetS;
ELocation.Enabled:=B; ELocation.Enabled:=B;
DEDocumentRoot.Enabled:=B; DEDocumentRoot.Enabled:=B;
CBDefaultFileLocation.Enabled:=Not B;
if not CBDefaultFileLocation.Enabled then
CBDefaultFileLocation.Checked:=False
end;
procedure TNewHTTPApplicationForm.CBDefaultFileLocationChange(Sender: TObject);
begin
CBRegisterFiles.Enabled:=Not CBDefaultFileLocation.Checked;
ELocation.Enabled:=Not CBDefaultFileLocation.Checked;
if not CBRegisterFiles.Enabled then
begin
CBRegisterFiles.Checked:=False;
ELocation.Text:='';
end;
end; end;
procedure TNewHTTPApplicationForm.LocalizeForm; procedure TNewHTTPApplicationForm.LocalizeForm;
@ -99,6 +117,11 @@ begin
Result:=CBRegisterFiles.Checked; Result:=CBRegisterFiles.Checked;
end; end;
function TNewHTTPApplicationForm.GetSD: Boolean;
begin
Result:=CBDefaultFileLocation.Checked;
end;
function TNewHTTPApplicationForm.Gett: Boolean; function TNewHTTPApplicationForm.Gett: Boolean;
begin begin
Result:=CBThreads.Checked; Result:=CBThreads.Checked;

View File

@ -24,7 +24,7 @@ interface
uses uses
Classes, SysUtils, fpWeb, fpHTML, fpdatasetform, Classes, SysUtils, fpWeb, fpHTML, fpdatasetform,
fpextjs, extjsjson, extjsxml, fpjsonrpc, jstree,jsparser, fpextjs, extjsjson, extjsxml, fpjsonrpc, jstree,jsparser,
fpextdirect,fpwebdata, fpextdirect,fpwebdata, fpwebfile,
{$IF FPC_FULLVERSION>=30004} {$IF FPC_FULLVERSION>=30004}
fphttpclient, fphttpclient,
fphttpserver, fphttpserver,
@ -182,7 +182,8 @@ type
FDir, FDir,
FLoc : String; FLoc : String;
FPort : Integer; FPort : Integer;
function GetOPtions: TModalResult; FDefaultFiles : Boolean;
function GetOptions: TModalResult;
public public
constructor Create; override; constructor Create; override;
function GetLocalizedName: string; override; function GetLocalizedName: string; override;
@ -806,7 +807,7 @@ begin
Result:=rsHTTPAppli2; Result:=rsHTTPAppli2;
end; end;
function THTTPApplicationDescriptor.GetOPtions : TModalResult; function THTTPApplicationDescriptor.GetOptions : TModalResult;
begin begin
With TNewHTTPApplicationForm.Create(Application) do With TNewHTTPApplicationForm.Create(Application) do
@ -821,7 +822,12 @@ begin
begin begin
FLoc:=Location; FLoc:=Location;
FDir:=Directory; FDir:=Directory;
end; end
else
begin
FDefaultFiles:=ServeFilesDefault;
FDir:=Directory;
end
end; end;
finally finally
Free; Free;
@ -862,6 +868,12 @@ begin
begin begin
S:=Format(' RegisterFileLocation(''%s'',''%s'');',[FLoc,FDir]); S:=Format(' RegisterFileLocation(''%s'',''%s'');',[FLoc,FDir]);
NewSource:=NewSource+S+le NewSource:=NewSource+S+le
end
else if FDefaultFiles then
begin
S:='TSimpleFileModule.BaseDir:='+Format('''%s'';',[StringReplace(FDir,'''','''''',[rfReplaceAll])]);
S:=S+le+'TSimpleFileModule.RegisterDefaultRoute;';
NewSource:=NewSource+S+le;
end; end;
NewSource:=NewSource NewSource:=NewSource
+' Application.Title:=''httpproject1'';'+le +' Application.Title:=''httpproject1'';'+le
@ -962,7 +974,7 @@ function TFileDescWebJSONRPCModule.GetImplementationSource(const Filename,
Var Var
RH,RM : Boolean; RH,RM : Boolean;
HP : String; JRC, HP : String;
begin begin
RH:=False; RH:=False;
@ -974,6 +986,7 @@ begin
begin begin
RH:=RegisterHandlers; RH:=RegisterHandlers;
RM:=RegisterModule; RM:=RegisterModule;
JRC:=JSONRPCClass;
If RM then If RM then
HP:=HTTPPath; HP:=HTTPPath;
end; end;
@ -986,7 +999,7 @@ begin
If RM then If RM then
Result:=Result+' RegisterHTTPModule('''+HP+''',T'+ResourceName+');'+LineEnding; Result:=Result+' RegisterHTTPModule('''+HP+''',T'+ResourceName+');'+LineEnding;
If RH then If RH then
Result:=Result+' JSONRPCHandlerManager.RegisterDatamodule(T'+ResourceName+','''+HP+''',);'+LineEnding; Result:=Result+' JSONRPCHandlerManager.RegisterDatamodule(T'+ResourceName+','''+JRC+''');'+LineEnding;
end; end;
{ TFileDescExtDirectModule } { TFileDescExtDirectModule }