paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-22 11:59:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

components: added fpweb from Michael Van Canneyt

Browse Source 
git-svn-id: trunk@10847 -
This commit is contained in:
mattias 2007-04-02 07:55:14 +00:00
parent 3c4a5dccb7
commit 31606f9a53
7 changed files with 1228 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
.gitattributes vendored
View File

@ -178,6 +178,12 @@ components/fpcunit/ide/testcaseopts.lfm svneol=native#text/plain
components/fpcunit/ide/testcaseopts.lrs svneol=native#text/pascal components/fpcunit/ide/testcaseopts.lrs svneol=native#text/pascal
components/fpcunit/ide/testcaseopts.pas svneol=native#text/pascal components/fpcunit/ide/testcaseopts.pas svneol=native#text/pascal
components/fpcunit/lib/README.txt svneol=native#text/plain components/fpcunit/lib/README.txt svneol=native#text/plain
components/fpweb/README.txt svneol=native#text/plain
components/fpweb/cgiapp.pp svneol=native#text/plain
components/fpweb/lazweb.pp svneol=native#text/plain
components/fpweb/weblaz.lpk svneol=native#text/plain
components/fpweb/weblaz.pas svneol=native#text/plain
components/fpweb/weblazideintf.pp svneol=native#text/plain
components/h2pas/h2pasconfig.pas svneol=native#text/plain components/h2pas/h2pasconfig.pas svneol=native#text/plain
components/h2pas/h2pasconvert.pas svneol=native#text/plain components/h2pas/h2pasconvert.pas svneol=native#text/plain
components/h2pas/h2pasdlg.lfm svneol=native#text/plain components/h2pas/h2pasdlg.lfm svneol=native#text/plain

2
components/fpweb/README.txt Normal file
View File

@ -0,0 +1,2 @@
fpWeb does not work with fpc 2.0.4.
It needs at least 2.3.x.

597
components/fpweb/cgiapp.pp Normal file
View File

