mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-21 21:59:18 +02:00
* Fix output, add better file serving options for new http app
This commit is contained in:
parent
82518bf64d
commit
e2d630da1d
@ -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
|
||||||
|
@ -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;
|
||||||
|
@ -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 }
|
||||||
|
Loading…
Reference in New Issue
Block a user