mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-28 23:19:18 +02:00
+ Initial revision
This commit is contained in:
parent
30482e6320
commit
0a9a114b75
202
fcl/win32/httpapp.pp
Normal file
202
fcl/win32/httpapp.pp
Normal file
@ -0,0 +1,202 @@
|
|||||||
|
{
|
||||||
|
$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.1 1998-10-01 21:56:15 florian
|
||||||
|
+ Initial revision
|
||||||
|
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user