From 4f6735791e0c5b93735ea38bce611ce566234d19 Mon Sep 17 00:00:00 2001 From: michael Date: Thu, 2 Jun 2011 16:19:25 +0000 Subject: [PATCH] * New Lazarus project type: HTTP application (FCL only) git-svn-id: trunk@31011 - --- .gitattributes | 2 + components/fpweb/fpwebstrconsts.pas | 6 + components/fpweb/frmnewhttpapp.lfm | 101 +++++++++++++ components/fpweb/frmnewhttpapp.pp | 108 ++++++++++++++ .../fpweb/languages/fpwebstrconsts.de.po | 24 ++++ .../fpweb/languages/fpwebstrconsts.it.po | 25 ++++ components/fpweb/languages/fpwebstrconsts.po | 24 ++++ .../fpweb/languages/fpwebstrconsts.pt.po | 24 ++++ .../fpweb/languages/fpwebstrconsts.pt_BR.po | 24 ++++ .../fpweb/languages/fpwebstrconsts.ru.po | 24 ++++ .../fpweb/languages/frmrpcmoduleoptions.it.po | 1 + .../fpweb/languages/reglazwebextra.it.po | 33 ++--- components/fpweb/languages/reglazwebextra.po | 8 ++ .../fpweb/languages/reglazwebextra.pt.po | 8 ++ .../fpweb/languages/reglazwebextra.pt_BR.po | 8 ++ .../fpweb/languages/reglazwebextra.ru.po | 8 ++ components/fpweb/lazwebextra.lpk | 17 ++- components/fpweb/reglazwebextra.pp | 135 +++++++++++++++++- 18 files changed, 554 insertions(+), 26 deletions(-) create mode 100644 components/fpweb/frmnewhttpapp.lfm create mode 100644 components/fpweb/frmnewhttpapp.pp diff --git a/.gitattributes b/.gitattributes index 0742402da4..5669bfa119 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1067,6 +1067,8 @@ components/fpweb/fpwebselecttagunit.lfm svneol=native#text/plain components/fpweb/fpwebselecttagunit.pas svneol=native#text/plain components/fpweb/fpwebstrconsts.pas svneol=native#text/plain components/fpweb/fpwebtoolsunit.pas svneol=native#text/plain +components/fpweb/frmnewhttpapp.lfm svneol=native#text/plain +components/fpweb/frmnewhttpapp.pp svneol=native#text/plain components/fpweb/frmrpcmoduleoptions.lfm svneol=native#text/plain components/fpweb/frmrpcmoduleoptions.pp svneol=native#text/plain components/fpweb/images/HTMLForm.png -text svneol=unset#image/png diff --git a/components/fpweb/fpwebstrconsts.pas b/components/fpweb/fpwebstrconsts.pas index ac1cd74037..bff49e158c 100644 --- a/components/fpweb/fpwebstrconsts.pas +++ b/components/fpweb/fpwebstrconsts.pas @@ -116,6 +116,12 @@ resourcestring SHTMLInputFormAlign = 'Align'; SHTMLInputFormAccessKey = 'Access key'; + sHTTPPort = '&Port to listen for requests:'; + sNewHTTPApp = 'New HTTP application'; + sRegisterFiles = '&Register location to serve files from'; + sDocumentLocation = '&Location'; + sDocumentRoot = '&Directory'; + sUseThreads = 'Use &threads to serve requests in'; implementation diff --git a/components/fpweb/frmnewhttpapp.lfm b/components/fpweb/frmnewhttpapp.lfm new file mode 100644 index 0000000000..a41bddbd7a --- /dev/null +++ b/components/fpweb/frmnewhttpapp.lfm @@ -0,0 +1,101 @@ +object NewHTTPApplicationForm: TNewHTTPApplicationForm + Left = 521 + Height = 310 + Top = 280 + Width = 384 + Caption = 'New HTTP server application' + ClientHeight = 310 + ClientWidth = 384 + OnCreate = FormCreate + LCLVersion = '0.9.31' + object DEDocumentroot: TDirectoryEdit + Left = 40 + Height = 22 + Top = 128 + Width = 272 + DialogTitle = 'Select directory' + ShowHidden = False + ButtonWidth = 23 + NumGlyphs = 0 + Enabled = False + MaxLength = 0 + TabOrder = 0 + end + object CBRegisterFiles: TCheckBox + Left = 16 + Height = 21 + Top = 14 + Width = 228 + Caption = 'Register location to serve files from' + OnChange = CBRegisterFilesChange + TabOrder = 1 + end + object SEPort: TSpinEdit + Left = 40 + Height = 22 + Top = 192 + Width = 98 + MaxValue = 65355 + TabOrder = 2 + Value = 8080 + end + object ButtonPanel1: TButtonPanel + Left = 6 + Height = 34 + Top = 270 + Width = 372 + OKButton.Name = 'OKButton' + OKButton.Caption = '&OK' + HelpButton.Name = 'HelpButton' + HelpButton.Caption = '&Help' + CloseButton.Name = 'CloseButton' + CloseButton.Caption = '&Close' + CancelButton.Name = 'CancelButton' + CancelButton.Caption = 'Cancel' + TabOrder = 3 + ShowButtons = [pbOK, pbCancel] + end + object LSEPort: TLabel + Left = 22 + Height = 15 + Top = 160 + Width = 153 + Caption = 'Port to listen for requests:' + FocusControl = SEPort + ParentColor = False + end + object ELocation: TEdit + Left = 40 + Height = 22 + Top = 72 + Width = 80 + Enabled = False + TabOrder = 4 + end + object LELocation: TLabel + Left = 40 + Height = 15 + Top = 48 + Width = 52 + Caption = 'Location:' + FocusControl = ELocation + ParentColor = False + end + object LDEDocumentRoot: TLabel + Left = 40 + Height = 15 + Top = 104 + Width = 52 + Caption = '&Directory' + FocusControl = DEDocumentroot + ParentColor = False + end + object CBthreads: TCheckBox + Left = 24 + Height = 21 + Top = 232 + Width = 213 + Caption = 'Use threads to serve requests in' + TabOrder = 5 + end +end diff --git a/components/fpweb/frmnewhttpapp.pp b/components/fpweb/frmnewhttpapp.pp new file mode 100644 index 0000000000..ee67cae246 --- /dev/null +++ b/components/fpweb/frmnewhttpapp.pp @@ -0,0 +1,108 @@ +unit frmnewhttpapp; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn, + StdCtrls, Spin, ButtonPanel; + +type + + { TNewHTTPApplicationForm } + + TNewHTTPApplicationForm = class(TForm) + ButtonPanel1: TButtonPanel; + CBRegisterFiles: TCheckBox; + CBthreads: TCheckBox; + DEDocumentroot: TDirectoryEdit; + ELocation: TEdit; + LSEPort: TLabel; + LELocation: TLabel; + LDEDocumentRoot: TLabel; + SEPort: TSpinEdit; + procedure CBRegisterFilesChange(Sender: TObject); + procedure FormCreate(Sender: TObject); + private + function GetD: String; + function GetL: String; + function GetP: Integer; + function GetS: Boolean; + function Gett: Boolean; + procedure LocalizeForm; + { private declarations } + public + { public declarations } + Property ServeFiles : Boolean Read GetS; + Property Location : String Read GetL; + Property Directory : String Read GetD; + Property Port: Integer Read GetP; + Property Threaded : Boolean Read Gett; + end; + +var + NewHTTPApplicationForm: TNewHTTPApplicationForm; + +implementation + +uses fpWebStrConsts; + +{$R *.lfm} + +{ TNewHTTPApplicationForm } + +procedure TNewHTTPApplicationForm.FormCreate(Sender: TObject); +begin + LocalizeForm; +end; + +procedure TNewHTTPApplicationForm.CBRegisterFilesChange(Sender: TObject); + +Var + B : Boolean; + +begin + B:=GetS; + ELocation.Enabled:=B; + DEDocumentRoot.Enabled:=B; +end; + +procedure TNewHTTPApplicationForm.LocalizeForm; + +begin + Caption:=sNewHTTPApp; + CBRegisterFiles.Caption:=sRegisterFiles; + LELocation.Caption:=sDocumentLocation; + LDEDocumentRoot.Caption:=sDocumentRoot; + LSEPort.Caption:=sHTTPPort; + CBthreads.Caption:=sUseThreads; +end; + +function TNewHTTPApplicationForm.GetD: String; +begin + Result:=DEDocumentRoot.Text; +end; + +function TNewHTTPApplicationForm.GetL: String; +begin + Result:=ELocation.Text; +end; + +function TNewHTTPApplicationForm.GetP: Integer; +begin + Result:=SEPort.Value; +end; + +function TNewHTTPApplicationForm.GetS: Boolean; +begin + Result:=CBRegisterFiles.Checked; +end; + +function TNewHTTPApplicationForm.Gett: Boolean; +begin + Result:=CBThreads.Checked; +end; + +end. + diff --git a/components/fpweb/languages/fpwebstrconsts.de.po b/components/fpweb/languages/fpwebstrconsts.de.po index aa2dd774ed..53dc49ffd8 100644 --- a/components/fpweb/languages/fpwebstrconsts.de.po +++ b/components/fpweb/languages/fpwebstrconsts.de.po @@ -23,6 +23,14 @@ msgstr "Erzeuge neue CSS-Datei..." msgid "Enter your classes/style definitions here" msgstr "" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgctxt "fpwebstrconsts.senteryoutext" msgid "Enter your text..." @@ -168,6 +176,10 @@ msgstr "" msgid "Html &title - " msgstr "" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "Javascript-Datei" @@ -416,3 +428,15 @@ msgstr "Dateiname einfügen" msgid "New Html file properties" msgstr "" +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/fpwebstrconsts.it.po b/components/fpweb/languages/fpwebstrconsts.it.po index 1df345f8a2..ba82242392 100644 --- a/components/fpweb/languages/fpwebstrconsts.it.po +++ b/components/fpweb/languages/fpwebstrconsts.it.po @@ -23,6 +23,14 @@ msgstr "Crea nuovo file CSS..." msgid "Enter your classes/style definitions here" msgstr "Scrivi qui le tue definizioni di classi e stili" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgid "Enter your text..." msgstr "Scrivi il tuo testo..." @@ -155,6 +163,10 @@ msgstr "Proprietà tag: %s" msgid "Html &title - <title>" msgstr "&Titolo HTML - <title>" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "File javascript" @@ -370,3 +382,16 @@ msgstr "Inserisci nome di file" #: fpwebstrconsts.snewhtmlfileprops msgid "New Html file properties" msgstr "Proprietà del nuovo file HTML" + +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/fpwebstrconsts.po b/components/fpweb/languages/fpwebstrconsts.po index 18d22fceaa..4b4dc58410 100644 --- a/components/fpweb/languages/fpwebstrconsts.po +++ b/components/fpweb/languages/fpwebstrconsts.po @@ -13,6 +13,14 @@ msgstr "" msgid "Enter your classes/style definitions here" msgstr "" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgid "Enter your text..." msgstr "" @@ -145,6 +153,10 @@ msgstr "" msgid "Html &title - <title>" msgstr "" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "" @@ -361,3 +373,15 @@ msgstr "" msgid "New Html file properties" msgstr "" +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/fpwebstrconsts.pt.po b/components/fpweb/languages/fpwebstrconsts.pt.po index 54c22dede4..0787a34440 100644 --- a/components/fpweb/languages/fpwebstrconsts.pt.po +++ b/components/fpweb/languages/fpwebstrconsts.pt.po @@ -21,6 +21,14 @@ msgstr "Criar novo arquivo CSS..." msgid "Enter your classes/style definitions here" msgstr "Entre com suas definições de classe/estilo aqui" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgid "Enter your text..." msgstr "Entre com seu texto..." @@ -154,6 +162,10 @@ msgstr "Propriedade Tag: %s" msgid "Html &title - <title>" msgstr "&Título Html - \"<title>\"" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "Arquivo Javascript" @@ -370,3 +382,15 @@ msgstr "Inserir nome arquivo" msgid "New Html file properties" msgstr "Novas propriedades arquivo HTML" +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/fpwebstrconsts.pt_BR.po b/components/fpweb/languages/fpwebstrconsts.pt_BR.po index 54c22dede4..0787a34440 100644 --- a/components/fpweb/languages/fpwebstrconsts.pt_BR.po +++ b/components/fpweb/languages/fpwebstrconsts.pt_BR.po @@ -21,6 +21,14 @@ msgstr "Criar novo arquivo CSS..." msgid "Enter your classes/style definitions here" msgstr "Entre com suas definições de classe/estilo aqui" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgid "Enter your text..." msgstr "Entre com seu texto..." @@ -154,6 +162,10 @@ msgstr "Propriedade Tag: %s" msgid "Html &title - <title>" msgstr "&Título Html - \"<title>\"" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "Arquivo Javascript" @@ -370,3 +382,15 @@ msgstr "Inserir nome arquivo" msgid "New Html file properties" msgstr "Novas propriedades arquivo HTML" +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/fpwebstrconsts.ru.po b/components/fpweb/languages/fpwebstrconsts.ru.po index cb761ecba5..912cadca0c 100644 --- a/components/fpweb/languages/fpwebstrconsts.ru.po +++ b/components/fpweb/languages/fpwebstrconsts.ru.po @@ -23,6 +23,14 @@ msgstr "Создать новый файл CSS..." msgid "Enter your classes/style definitions here" msgstr "Введите здесь объявления классов/стилей" +#: fpwebstrconsts.sdocumentlocation +msgid "&Location" +msgstr "" + +#: fpwebstrconsts.sdocumentroot +msgid "&Directory" +msgstr "" + #: fpwebstrconsts.senteryoutext msgctxt "fpwebstrconsts.senteryoutext" msgid "Enter your text..." @@ -169,6 +177,10 @@ msgstr "Свойства тега: %s" msgid "Html &title - <title>" msgstr "&Заголовок Html - <title>" +#: fpwebstrconsts.shttpport +msgid "&Port to listen for requests:" +msgstr "" + #: fpwebstrconsts.sjsfile msgid "Javascript file" msgstr "Файл JavaScript" @@ -421,3 +433,15 @@ msgstr "Вставить имя файла" msgid "New Html file properties" msgstr "Свойства нового файла HTML" +#: fpwebstrconsts.snewhttpapp +msgid "New HTTP application" +msgstr "" + +#: fpwebstrconsts.sregisterfiles +msgid "&Register location to serve files from" +msgstr "" + +#: fpwebstrconsts.susethreads +msgid "Use &threads to serve requests in" +msgstr "" + diff --git a/components/fpweb/languages/frmrpcmoduleoptions.it.po b/components/fpweb/languages/frmrpcmoduleoptions.it.po index 53f67f3781..b949be029d 100644 --- a/components/fpweb/languages/frmrpcmoduleoptions.it.po +++ b/components/fpweb/languages/frmrpcmoduleoptions.it.po @@ -30,3 +30,4 @@ msgstr "Registra gestore JSON-RPC nella factory" #: frmrpcmoduleoptions.sregisterwebm msgid "Register web module" msgstr "Registra il modulo web" + diff --git a/components/fpweb/languages/reglazwebextra.it.po b/components/fpweb/languages/reglazwebextra.it.po index e2f4c39ab0..2faa5be15d 100644 --- a/components/fpweb/languages/reglazwebextra.it.po +++ b/components/fpweb/languages/reglazwebextra.it.po @@ -11,38 +11,35 @@ msgstr "" "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Virtaal 0.5.1\n" +#: reglazwebextra.rshttpappli +msgid "HTTP server Application" +msgstr "" + +#: reglazwebextra.rshttpappli2 +msgid "HTTP server Application. Complete HTTP Server program in Free Pascal using webmodules. The program source is automatically maintained by Lazarus." +msgstr "" + #: reglazwebextra.rswebdataprovi msgid "Web DataProvider Module" msgstr "Modulo web DataProvider" #: reglazwebextra.rswebdataprovi2 -msgid "" -"WEB DataProvider Module%sA datamodule to handle data requests for WEB (HTTP) " -"applications using WebDataProvider components." -msgstr "" -"Modulo web DataProvider%sUn modulo dati per gestire richieste di dati da " -"applicazioni WEB (HTTP) usando componenti WebDataProvider." +msgid "WEB DataProvider Module%sA datamodule to handle data requests for WEB (HTTP) applications using WebDataProvider components." +msgstr "Modulo web DataProvider%sUn modulo dati per gestire richieste di dati da applicazioni WEB (HTTP) usando componenti WebDataProvider." #: reglazwebextra.rswebextdirect msgid "Web Ext.Direct Module" msgstr "Modulo web Ext.Direct" #: reglazwebextra.rswebextdirect2 -msgid "" -"WEB Ext.Direct Module%sA datamodule to dispatch Ext.Direct requests in WEB " -"(HTTP) applications using TJSONRPCHandler components." -msgstr "" -"Modulo web Ext.Direct%sUn modulo dati per inviare richireste Ext.Direct " -"nelle applicazioni WEB (HTTP) usando componenti TJSONRPCHandler." +msgid "WEB Ext.Direct Module%sA datamodule to dispatch Ext.Direct requests in WEB (HTTP) applications using TJSONRPCHandler components." +msgstr "Modulo web Ext.Direct%sUn modulo dati per inviare richireste Ext.Direct nelle applicazioni WEB (HTTP) usando componenti TJSONRPCHandler." #: reglazwebextra.rswebjsonrpcmo msgid "Web JSON-RPC Module" msgstr "Modulo web JSON-RPC" #: reglazwebextra.rswebjsonrpcmo2 -msgid "" -"WEB JSON-RPC Module%sA datamodule to dispatch JSON-RPC requests in WEB " -"(HTTP) applications using TJSONRPCHandler components." -msgstr "" -"Modulo web JSON-RPC%sUn modulo dati per inviare richieste JSON-RPC nelle " -"applicazioni WEB (HTTP) usando componenti TJSONRPCHandler." +msgid "WEB JSON-RPC Module%sA datamodule to dispatch JSON-RPC requests in WEB (HTTP) applications using TJSONRPCHandler components." +msgstr "Modulo web JSON-RPC%sUn modulo dati per inviare richieste JSON-RPC nelle applicazioni WEB (HTTP) usando componenti TJSONRPCHandler." + diff --git a/components/fpweb/languages/reglazwebextra.po b/components/fpweb/languages/reglazwebextra.po index 811dac7c3d..3254c1327e 100644 --- a/components/fpweb/languages/reglazwebextra.po +++ b/components/fpweb/languages/reglazwebextra.po @@ -1,6 +1,14 @@ msgid "" msgstr "Content-Type: text/plain; charset=UTF-8" +#: reglazwebextra.rshttpappli +msgid "HTTP server Application" +msgstr "" + +#: reglazwebextra.rshttpappli2 +msgid "HTTP server Application. Complete HTTP Server program in Free Pascal using webmodules. The program source is automatically maintained by Lazarus." +msgstr "" + #: reglazwebextra.rswebdataprovi msgid "Web DataProvider Module" msgstr "" diff --git a/components/fpweb/languages/reglazwebextra.pt.po b/components/fpweb/languages/reglazwebextra.pt.po index 4519e9e824..043b6c9411 100644 --- a/components/fpweb/languages/reglazwebextra.pt.po +++ b/components/fpweb/languages/reglazwebextra.pt.po @@ -9,6 +9,14 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" +#: reglazwebextra.rshttpappli +msgid "HTTP server Application" +msgstr "" + +#: reglazwebextra.rshttpappli2 +msgid "HTTP server Application. Complete HTTP Server program in Free Pascal using webmodules. The program source is automatically maintained by Lazarus." +msgstr "" + #: reglazwebextra.rswebdataprovi msgid "Web DataProvider Module" msgstr "Módulo Web DataProvider" diff --git a/components/fpweb/languages/reglazwebextra.pt_BR.po b/components/fpweb/languages/reglazwebextra.pt_BR.po index 4519e9e824..043b6c9411 100644 --- a/components/fpweb/languages/reglazwebextra.pt_BR.po +++ b/components/fpweb/languages/reglazwebextra.pt_BR.po @@ -9,6 +9,14 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" +#: reglazwebextra.rshttpappli +msgid "HTTP server Application" +msgstr "" + +#: reglazwebextra.rshttpappli2 +msgid "HTTP server Application. Complete HTTP Server program in Free Pascal using webmodules. The program source is automatically maintained by Lazarus." +msgstr "" + #: reglazwebextra.rswebdataprovi msgid "Web DataProvider Module" msgstr "Módulo Web DataProvider" diff --git a/components/fpweb/languages/reglazwebextra.ru.po b/components/fpweb/languages/reglazwebextra.ru.po index 441bc37a05..3806d2cd8f 100644 --- a/components/fpweb/languages/reglazwebextra.ru.po +++ b/components/fpweb/languages/reglazwebextra.ru.po @@ -9,6 +9,14 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" +#: reglazwebextra.rshttpappli +msgid "HTTP server Application" +msgstr "" + +#: reglazwebextra.rshttpappli2 +msgid "HTTP server Application. Complete HTTP Server program in Free Pascal using webmodules. The program source is automatically maintained by Lazarus." +msgstr "" + #: reglazwebextra.rswebdataprovi msgid "Web DataProvider Module" msgstr "Модуль Web DataProvider" diff --git a/components/fpweb/lazwebextra.lpk b/components/fpweb/lazwebextra.lpk index e8135d471d..9320c1e51e 100644 --- a/components/fpweb/lazwebextra.lpk +++ b/components/fpweb/lazwebextra.lpk @@ -28,7 +28,7 @@ HTML editing functionality by Alexei Lagunov"/> <License Value="LGPL"/> <Version Minor="9"/> - <Files Count="43"> + <Files Count="44"> <Item1> <Filename Value="reglazwebextra.pp"/> <HasRegisterProc Value="True"/> @@ -211,23 +211,30 @@ HTML editing functionality by Alexei Lagunov"/> <Filename Value="fpwebnewhtmltagtdunit.lfm"/> <Type Value="LFM"/> </Item43> + <Item44> + <Filename Value="frmnewhttpapp.pp"/> + <UnitName Value="frmnewhttpapp"/> + </Item44> </Files> <i18n> <EnableI18N Value="True"/> <OutDir Value="languages"/> </i18n> <Type Value="RunAndDesignTime"/> - <RequiredPkgs Count="3"> + <RequiredPkgs Count="4"> <Item1> - <PackageName Value="sqldblaz"/> + <PackageName Value="LCLBase"/> </Item1> <Item2> - <PackageName Value="weblaz"/> + <PackageName Value="sqldblaz"/> </Item2> <Item3> + <PackageName Value="weblaz"/> + </Item3> + <Item4> <PackageName Value="FCL"/> <MinVersion Major="1" Valid="True"/> - </Item3> + </Item4> </RequiredPkgs> <UsageOptions> <UnitPath Value="$(PkgOutDir)/"/> diff --git a/components/fpweb/reglazwebextra.pp b/components/fpweb/reglazwebextra.pp index fa63ab3fd2..3fa6ea4246 100644 --- a/components/fpweb/reglazwebextra.pp +++ b/components/fpweb/reglazwebextra.pp @@ -77,6 +77,23 @@ Type Property SourceFileName : String Read FSFN; end; + { THTTPApplicationDescriptor } + THTTPApplicationDescriptor = class(TProjectDescriptor) + private + FThreaded, + fReg : Boolean; + FDir, + FLoc : String; + FPort : Integer; + function GetOPtions: TModalResult; + public + constructor Create; override; + function GetLocalizedName: string; override; + function GetLocalizedDescription: string; override; + function InitProject(AProject: TLazProject): TModalResult; override; + function CreateStartFiles(AProject: TLazProject): TModalResult; override; + end; + Procedure Register; resourcestring @@ -90,17 +107,22 @@ resourcestring rsWEBExtDirect2 = 'WEB Ext.Direct Module%sA datamodule to dispatch Ext.' +'Direct requests in WEB (HTTP) applications using TJSONRPCHandler ' +'components.'; + rsHTTPAppli = 'HTTP server Application'; + rsHTTPAppli2 = 'HTTP server Application. Complete HTTP Server ' + +'program in Free Pascal using webmodules. The program source ' + +'is automatically maintained by Lazarus.'; Var FileDescriptorWebProviderDataModule: TFileDescWebProviderDataModule; - FileDescriptorJSONRPCModule : TFileDescWebJSONRPCModule; + ProjectDescriptorHTTPApplication : THTTPApplicationDescriptor; + FileDescriptorJSONRPCModule : TFileDescWebJSONRPCModule; FileDescriptorExtDirectModule : TFileDescExtDirectModule; AChecker : TJSSyntaxChecker; implementation -uses propedits,FormEditingIntf, frmrpcmoduleoptions, - sqlstringspropertyeditordlg, registersqldb; +uses propedits,FormEditingIntf, frmrpcmoduleoptions,frmnewhttpapp, + sqlstringspropertyeditordlg, registersqldb, weblazideintf; Procedure Register; @@ -127,7 +149,114 @@ begin RegisterPropertyEditor(TStrings.ClassInfo, TSQLDBWebDataProvider, 'InsertSQL', TSQLStringsPropertyEditor); RegisterPropertyEditor(TStrings.ClassInfo, TSQLDBWebDataProvider, 'DeleteSQL', TSQLStringsPropertyEditor); RegisterPropertyEditor(TStrings.ClassInfo, TSQLDBWebDataProvider, 'UpdateSQL', TSQLStringsPropertyEditor); + ProjectDescriptorHTTPApplication:=THTTPApplicationDescriptor.Create; + RegisterProjectDescriptor(ProjectDescriptorHTTPApplication); +end; +{ THTTPApplicationDescriptor } + +constructor THTTPApplicationDescriptor.Create; +begin + inherited Create; + Name:='FPHTTPApplication'; +end; + +function THTTPApplicationDescriptor.GetLocalizedName: string; +begin + Result:=rsHTTPAppli; +end; + +function THTTPApplicationDescriptor.GetLocalizedDescription: string; +begin + Result:=rsHTTPAppli2; +end; + +function THTTPApplicationDescriptor.GetOPtions : TModalResult; + +begin + With TNewHTTPApplicationForm.Create(Application) do + try + Result:=ShowModal; + if Result=mrOK then + begin + FThreaded:=Threaded; + FPort:=Port; + FReg:=ServeFiles; + if Freg then + begin + FLoc:=Location; + FDir:=Directory; + end; + end; + finally + Free; + end; +end; +function THTTPApplicationDescriptor.InitProject(AProject: TLazProject + ): TModalResult; + +Var + S : string; + le: string; + NewSource: String; + MainFile: TLazProjectFile; + +begin + inherited InitProject(AProject); + Result:=GetOptions; + if Result<>mrOK then + Exit; + MainFile:=AProject.CreateProjectFile('httpproject1.lpr'); + MainFile.IsPartOfProject:=true; + AProject.AddFile(MainFile,false); + AProject.MainFileID:=0; + // create program source + le:=LineEnding; + NewSource:='program httpproject1;'+le + +le + +'{$mode objfpc}{$H+}'+le + +le + +'uses'+le; + if FReg then + NewSource:=NewSource+' fpwebfile,'+le; + NewSource:=NewSource + +' fphttpapp;'+le + +le + +'begin'+le; + if Freg then + begin + S:=Format(' RegisterFileLocation(''%s'',''%s'');',[FLoc,FDir]); + NewSource:=NewSource+S+le + end; + NewSource:=NewSource + +' Application.Title:=''httpproject1'';'+le + +Format(' Application.Port:=%d;'+le,[FPort]); + if FThreaded then + NewSource:=NewSource+' Application.Threaded:=True;'+le; + NewSource:=NewSource + +' Application.Initialize;'+le + +' Application.Run;'+le + +'end.'+le + +le; + AProject.MainFile.SetSourceText(NewSource); + + // add + AProject.AddPackageDependency('FCL'); + AProject.AddPackageDependency('WebLaz'); + AProject.AddPackageDependency('LazWebExtra'); + + // compiler options + AProject.LazCompilerOptions.Win32GraphicApp:=false; + AProject.Flags := AProject.Flags - [pfMainUnitHasCreateFormStatements]; + Result:= mrOK; +end; + +function THTTPApplicationDescriptor.CreateStartFiles(AProject: TLazProject + ): TModalResult; +begin + LazarusIDE.DoNewEditorFile(FileDescriptorWebModule,'','', + [nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]); + Result:= mrOK; end; { TFileDescWebProviderDataModule }