@ -0,0 +1,597 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by the Free Pascal development team
TCGIApplication class.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{$define CGIDEBUG}
{$mode objfpc}
{$H+}
unit cgiapp;
Interface
uses
CustApp,Classes,SysUtils, httpdefs;
Const
CGIVarCount = 33;
Type
TCGIVarArray = Array[1..CGIVarCount] of String;
Const
CgiVarNames : TCGIVarArray =
({ 1 } 'AUTH_TYPE',
{ 2 } 'CONTENT_LENGTH',
{ 3 } 'CONTENT_TYPE',
{ 4 } 'GATEWAY_INTERFACE',
{ 5 } 'PATH_INFO',
{ 6 } 'PATH_TRANSLATED',
{ 7 } 'QUERY_STRING',
{ 8 } 'REMOTE_ADDR',
{ 9 } 'REMOTE_HOST',
{ 10 } 'REMOTE_IDENT',
{ 11 } 'REMOTE_USER',
{ 12 } 'REQUEST_METHOD',
{ 13 } 'SCRIPT_NAME',
{ 14 } 'SERVER_NAME',
{ 15 } 'SERVER_PORT',
{ 16 } 'SERVER_PROTOCOL',
{ 17 } 'SERVER_SOFTWARE',
{ 18 } 'HTTP_ACCEPT',
{ 19 } 'HTTP_ACCEPT_CHARSET',
{ 20 } 'HTTP_ACCEPT_ENCODING',
{ 21 } 'HTTP_IF_MODIFIED_SINCE',
{ 22 } 'HTTP_REFERER',
{ 23 } 'HTTP_USER_AGENT',
// Additional Apache vars
{ 24 } 'HTTP_CONNECTION',
{ 25 } 'HTTP_ACCEPT_LANGUAGE',
{ 26 } 'HTTP_HOST',
{ 27 } 'SERVER_SIGNATURE',
{ 28 } 'SERVER_ADDR',
{ 29 } 'DOCUMENT_ROOT',
{ 30 } 'SERVER_ADMIN',
{ 31 } 'SCRIPT_FILENAME',
{ 32 } 'REMOTE_PORT',
{ 33 } 'REQUEST_URI'
);
Type
{ TCGIRequest }
TCustomCGIApplication = Class;
TCGIRequest = Class(TRequest)
Private
FCGI : TCustomCGIApplication;
function GetCGIVar(Index: integer): String;
Protected
Function GetFieldValue(Index : Integer) : String; override;
Procedure InitFromEnvironment;
Procedure InitPostVars;
Procedure InitGetVars;
Public
Constructor CreateCGI(ACGI : TCustomCGIApplication);
Property GatewayInterface : String Index 1 Read GetCGIVar;
Property RemoteIdent : String Index 2 read GetCGIVar;
Property RemoteUser : String Index 3 read GetCGIVar;
Property RequestMethod : String Index 4 read GetCGIVar;
Property ServerName : String Index 5 read GetCGIVar;
Property ServerProtocol : String Index 6 read GetCGIVar;
Property ServerSoftware : String Index 7 read GetCGIVar;
end;
{ TCGIResponse }
TCGIResponse = Class(TResponse)
private
FCGI : TCustomCGIApplication;
FOutput : TStream;
Protected
Procedure DoSendHeaders(Headers : TStrings); override;
Procedure DoSendContent; override;
Public
Constructor CreateCGI(ACGI : TCustomCGIApplication; AStream : TStream);
end;
{ TCustomCgiApplication }
TCustomCGIApplication = Class(TCustomApplication)
Private
FResponse : TCGIResponse;
FRequest : TCGIRequest;
FEmail : String;
FAdministrator : String;
FOutput : TStream;
Procedure InitRequestVars;
Function GetEmail : String;
Function GetAdministrator : String;
Function GetRequestVariable(Const VarName : String) : String;
Function GetRequestVariableCount : Integer;
Public
Destructor Destroy; override;
Property Request : TCGIRequest read FRequest;
Property Response: TCGIResponse Read FResponse;
Procedure AddResponse(Const S : String);
Procedure AddResponse(Const Fmt : String; Args : Array of const);
Procedure AddResponseLn(Const S : String);
Procedure AddResponseLn(Const Fmt : String; Args : Array of const);
Procedure Initialize; override;
Procedure GetCGIVarList(List : TStrings);
Procedure ShowException(E: Exception);override;
Procedure DeleteFormFiles;
Procedure DoRun; override;
Procedure handleRequest(ARequest : TRequest; AResponse : TResponse); virtual;
Function GetTempCGIFileName : String;
Function VariableIsUploadedFile(Const VarName : String) : boolean;
Function UploadedFileName(Const VarName : String) : String;
Property Email : String Read GetEmail Write FEmail;
Property Administrator : String Read GetAdministrator Write FAdministrator;
Property RequestVariables[VarName : String] : String Read GetRequestVariable;
Property RequestVariableCount : Integer Read GetRequestVariableCount;
end;
ResourceString
SWebMaster = 'webmaster';
SCGIError = 'CGI Error';
SAppEncounteredError = 'The application encountered the following error:';
SError = 'Error: ';
SNotify = 'Notify: ';
SErrNoContentLength = 'No content length passed from server!';
SErrUnsupportedContentType = 'Unsupported content type: "%s"';
SErrNoRequestMethod = 'No REQUEST_METHOD passed from server.';
SErrInvalidRequestMethod = 'Invalid REQUEST_METHOD passed from server.';
Implementation
uses
{$ifdef CGIDEBUG}
dbugintf,
{$endif}
iostream;
Const
MapCgiToHTTP : TCGIVarArray =
({ 1: 'AUTH_TYPE' } fieldWWWAuthenticate, // ?
{ 2: 'CONTENT_LENGTH' } FieldContentLength,
{ 3: 'CONTENT_TYPE' } FieldContentType,
{ 4: 'GATEWAY_INTERFACE' } '',
{ 5: 'PATH_INFO' } '',
{ 6: 'PATH_TRANSLATED' } '',
{ 7: 'QUERY_STRING' } '',
{ 8: 'REMOTE_ADDR' } '',
{ 9: 'REMOTE_HOST' } '',
{ 10: 'REMOTE_IDENT' } '',
{ 11: 'REMOTE_USER' } '',
{ 12: 'REQUEST_METHOD' } '',
{ 13: 'SCRIPT_NAME' } '',
{ 14: 'SERVER_NAME' } '',
{ 15: 'SERVER_PORT' } '',
{ 16: 'SERVER_PROTOCOL' } '',
{ 17: 'SERVER_SOFTWARE' } '',
{ 18: 'HTTP_ACCEPT' } FieldAccept,
{ 19: 'HTTP_ACCEPT_CHARSET' } FieldAcceptCharset,
{ 20: 'HTTP_ACCEPT_ENCODING' } FieldAcceptEncoding,
{ 21: 'HTTP_IF_MODIFIED_SINCE' } FieldIfModifiedSince,
{ 22: 'HTTP_REFERER' } FieldReferer,
{ 23: 'HTTP_USER_AGENT' } FieldUserAgent,
// Additional Apache vars
{ 24: 'HTTP_CONNECTION' } FieldConnection,
{ 25: 'HTTP_ACCEPT_LANGUAGE' } FieldAcceptLanguage,
{ 26: 'HTTP_HOST' } '',
{ 27: 'SERVER_SIGNATURE' } '',
{ 28: 'SERVER_ADDR' } '',
{ 29: 'DOCUMENT_ROOT' } '',
{ 30: 'SERVER_ADMIN' } '',
{ 31: 'SCRIPT_FILENAME' } '',
{ 32: 'REMOTE_PORT' } '',
{ 33: 'REQUEST_URI' } ''
);
Destructor TCustomCGIApplication.Destroy;
begin
DeleteFormFiles;
FreeAndNil(FRequest);
FreeAndNil(FResponse);
FreeAndNil(FOutPut);
Inherited;
end;
Function TCustomCGIApplication.GetTempCGIFileName : String;
begin
Result:=GetTempFileName('/tmp/','CGI')
end;
Procedure TCustomCGIApplication.DeleteFormFiles;
Var
I : Integer;
FN : String;
begin
For I:=0 to FRequest.Files.Count-1 do
begin
FN:=FRequest.Files[I].LocalFileName;
If FileExists(FN) then
DeleteFile(FN);
end;
end;
procedure TCustomCGIApplication.DoRun;
begin
HandleRequest(FRequest,FResponse);
If Not FResponse.ContentSent then
begin
FResponse.SendContent;
end;
Terminate;
end;
procedure TCustomCGIApplication.HandleRequest(ARequest: TRequest; AResponse: TResponse);
begin
// Needs overriding;
end;
Procedure TCustomCGIApplication.Initialize;
begin
StopOnException:=True;
Inherited;
FRequest:=TCGIRequest.CreateCGI(Self);
InitRequestVars;
FOutput:=TIOStream.Create(iosOutput);
FResponse:=TCGIResponse.CreateCGI(Self,Self.FOutput);
end;
Procedure TCustomCGIApplication.GetCGIVarList(List : TStrings);
Var
I : Integer;
begin
List.Clear;
For I:=1 to cgiVarCount do
List.Add(CGIVarNames[i]+'='+GetEnvironmentVariable(CGIVarNames[i]));
end;
Procedure TCustomCGIApplication.ShowException(E: Exception);
Var
TheEmail : String;
FrameCount: integer;
Frames: PPointer;
FrameNumber:Integer;
S : TStrings;
begin
If not FResponse.HeadersSent then
FResponse.ContentType:='text/html';
If (FResponse.ContentType='text/html') then
begin
S:=TStringList.Create;
Try
With S do
begin
Add('<html><head><title>'+Title+': '+SCGIError+'</title></head>'+LineEnding);
Add('<body>');
Add('<center><hr><h1>'+Title+': ERROR</h1><hr></center><br><br>');
Add(SAppEncounteredError+'<br>');
Add('<ul>');
Add('<li>'+SError+' <b>'+E.Message+'</b>');
Add('<li> Stack trace:<br>');
Add(BackTraceStrFunc(ExceptAddr)+'<br>');
FrameCount:=ExceptFrameCount;
Frames:=ExceptFrames;
for FrameNumber := 0 to FrameCount-1 do
Add(BackTraceStrFunc(Frames[FrameNumber])+'<br>');
Add('</ul><hr>');
TheEmail:=Email;
If (TheEmail<>'') then
Add('<h5><p><i>'+SNotify+Administrator+': <a href="mailto:'+TheEmail+'">'+TheEmail+'</a></i></p></h5>');
Add('</body></html>');
end;
FResponse.Content:=S.Text;
Finally
FreeAndNil(S);
end;
end;
end;
Function TCustomCGIApplication.GetEmail : String;
Var
H : String;
begin
If (FEmail='') then
begin
H:=Request.ServerName;
If (H<>'') then
Result:=Administrator+'@'+H
else
Result:='';
end
else
Result:=Email;
end;
Function TCustomCGIApplication.GetAdministrator : String;
begin
If (FADministrator<>'') then
Result:=FAdministrator
else
Result:=SWebMaster;
end;
Procedure TCustomCGIApplication.InitRequestVars;
var
R : String;
begin
R:=GetEnvironmentVariable('REQUEST_METHOD');
if (R='') then
Raise Exception.Create(SErrNoRequestMethod);
FRequest.InitFromEnvironment;
if CompareText(R,'POST')=0 then
Request.InitPostVars
else if CompareText(R,'GET')=0 then
Request.InitGetVars
else
Raise Exception.CreateFmt(SErrInvalidRequestMethod,[R]);
end;
constructor TCGIRequest.CreateCGI(ACGI: TCustomCGIApplication);
begin
Inherited Create;
FCGI:=ACGI;
end;
Type
TCapacityStream = Class(TMemoryStream)
Public
Property Capacity;
end;
Procedure TCGIRequest.InitPostVars;
Var
M : TCapacityStream;
I : TIOStream;
Cl : Integer;
B : Byte;
CT : String;
begin
{$ifdef CGIDEBUG}
SendMethodEnter('InitPostVars');
{$endif}
CL:=ContentLength;
M:=TCapacityStream.Create;
Try
I:=TIOStream.Create(iosInput);
Try
if (CL<>0) then
begin
M.Capacity:=Cl;
M.CopyFrom(I,Cl);
end
else
begin
While (I.Read(B,1)>0) do
M.Write(B,1)
end;
Finally
I.Free;
end;
M.Position:=0;
With TFileStream.Create('/tmp/query',fmCreate) do
try
CopyFrom(M,0);
M.Position:=0;
Finally
Free;
end;
CT:=ContentType;
if Pos('MULTIPART/FORM-DATA',Uppercase(CT))<>0 then
ProcessMultiPart(M,CT)
else if CompareText('APPLICATION/X-WWW-FORM-URLENCODED',CT)=0 then
ProcessUrlEncoded(M)
else
begin
{$ifdef CGIDEBUG}
SendDebug('InitPostVars: unsupported content type:'+CT);
{$endif}
Raise Exception.CreateFmt(SErrUnsupportedContentType,[CT]);
end;
finally
M.Free;
end;
{$ifdef CGIDEBUG}
SendMethodExit('InitPostVars');
{$endif}
end;
Procedure TCGIRequest.InitGetVars;
Var
FQueryString : String;
begin
{$ifdef CGIDEBUG}
SendMethodEnter('InitGetVars');
{$endif}
FQueryString:=GetEnvironmentVariable('QUERY_STRING');
If (FQueryString<>'') then
ProcessQueryString(FQueryString);
{$ifdef CGIDEBUG}
SendMethodExit('InitGetVars');
{$endif}
end;
const
hexTable = '0123456789ABCDEF';
Function TCustomCGIApplication.GetRequestVariable(Const VarName : String) : String;
begin
If Assigned(Request) then
Result:=FRequest.QueryFields.Values[VarName]
else
Result:='';
end;
Function TCustomCGIApplication.GetRequestVariableCount : Integer;
begin
If Assigned(Request) then
Result:=FRequest.QueryFields.Count
else
Result:=0;
end;
Procedure TCustomCGIApplication.AddResponse(Const S : String);
Var
L : Integer;
begin
L:=Length(S);
If L>0 then
Response.Content:=Response.Content+S;
end;
Procedure TCustomCGIApplication.AddResponse(Const Fmt : String; Args : Array of const);
begin
AddResponse(Format(Fmt,Args));
end;
Procedure TCustomCGIApplication.AddResponseLN(Const S : String);
begin
AddResponse(S+LineEnding);
end;
Procedure TCustomCGIApplication.AddResponseLN(Const Fmt : String; Args : Array of const);
begin
AddResponseLN(Format(Fmt,Args));
end;
Function TCustomCGIApplication.VariableIsUploadedFile(Const VarName : String) : boolean;
begin
// Result:=FFormFiles.IndexOfName(VarName)<>-1;
end;
Function TCustomCGIApplication.UploadedFileName(Const VarName : String) : String;
begin
// Result:=FRequest.Files.Values[VarName];
end;
{ TCGIHTTPRequest }
function TCGIRequest.GetCGIVar(Index: integer): String;
begin
Case Index of
1 : Result:=GetEnvironmentVariable(CGIVarNames[4]); // Property GatewayInterface : String Index 1 Read GetCGIVar;
2 : Result:=GetEnvironmentVariable(CGIVarNames[10]); // Property RemoteIdent : String Index 2 read GetCGIVar;
3 : Result:=GetEnvironmentVariable(CGIVarNames[11]); // Property RemoteUser : String Index 3 read GetCGIVar;
4 : Result:=GetEnvironmentVariable(CGIVarNames[12]); // Property RequestMethod : String Index 4 read GetCGIVar;
5 : Result:=GetEnvironmentVariable(CGIVarNames[14]); // Property ServerName : String Index 5 read GetCGIVar;
6 : Result:=GetEnvironmentVariable(CGIVarNames[16]); // Property ServerProtocol : String Index 6 read GetCGIVar;
7 : Result:=GetEnvironmentVariable(CGIVarNames[17]); // Property ServerSoftware : String Index 7 read GetCGIVar;
end;
end;
Procedure TCGIRequest.InitFromEnvironment;
Var
I : Integer;
N,V,OV : String;
begin
For I:=1 to CGIVarCount do
begin
N:=MapCgiToHTTP[i];
if (N<>'') then
begin
OV:=GetFieldByName(N);
V:=GetEnvironmentVariable(CGIVarNames[I]);
If (OV='') or (V<>'') then
SetFieldByName(N,V);
end;
end;
end;
Function TCGIRequest.GetFieldValue(Index : Integer) : String;
begin
Case Index of
25 : Result:=GetEnvironmentVariable(CGIVarNames[5]); // Property PathInfo
26 : Result:=GetEnvironmentVariable(CGIVarNames[6]); // Property PathTranslated
27 : Result:=GetEnvironmentVariable(CGIVarNames[8]); // Property RemoteAddress
28 : Result:=GetEnvironmentVariable(CGIVarNames[9]); // Property RemoteHost
29 : Result:=GetEnvironmentVariable(CGIVarNames[13]); // Property ScriptName
30 : Result:=GetEnvironmentVariable(CGIVarNames[15]); // Property ServerPort
else
Result:=Inherited GetFieldValue(Index);
end;
end;
{ TCGIResponse }
procedure TCGIResponse.DoSendHeaders(Headers : TStrings);
begin
if Assigned(FOutput) then
Headers.SaveToStream(FOutput);
end;
procedure TCGIResponse.DoSendContent;
begin
If Assigned(ContentStream) then
FOutput.CopyFrom(ContentStream,0)
else
Contents.SaveToStream(FOutput);
end;
constructor TCGIResponse.CreateCGI(ACGI: TCustomCGIApplication; AStream: TStream);
begin
inherited Create(ACGI.Request);
FCGI:=ACGI;
FOutput:=AStream;
end;
initialization
finalization
{$ifdef CGIDEBUG}
if (SendError<>'') then
Writeln('Debug failed: ',SendError);
{$endif}
end.

