unit Unit4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdCustomTCPServer,
IdCustomHTTPServer, IdHTTPServer, idContext, HTTPApp, HTTPProd;
type
TForm4 =
class(TForm)
IdHTTPServer1: TIdHTTPServer;
Button1: TButton;
Label1: TLabel;
Button2: TButton;
PageProducer1: TPageProducer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure IdHTTPServer1AfterBind(Sender: TObject);
procedure pgpEHTMLHTMLTag(Sender: TObject; Tag: TTag;
const TagString:
String; TagParams: TStrings;
var ReplaceText:
String);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
procedure TForm4.Button1Click(Sender: TObject);
begin
IdHTTPServer1.Active := false;
IdHTTPServer1.DefaultPort := 8888;
// Port 8888 ist Standard
try
IdHTTPServer1.Active := true;
except
raise;
end;
if IdHTTPServer1.Active
then
begin
label1.Caption := '
Server ist: ONLINE an Port 8888';
end;
end;
procedure TForm4.Button2Click(Sender: TObject);
begin
try
IdHTTPServer1.Active := false;
except
raise;
end;
if not IdHTTPServer1.Active
then
begin
Label1.Caption := '
Server ist: OFFLINE';
end;
end;
procedure TForm4.pgpEHTMLHTMLTag(Sender: TObject; Tag: TTag;
const TagString:
String; TagParams: TStrings;
var ReplaceText:
String);
var
LTag:
String;
begin
LTag := LowerCase(TagString);
if LTag = '
date'
then
ReplaceText := DateToStr(Now)
else if LTag = '
time'
then
ReplaceText := TimeToStr(Now)
else if LTag = '
datetime'
then
ReplaceText := DateTimeToStr(Now)
else if LTag = '
server'
then
// ReplaceText := 'Meinserver'.'Indy';
end;
procedure TForm4.IdHTTPServer1AfterBind(Sender: TObject);
begin
//
end;
procedure TForm4.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
Var
Stream: TFilestream;
TheString :
String;
I: Integer;
RequestedDocument, FileName, CheckFileName:
String;
begin
// requested document
RequestedDocument := ARequestInfo.Document;
// convert all '/' to '\'
FileName := RequestedDocument;
I := Pos('
/', FileName);
while I > 0
do
begin
FileName[I] := '
\';
I := Pos('
/', FileName);
end;
// locate requested file
// FileName := '.\' + FileName;
//MYCODE START
try
// check whether file or folder was requested
if AnsiLastChar(FileName)^ = '
\'
then
// folder - reroute to default document
CheckFileName := FileName + '
index.html'
else
// file - use it
CheckFileName := FileName;
if FileExists(CheckFileName)
then
begin
// file exists
if LowerCase(ExtractFileExt(CheckFileName)) = '
.ehtm'
then
begin
// Extended HTML - send through internal tag parser
PageProducer1 := PageProducer1.Create(Self);
try
// set source file name
PageProducer1.HTMLFile := CheckFileName;
// set event handler
PageProducer1.OnHTMLTag := pgpEHTMLHTMLTag;
// parse !
AResponseInfo.ContentText := PageProducer1.Content;
finally
PageProducer1.Free;
end;
end else begin
// return file as-is
// log
// Log('Returning Document: ' + CheckFileName);
// open file stream
AResponseInfo.ContentStream :=
TFileStream.Create(CheckFileName, fmOpenRead
or fmShareCompat);
end;
end;
finally
if Assigned(AResponseInfo.ContentStream)
then
begin
// response stream does exist
// set length
AResponseInfo.ContentLength := AResponseInfo.ContentStream.Size;
// write header
AResponseInfo.WriteHeader;
// return content
AResponseInfo.WriteContent;
// free stream
AResponseInfo.ContentStream.Free;
AResponseInfo.ContentStream :=
nil;
end else if AResponseInfo.ContentText <> '
'
then begin
// set length
AResponseInfo.ContentLength := Length(AResponseInfo.ContentText);
// write header
AResponseInfo.WriteHeader;
// return content
end else begin
if not AResponseInfo.HeaderHasBeenWritten
then
begin
// set error code
AResponseInfo.ResponseNo := 404;
AResponseInfo.ResponseText := '
Document not found';
// write header
AResponseInfo.WriteHeader;
end;
// return content
AResponseInfo.ContentText := '
The document requested is not availabe.';
AResponseInfo.WriteContent;
end;
end;
//MYCODE END
if ARequestInfo.Document = '
/'
then begin
AResponseInfo.ContentType := '
image/jpeg';
IF fileexists('
test.jpg') = true
then ARequestInfo.Document := '
test.jpg';
end;
Stream := TfileStream.Create('
test.jpg', fmOpenRead
or fmShareDenyWrite );
AResponseInfo.ContentStream := Stream;
setlength(TheString, stream.size);
stream.
Read(TheString[1], stream.size);
end;
end.