From e2d630da1d5ec85c7d0b66747fe4f37d9e90bf04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= Date: Fri, 17 Dec 2021 13:05:19 +0100 Subject: [PATCH] * Fix output, add better file serving options for new http app --- components/fpweb/frmnewhttpapp.lfm | 84 +++++++++++++++++------------- components/fpweb/frmnewhttpapp.pp | 25 ++++++++- components/fpweb/weblazideintf.pp | 25 ++++++--- 3 files changed, 90 insertions(+), 44 deletions(-) diff --git a/components/fpweb/frmnewhttpapp.lfm b/components/fpweb/frmnewhttpapp.lfm index b871efb059..0e376c2502 100644 --- a/components/fpweb/frmnewhttpapp.lfm +++ b/components/fpweb/frmnewhttpapp.lfm @@ -1,39 +1,39 @@ object NewHTTPApplicationForm: TNewHTTPApplicationForm Left = 521 - Height = 310 + Height = 374 Top = 280 - Width = 384 + Width = 462 Caption = 'New HTTP server application' - ClientHeight = 310 - ClientWidth = 384 + ClientHeight = 374 + ClientWidth = 462 OnCreate = FormCreate - LCLVersion = '0.9.31' + LCLVersion = '2.3.0.0' object DEDocumentroot: TDirectoryEdit Left = 40 - Height = 22 - Top = 128 + Height = 27 + Top = 160 Width = 272 DialogTitle = 'Select directory' ShowHidden = False ButtonWidth = 23 - NumGlyphs = 0 + NumGlyphs = 1 Enabled = False MaxLength = 0 TabOrder = 0 end object CBRegisterFiles: TCheckBox Left = 16 - Height = 21 + Height = 23 Top = 14 - Width = 228 + Width = 239 Caption = 'Register location to serve files from' OnChange = CBRegisterFilesChange TabOrder = 1 end object SEPort: TSpinEdit - Left = 40 - Height = 22 - Top = 192 + Left = 34 + Height = 27 + Top = 232 Width = 98 MaxValue = 65355 TabOrder = 2 @@ -41,57 +41,67 @@ object NewHTTPApplicationForm: TNewHTTPApplicationForm end object ButtonPanel1: TButtonPanel Left = 6 - Height = 34 - Top = 270 - Width = 372 + Height = 38 + Top = 330 + Width = 450 OKButton.Name = 'OKButton' + OKButton.DefaultCaption = True HelpButton.Name = 'HelpButton' + HelpButton.DefaultCaption = True CloseButton.Name = 'CloseButton' + CloseButton.DefaultCaption = True CancelButton.Name = 'CancelButton' + CancelButton.DefaultCaption = True TabOrder = 3 ShowButtons = [pbOK, pbCancel] end object LSEPort: TLabel - Left = 22 - Height = 15 - Top = 160 - Width = 153 + Left = 16 + Height = 16 + Top = 200 + Width = 157 Caption = 'Port to listen for requests:' FocusControl = SEPort - ParentColor = False end object ELocation: TEdit Left = 40 - Height = 22 - Top = 72 + Height = 27 + Top = 64 Width = 80 Enabled = False TabOrder = 4 end object LELocation: TLabel Left = 40 - Height = 15 - Top = 48 - Width = 52 + Height = 16 + Top = 40 + Width = 55 Caption = 'Location:' FocusControl = ELocation - ParentColor = False end object LDEDocumentRoot: TLabel - Left = 40 - Height = 15 - Top = 104 - Width = 52 - Caption = '&Directory' + Left = 18 + Height = 16 + Top = 136 + Width = 171 + Caption = '&Directory to serve files from:' FocusControl = DEDocumentroot - ParentColor = False end object CBthreads: TCheckBox - Left = 24 - Height = 21 - Top = 232 - Width = 213 + Left = 18 + Height = 23 + Top = 272 + Width = 217 Caption = 'Use threads to serve requests in' TabOrder = 5 end + object CBDefaultFileLocation: TCheckBox + Left = 16 + Height = 23 + Top = 98 + Width = 178 + Caption = 'Default route serves files' + OnChange = CBDefaultFileLocationChange + TabOrder = 6 + end end diff --git a/components/fpweb/frmnewhttpapp.pp b/components/fpweb/frmnewhttpapp.pp index ee67cae246..8e0958ef26 100644 --- a/components/fpweb/frmnewhttpapp.pp +++ b/components/fpweb/frmnewhttpapp.pp @@ -16,12 +16,14 @@ type ButtonPanel1: TButtonPanel; CBRegisterFiles: TCheckBox; CBthreads: TCheckBox; + CBDefaultFileLocation: TCheckBox; DEDocumentroot: TDirectoryEdit; ELocation: TEdit; LSEPort: TLabel; LELocation: TLabel; LDEDocumentRoot: TLabel; SEPort: TSpinEdit; + procedure CBDefaultFileLocationChange(Sender: TObject); procedure CBRegisterFilesChange(Sender: TObject); procedure FormCreate(Sender: TObject); private @@ -29,6 +31,7 @@ type function GetL: String; function GetP: Integer; function GetS: Boolean; + function GetSD: Boolean; function Gett: Boolean; procedure LocalizeForm; { private declarations } @@ -39,7 +42,8 @@ type Property Directory : String Read GetD; Property Port: Integer Read GetP; Property Threaded : Boolean Read Gett; - end; + Property ServeFilesDefault : Boolean Read GetSD; + end; var NewHTTPApplicationForm: TNewHTTPApplicationForm; @@ -66,6 +70,20 @@ begin B:=GetS; ELocation.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; procedure TNewHTTPApplicationForm.LocalizeForm; @@ -99,6 +117,11 @@ begin Result:=CBRegisterFiles.Checked; end; +function TNewHTTPApplicationForm.GetSD: Boolean; +begin + Result:=CBDefaultFileLocation.Checked; +end; + function TNewHTTPApplicationForm.Gett: Boolean; begin Result:=CBThreads.Checked; diff --git a/components/fpweb/weblazideintf.pp b/components/fpweb/weblazideintf.pp index 1d8a7d366e..e463d8be7f 100644 --- a/components/fpweb/weblazideintf.pp +++ b/components/fpweb/weblazideintf.pp @@ -24,7 +24,7 @@ interface uses Classes, SysUtils, fpWeb, fpHTML, fpdatasetform, fpextjs, extjsjson, extjsxml, fpjsonrpc, jstree,jsparser, - fpextdirect,fpwebdata, + fpextdirect,fpwebdata, fpwebfile, {$IF FPC_FULLVERSION>=30004} fphttpclient, fphttpserver, @@ -182,7 +182,8 @@ type FDir, FLoc : String; FPort : Integer; - function GetOPtions: TModalResult; + FDefaultFiles : Boolean; + function GetOptions: TModalResult; public constructor Create; override; function GetLocalizedName: string; override; @@ -806,7 +807,7 @@ begin Result:=rsHTTPAppli2; end; -function THTTPApplicationDescriptor.GetOPtions : TModalResult; +function THTTPApplicationDescriptor.GetOptions : TModalResult; begin With TNewHTTPApplicationForm.Create(Application) do @@ -821,7 +822,12 @@ begin begin FLoc:=Location; FDir:=Directory; - end; + end + else + begin + FDefaultFiles:=ServeFilesDefault; + FDir:=Directory; + end end; finally Free; @@ -862,6 +868,12 @@ begin begin S:=Format(' RegisterFileLocation(''%s'',''%s'');',[FLoc,FDir]); 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; NewSource:=NewSource +' Application.Title:=''httpproject1'';'+le @@ -962,7 +974,7 @@ function TFileDescWebJSONRPCModule.GetImplementationSource(const Filename, Var RH,RM : Boolean; - HP : String; + JRC, HP : String; begin RH:=False; @@ -974,6 +986,7 @@ begin begin RH:=RegisterHandlers; RM:=RegisterModule; + JRC:=JSONRPCClass; If RM then HP:=HTTPPath; end; @@ -986,7 +999,7 @@ begin If RM then Result:=Result+' RegisterHTTPModule('''+HP+''',T'+ResourceName+');'+LineEnding; If RH then - Result:=Result+' JSONRPCHandlerManager.RegisterDatamodule(T'+ResourceName+','''+HP+''',);'+LineEnding; + Result:=Result+' JSONRPCHandlerManager.RegisterDatamodule(T'+ResourceName+','''+JRC+''');'+LineEnding; end; { TFileDescExtDirectModule }