mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 23:29:27 +02:00
203 lines
4.7 KiB
ObjectPascal
203 lines
4.7 KiB
ObjectPascal
{
|
|
$Id$
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 1998 by Florian Klaempfl
|
|
member of the Free Pascal development team
|
|
|
|
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.
|
|
|
|
**********************************************************************}
|
|
|
|
unit httpapp;
|
|
|
|
interface
|
|
|
|
uses
|
|
sysutils,classes,syncobjs;
|
|
|
|
const
|
|
DateFormat = 'ddd, dd mmm yyyy hh:mm:ss';
|
|
|
|
MAX_STRINGS = 12;
|
|
MAX_INTEGERS = 1;
|
|
MAX_DATETIMES = 3;
|
|
|
|
type
|
|
TCharSet = set of Char;
|
|
TMethodType = (mtAny,mtGet,mtPut,mtPost,mtHead);
|
|
|
|
TWebApp = class(TComponent)
|
|
protected
|
|
function ActivateWebModule : TDataModule;
|
|
procedure DeactivateWebModule(DataModule : TDataModule);
|
|
procedure DoHandleException(E : Exception);dynamic;
|
|
function HandleRequest(Request : TWebRequest;Response : TWebResponse) : Boolean;
|
|
public
|
|
constructor Create(AOwner : TComponent);override;
|
|
procedure CreateForm(InstanceClass: TComponentClass;var Reference);virtual;
|
|
destructor Destroy;override;
|
|
procedure Initialize;virtual;
|
|
procedure Run;virtual;
|
|
end;
|
|
|
|
function DosPathToUnixPath(const Path : string) : string;
|
|
function UnixPathToDosPath(const Path : string) : string;
|
|
|
|
function HTTPDecode(const str : String) : string;
|
|
function HTTPEncode(const str : String) : string;
|
|
|
|
function ParseDate(const DateStr : string) : TDateTime;
|
|
procedure ExtractHTTPFields(Separators,WhiteSpace : TCharSet;
|
|
Content : PChar;Strings : TStrings);
|
|
procedure ExtractHeaderFields(Separators,WhiteSpace : TCharSet;
|
|
Content: PChar;Strings : TStrings;Decode : Boolean);
|
|
|
|
function StatusString(StatusCode : Integer) : string;
|
|
|
|
const
|
|
Application : TWebApp = nil;
|
|
|
|
implementation
|
|
|
|
function TWebApp.ActivateWebModule : TDataModule;
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure TWebApp.DeactivateWebModule(DataModule : TDataModule);
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure TWebApp.DoHandleException(E : Exception);
|
|
|
|
begin
|
|
end;
|
|
|
|
function TWebApp.HandleRequest(Request : TWebRequest;Response : TWebResponse) : Boolean;
|
|
|
|
begin
|
|
end;
|
|
|
|
constructor TWebApp.Create(AOwner : TComponent);
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure TWebApp.CreateForm(InstanceClass: TComponentClass;var Reference);
|
|
|
|
begin
|
|
end;
|
|
|
|
destructor TWebApp.Destroy;
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure TWebApp.Initialize;
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure TWebApp.Run;
|
|
|
|
begin
|
|
end;
|
|
|
|
function DosPathToUnixPath(const Path : string) : string;
|
|
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
Result:=Path;
|
|
for i:=1 to Length(Result) do
|
|
if Result[i]='\' then
|
|
Result[i]:='/';
|
|
end;
|
|
|
|
function UnixPathToDosPath(const Path : string) : string;
|
|
|
|
var
|
|
i : integer;
|
|
|
|
begin
|
|
Result:=Path;
|
|
for i:=1 to Length(Result) do
|
|
if Result[i]='/' then
|
|
Result[i]:='\';
|
|
end;
|
|
|
|
function HTTPDecode(const str : String) : string;
|
|
|
|
begin
|
|
end;
|
|
|
|
function HTTPEncode(const str : String) : string;
|
|
|
|
const
|
|
noconvert = ['A'..'Z','a'..'z','*','@','.',
|
|
'.','_','-','0'..'9','$','!','''','(',')'];
|
|
|
|
const
|
|
hex2str : array[0..15] of char = '0123456789ABCDEF';
|
|
|
|
var
|
|
i : integer;
|
|
c : char;
|
|
s : shortstring;
|
|
|
|
begin
|
|
// allocate some space for the result
|
|
SetLength(Result,Length(str));
|
|
for i:=1 to length(str) do
|
|
begin
|
|
c:=str[i];
|
|
if c in noconvert then
|
|
Result:=Result+c;
|
|
else if c=' ' then
|
|
Result:=Result+'+'
|
|
else
|
|
Result:=Result+'%'+
|
|
hex2str[ord(c) shr 4]+
|
|
hex2str[ord(c) and $f];
|
|
end;
|
|
end;
|
|
|
|
function ParseDate(const DateStr : string) : TDateTime;
|
|
|
|
begin
|
|
end;
|
|
|
|
procedure ExtractHTTPFields(Separators,WhiteSpace : TCharSet;
|
|
Content : PChar;Strings : TStrings);
|
|
|
|
begin
|
|
ExtractHeaderFields(Separators,WhiteSpace,Content,Strings,True);
|
|
end;
|
|
|
|
procedure ExtractHeaderFields(Separators,WhiteSpace : TCharSet;
|
|
Content: PChar;Strings : TStrings;Decode : Boolean);
|
|
|
|
begin
|
|
end;
|
|
|
|
function StatusString(StatusCode : Integer) : string;
|
|
|
|
begin
|
|
end;
|
|
|
|
end.
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.3 2002-09-07 15:15:29 peter
|
|
* old logs removed and tabs fixed
|
|
|
|
}
|