40
components/fpweb/lazweb.pp Normal file
View File

@ -0,0 +1,40 @@
{
Copyright (C) 2007 Michael Van Canneyt
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
{$mode objfpc}
{$H+}
unit lazweb;
Interface
uses Classes,lresources;
function InitResourceComponent(Instance: TComponent;
RootAncestor: TClass): Boolean;
Implementation
function InitResourceComponent(Instance: TComponent;
RootAncestor: TClass): Boolean;
begin
Result:=InitLazResourceComponent(Instance,RootAncestor);
end;
initialization
RegisterInitComponentHandler(TComponent,@InitResourceComponent);
end.

124
components/fpweb/weblaz.lpk Normal file
View File

@ -0,0 +1,124 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="2">
<Name Value="weblaz"/>
<CompilerOptions>
<Version Value="5"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CustomOptions Value="-dcgidebug
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="16">
<Item1>
<Filename Value="weblazideintf.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="WebLazIDEIntf"/>
</Item1>
<Item2>
<Filename Value="fpweb.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fpWeb"/>
</Item2>
<Item3>
<Filename Value="httpdefs.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="HTTPDefs"/>
</Item3>
<Item4>
<Filename Value="fphttp.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fphttp"/>
</Item4>
<Item5>
<Filename Value="fpcgi.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fpcgi"/>
</Item5>
<Item6>
<Filename Value="custcgi.pp"/>
<AddToUsesPkgSection Value="False"/>
<Type Value="Virtual Unit"/>
<UnitName Value="custcgi"/>
</Item6>
<Item7>
<Filename Value="lazweb.pp"/>
<UnitName Value="lazweb"/>
</Item7>
<Item8>
<Filename Value="fptemplate.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fpTemplate"/>
</Item8>
<Item9>
<Filename Value="htmldefs.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="HTMLDefs"/>
</Item9>
<Item10>
<Filename Value="htmlelements.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="htmlelements"/>
</Item10>
<Item11>
<Filename Value="htmlwriter.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="htmlwriter"/>
</Item11>
<Item12>
<Filename Value="webutil.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="webutil"/>
</Item12>
<Item13>
<Filename Value="fphtml.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fphtml"/>
</Item13>
<Item14>
<Filename Value="fpdatasetform.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fpdatasetform"/>
</Item14>
<Item15>
<Filename Value="websession.pp"/>
<Type Value="Virtual Unit"/>
<UnitName Value="websession"/>
</Item15>
<Item16>
<Filename Value="fpapache.pp"/>
<AddToUsesPkgSection Value="False"/>
<Type Value="Virtual Unit"/>
<UnitName Value="fpapache"/>
</Item16>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="IDEIntf"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item3>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="/home/michael/projects/lazarus/components/fpweb/"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

23
components/fpweb/weblaz.pas Normal file
View File

@ -0,0 +1,23 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit weblaz;
interface
uses
WebLazIDEIntf, fpWeb, HTTPDefs, fphttp, fpcgi, lazweb, fpTemplate, HTMLDefs,
htmlelements, htmlwriter, webutil, fphtml, fpdatasetform, websession,
LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('WebLazIDEIntf', @WebLazIDEIntf.Register);
end;
initialization
RegisterPackage('weblaz', @Register);
end.

436
components/fpweb/weblazideintf.pp Normal file
View File

@ -0,0 +1,436 @@
{
Copyright (C) 2007 Michael Van Canneyt
This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details.
You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
{$mode objfpc}
{$H+}
unit WebLazIDEIntf;
interface
uses
Classes, SysUtils, fpWeb, fpHTML, fpdatasetform,
Controls, Dialogs, forms, LazIDEIntf, ProjectIntf;
type
{ TCGIApplicationDescriptor }
TCGIApplicationDescriptor = class(TProjectDescriptor)
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;
{ TCGIApplicationDescriptor }
TApacheApplicationDescriptor = class(TProjectDescriptor)
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;
TCustomCGIApplicationDescriptor = class(TProjectDescriptor)
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;
{ TFileDescPascalUnitWithCGIDataModule }
TFileDescWebDataModule = class(TFileDescPascalUnitWithResource)
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function GetImplementationSource(const Filename, SourceName, ResourceName: string): string;override;
end;
TFileDescHTMLModule = class(TFileDescPascalUnitWithResource)
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function GetImplementationSource(const Filename, SourceName, ResourceName: string): string;override;
end;
var
ProjectDescriptorCustomCGIApplication: TCustomCGIApplicationDescriptor;
ProjectDescriptorCGIApplication: TCGIApplicationDescriptor;
ProjectDescriptorApacheApplication: TApacheApplicationDescriptor;
FileDescriptorHTMLModule: TFileDescHTMLModule;
FileDescriptorWebModule: TFileDescWebDataModule;
procedure Register;
implementation
uses LazarusPackageIntf,FormEditingIntf;
Const
fpWebTab = 'fpWeb';
Procedure RegisterHTMLComponents;
begin
RegisterComponents(fpWebTab,[THTMLDatasetContentProducer,
THTMLSelectProducer,
THTMLDatasetSelectProducer])
end;
Procedure RegisterDatasetComponents;
begin
RegisterComponents(fpWebTab,[THTMLDataSetFormShowProducer,
THTMLDataSetFormEditProducer,
THTMLDataSetFormGridProducer]);
end;
Procedure RegisterComponents;
begin
RegisterUnit('fphtml',@RegisterHTMLComponents);
RegisterUnit('fpdatasetform',@RegisterdatasetComponents);
end;
procedure Register;
begin
RegisterComponents;
FileDescriptorWebModule:=TFileDescWebDataModule.Create;
RegisterProjectFileDescriptor(FileDescriptorWebModule);
ProjectDescriptorCGIApplication:=TCGIApplicationDescriptor.Create;
RegisterProjectDescriptor(ProjectDescriptorCGIApplication);
FileDescriptorHTMLModule:=TFileDescHTMLModule.Create;
RegisterProjectFileDescriptor(FileDescriptorHTMLModule);
ProjectDescriptorCustomCGIApplication:=TCustomCGIApplicationDescriptor.Create;
RegisterProjectDescriptor(ProjectDescriptorCustomCGIApplication);
ProjectDescriptorApacheApplication:=TApacheApplicationDescriptor.Create;
RegisterProjectDescriptor(ProjectDescriptorApacheApplication);
FormEditingHook.RegisterDesignerBaseClass(TFPWebModule);
FormEditingHook.RegisterDesignerBaseClass(TFPHTMLModule);
end;
{ TCGIApplicationDescriptor }
constructor TCGIApplicationDescriptor.Create;
begin
inherited Create;
Name:='CGI Application';
end;
function TCGIApplicationDescriptor.GetLocalizedName: string;
begin
Result:='CGI Application';
end;
function TCGIApplicationDescriptor.GetLocalizedDescription: string;
begin
Result:='CGI Application'#13#13'A CGI (Common Gateway Interface) program '
+'in Free Pascal. The program file is '
+'automatically maintained by Lazarus.';
end;
function TCGIApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
var
le: string;
NewSource: String;
MainFile: TLazProjectFile;
begin
inherited InitProject(AProject);
MainFile:=AProject.CreateProjectFile('cgiproject1.lpr');
MainFile.IsPartOfProject:=true;
AProject.AddFile(MainFile,false);
AProject.MainFileID:=0;
// create program source
le:=LineEnding;
NewSource:='program cgiproject1;'+le
+le
+'{$mode objfpc}{$H+}'+le
+le
+'uses'+le
+' fpWeb,fpCGI;'+le
+le
+'begin'+le
+' Application.Title:=''cgiproject1'';'+le
+' Application.Initialize;'+le
+' Application.Run;'+le
+'end.'+le
+le;
AProject.MainFile.SetSourceText(NewSource);
// add
AProject.AddPackageDependency('WebLaz');
// compiler options
AProject.LazCompilerOptions.Win32GraphicApp:=false;
Result:= mrOK;
end;
function TCGIApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
begin
LazarusIDE.DoNewEditorFile(FileDescriptorWebModule,'','',
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
Result:= mrOK;
end;
{ TCustomCGIApplicationDescriptor }
constructor TCustomCGIApplicationDescriptor.Create;
begin
inherited Create;
Name:='Custom CGI Application';
end;
function TCustomCGIApplicationDescriptor.GetLocalizedName: string;
begin
Result:='Custom CGI Application';
end;
function TCustomCGIApplicationDescriptor.GetLocalizedDescription: string;
begin
Result:='Custom CGI Application'#13#13'A CGI (Common Gateway Interface) program '
+'in Free Pascal. The program file is '
+'automatically maintained by Lazarus.';
end;
function TCustomCGIApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
var
le: string;
NewSource: String;
MainFile: TLazProjectFile;
begin
inherited InitProject(AProject);
MainFile:=AProject.CreateProjectFile('cgiproject1.lpr');
MainFile.IsPartOfProject:=true;
AProject.AddFile(MainFile,false);
AProject.MainFileID:=0;
// create program source
le:=LineEnding;
NewSource:='program cgiproject1;'+le
+le
+'{$mode objfpc}{$H+}'+le
+le
+'uses'+le
+' Classes,SysUtils,httpDefs,custcgi;'+le
+le
+'Type'+le
+' TCGIApp = Class(TCustomCGIApplication)'+le
+' Public'+le
+' Procedure HandleRequest(ARequest : Trequest; AResponse : TResponse); override;'+le
+' end;'+le
+le
+'Procedure TCGIApp.HandleRequest(ARequest : Trequest; AResponse : TResponse);'+le
+le
+'begin'+le
+' // Your code here'+le
+'end;'+le
+le
+'begin'+le
+' With TCGIApp.Create(Nil) do'+le
+' try'+le
+' Initialize;'+le
+' Run;'+le
+' finally'+le
+' Free;'+le
+' end;'+le
+'end.'+le;
AProject.MainFile.SetSourceText(NewSource);
// add
AProject.AddPackageDependency('FCL');
AProject.AddPackageDependency('WebLaz');
// compiler options
AProject.LazCompilerOptions.Win32GraphicApp:=false;
Result:= mrOK;
end;
function TCustomCGIApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
begin
Result:= mrOK;
end;
{ TFileDescWebDataModule }
constructor TFileDescWebDataModule.Create;
begin
inherited Create;
Name:='Web Module';
ResourceClass:=TFPWebModule;
UseCreateFormStatements:=true;
end;
function TFileDescWebDataModule.GetInterfaceUsesSection: string;
begin
Result:=inherited GetInterfaceUsesSection;
Result:=Result+',LResources,HTTPDefs, websession, fpHTTP,fpWeb';
end;
function TFileDescWebDataModule.GetLocalizedName: string;
begin
Result:='Web Module';
end;
function TFileDescWebDataModule.GetLocalizedDescription: string;
begin
Result:='WEB Module'#13
+'A datamodule for WEB (HTTP) applications.';
end;
function TFileDescWebDataModule.GetImplementationSource(const Filename, SourceName, ResourceName: string): string;
begin
Result:=Inherited GetImplementationSource(FileName,SourceName,ResourceName);
Result:=Result+' RegisterHTTPModule(''T'+ResourceName+''',T'+ResourceName+');'+LineEnding;
end;
{ TFileDescHTMLModule }
constructor TFileDescHTMLModule.Create;
begin
inherited Create;
Name:='HTML Module';
ResourceClass:=TFPHTMLModule;
UseCreateFormStatements:=true;
end;
function TFileDescHTMLModule.GetInterfaceUsesSection: string;
begin
Result:=inherited GetInterfaceUsesSection;
Result:=Result+',LResources,HTTPDefs,websession,fpHTTP,htmlwriter,htmlelements,fphtml';
end;
function TFileDescHTMLModule.GetLocalizedName: string;
begin
Result:='HTML Web Module';
end;
function TFileDescHTMLModule.GetLocalizedDescription: string;
begin
Result:='HTML WEB Module'#13
+'A Web datamodule for producing strict HTML.';
end;
function TFileDescHTMLModule.GetImplementationSource(const Filename, SourceName, ResourceName: string): string;
begin
Result:=Inherited GetImplementationSource(FileName,SourceName,ResourceName);
Result:=Result+' RegisterHTTPModule(''T'+ResourceName+''',T'+ResourceName+');'+LineEnding;
end;
{ TApacheApplicationDescriptor }
constructor TApacheApplicationDescriptor.Create;
begin
inherited Create;
Name:='Apache Module';
end;
function TApacheApplicationDescriptor.GetLocalizedName: string;
begin
Result:='Apache Module';
end;
function TApacheApplicationDescriptor.GetLocalizedDescription: string;
begin
Result:='Apache module'#13#13'An Apache loadable module '
+'in Free Pascal. The main library file is '
+'automatically maintained by Lazarus.';
end;
function TApacheApplicationDescriptor.InitProject(AProject: TLazProject): TModalResult;
var
le: string;
NewSource: String;
MainFile: TLazProjectFile;
begin
inherited InitProject(AProject);
MainFile:=AProject.CreateProjectFile('mod_apache1.lpr');
MainFile.IsPartOfProject:=true;
AProject.AddFile(MainFile,false);
AProject.MainFileID:=0;
// create program source
le:=LineEnding;
NewSource:='Library mod_apache1;'+le
+le
+'{$mode objfpc}{$H+}'+le
+le
+'Uses'+le
+' fpWeb,lazweb,httpd,fpApache;'+le
+le
+'Const'+le
+le
+'{ The following constant is used to export the module record. It must '+le
+' always match the name in the LoadModule statement in the apache'+le
+' configuration file(s). It is case sensitive !}'+le
+' ModuleName=''mod_apache1'';'+le
+le
+'{ The following constant is used to determine whether the module will'+le
+' handle a request. It should match the name in the SetHandler statement'+le
+' in the apache configuration file(s). It is not case sensitive. }'+le
+le
+' HandlerName=ModuleName;'+le
+le
+'Var'+le
+' DefaultModule : module; {$ifdef unix} public name ModuleName;{$endif unix}'+le
+le
+'{$ifdef windows}'+le
+'Exports defaultmodule name ModuleName;'+le
+'{$endif windows}'+le
+le
+'begin'+le
+' Application.Title:=''mod_apache1'';'+le
+' Application.ModuleName:=ModuleName;'+le
+' Application.HandlerName:=HandlerName;'+le
+' Application.SetModuleRecord(DefaultModule);'+le
+' Application.Initialize;'+le
+'end.'+le
+le;
AProject.MainFile.SetSourceText(NewSource);
// add
AProject.AddPackageDependency('WebLaz');
// compiler options
AProject.LazCompilerOptions.Win32GraphicApp:=false;
Result:= mrOK;
end;
function TApacheApplicationDescriptor.CreateStartFiles(AProject: TLazProject): TModalResult;
begin
LazarusIDE.DoNewEditorFile(FileDescriptorWebModule,'','',
[nfIsPartOfProject,nfOpenInEditor,nfCreateDefaultSrc]);
Result:= mrOK;
end;
end.