📄 webserv1.pas
字号:
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function IsDirectory(const Path : String) : Boolean;
var
SR : TSearchRec;
begin
if FindFirst(Path, faDirectory or faAnyFile, SR) = 0 then
Result := ((SR.Attr and faDirectory) <> 0)
else
Result := FALSE;
FindClose(SR);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when HTTP server component receive a GET }
{ command from any client. }
{ We count the request, display a message and trap '/time.htm' path for }
{ special handling. }
{ There is no document time.htm on disk, we will create it on the fly. With }
{ a classic webserver we would have used a CGI or ISAPI/NSAPI to achieve }
{ the same goal. It is much easier here since we can use Delphi code }
{ directly to generate whatever we wants. Here for the demo we generate a }
{ page with server data and time displayed. }
procedure TWebServForm.HttpServer1GetDocument(
Sender : TObject; { HTTP server component }
Client : TObject; { Client connection issuing command }
var Flags : THttpGetFlag); { Tells what HTTP server has to do next }
var
ClientCnx : TMyHttpConnection;
begin
{ It's easyer to do the cast one time. Could use with clause... }
ClientCnx := TMyHttpConnection(Client);
{ Count request and display a message }
Inc(FCountRequests);
Display('[' + FormatDateTime('HH:NN:SS', Now) + ' ' +
ClientCnx.GetPeerAddr + '] ' + IntToStr(FCountRequests) +
': ' + ClientCnx.Version + ' GET ' + ClientCnx.Path);
DisplayHeader(ClientCnx);
{ Trap '/demo.htm' to dynamically generate a simple HTML document }
if CompareText(ClientCnx.Path, '/demo.htm') = 0 then
CreateVirtualDocument_demo_htm(Sender, ClientCnx, Flags)
{ Trap '/time.htm' path to dynamically generate a dynamic answer. }
else if CompareText(ClientCnx.Path, '/time.htm') = 0 then
CreateVirtualDocument_time_htm(Sender, ClientCnx, Flags)
{ Trap '/myip.htm' path to dynamically generate a dynamic answer. }
else if CompareText(ClientCnx.Path, '/myip.htm') = 0 then
CreateVirtualDocument_myip_htm(Sender, ClientCnx, Flags)
{ Trap '/redir.htm' to dynamically generate a redirection answer }
else if CompareText(ClientCnx.Path, '/redir.htm') = 0 then
CreateVirtualDocument_redir_htm(Sender, ClientCnx, Flags)
{ Trap '/form.htm' to dynamically generate a HTML form answer }
else if CompareText(ClientCnx.Path, '/form.htm') = 0 then
CreateVirtualDocument_form_htm(Sender, ClientCnx, Flags)
{ Trap '/formdata.htm' to dynamically generate a HTML form answer }
else if CompareText(ClientCnx.Path, '/formdata.htm') = 0 then
CreateVirtualDocument_formdata_htm(Sender, ClientCnx, Flags);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is use to generate /demo.htm document }
procedure TWebServForm.CreateVirtualDocument_demo_htm(
Sender : TObject;
ClientCnx : TMyHttpConnection;
var Flags : THttpGetFlag);
begin
ClientCnx.AnswerString(Flags,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'', { Default header }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Demo - Menu</TITLE>' +
'</HEAD>' +
'<BODY>' +
'<H2>ICS WebServer Demo Menu</H2>' +
'<A HREF="/time.htm">Server time</A><BR>' +
'<A HREF="/form.htm">Data entry</A><BR>' +
'<A HREF="/formdata.htm">Show data file</A><BR>' +
'<A HREF="/redir.htm">Redirection</A><BR>' +
'<A HREF="/myip.htm">Show client IP</A><BR>' +
'<A HREF="/">Default document</A><BR>' +
'<A HREF="http://www.overbyte.be">ICS Home page</A><BR>' +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is use to generate /redir.htm document }
procedure TWebServForm.CreateVirtualDocument_redir_htm(
Sender : TObject; { HTTP server component }
ClientCnx : TMyHttpConnection; { Client connection issuing command }
var Flags : THttpGetFlag); { Tells what HTTP server has to do next }
var
Location : String;
begin
Location := ClientCnx.Params;
if Location = '' then
Location := Trim(RedirUrlEdit.text);
ClientCnx.AnswerString(Flags,
'302 Moved', { Tell the browser about relocation }
'', { Default Content-Type: text/html }
'Location: ' + Location + #13#10, { Specify new location }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Demo - Redir</TITLE>' +
'</HEAD>' + #13#10 +
'<BODY>' +
'You should be redirected automatically !<BR>' + #13#10 +
'<A HREF="' + Location + '">Click Here</A><BR>' + #13#10 +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is use to generate /time.htm document }
procedure TWebServForm.CreateVirtualDocument_time_htm(
Sender : TObject; { HTTP server component }
ClientCnx : TMyHttpConnection; { Client connection issuing command }
var Flags : THttpGetFlag); { Tells what HTTP server has to do next }
begin
ClientCnx.AnswerString(Flags,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'Pragma: no-cache' + #13#10 + { No client caching please }
'Expires: -1' + #13#10, { I said: no caching ! }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Demo</TITLE>' +
'</HEAD>' + #13#10 +
'<BODY>' +
'<H2>Time at server side:</H2>' + #13#10 +
'<P>' + DateTimeToStr(Now) +'</P>' + #13#10 +
'<A HREF="/demo.htm">Demo menu</A>' + #13#10 +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.CreateVirtualDocument_myip_htm(
Sender : TObject;
ClientCnx : TMyHttpConnection;
var Flags : THttpGetFlag);
begin
ClientCnx.AnswerString(Flags,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'Pragma: no-cache' + #13#10 + { No client caching please }
'Expires: -1' + #13#10, { I said: no caching ! }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Demo</TITLE>' +
'</HEAD>' + #13#10 +
'<BODY>' +
'Your IP is: ' +
ClientCnx.PeerAddr + #13#10 +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is use to generate /formdata.htm document which display }
{ data entered with form.htm virtual document. }
procedure TWebServForm.CreateVirtualDocument_formdata_htm(
Sender : TObject; { HTTP server component }
ClientCnx : TMyHttpConnection; { Client connection issuing command }
var Flags : THttpGetFlag); { Tells what HTTP server has to do next }
var
Body : String;
Line : String;
F : TextFile;
begin
Body := '<HTML><HEAD>' +
'<TITLE>ICS WebServ - Form Demo - Data File</TITLE>' +
'</HEAD><BODY>' +
'<A HREF="/demo.htm">Demo menu</A> ' +
'<A HREF="/form.htm">Data entry</A><HR>';
{ Append data file content to HTML answer }
try
AssignFile(F, 'FormHandler.txt');
Reset(F);
try
while not Eof(F) do begin
ReadLn(F, Line);
Body := Body + TextToHtmlText(Line) + '<BR>';
end;
Body := Body + '<HR>';
finally
CloseFile(F);
end;
except
on E:Exception do
Body := '<HTML><BODY>' + E.ClassName + ': ' + E.Message;
end;
Body := Body + '</BODY></HTML>';
ClientCnx.AnswerString(Flags,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'Pragma: no-cache' + #13#10 + { No client caching please }
'Expires: -1' + #13#10, { I said: no caching ! }
Body);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This procedure is use to generate /form.htm document }
procedure TWebServForm.CreateVirtualDocument_form_htm(
Sender : TObject; { HTTP server component }
ClientCnx : TMyHttpConnection; { Client connection issuing command }
var Flags : THttpGetFlag); { Tells what HTTP server has to do next }
begin
ClientCnx.AnswerString(Flags,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'', { Default header }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServ Form Demo</TITLE>' +
'</HEAD>' +
'<BODY>' +
'<H2>Enter your first and last name</H2>' +
'<FORM METHOD="POST" ACTION="/cgi-bin/FormHandler">' +
'<P>This demo form show how to handle posted data. ' +
'The "send" button on the form below will post form data ' +
'to the virtual script /cgi-bin/FormHandler which is ' +
'purely implemented in Delphi code withing WebServ demo. ' +
'Data is written to <A HREF="/FormData.htm">' +
'FormHanlder.txt</A> text file. ' +
'<BR><HR><BR>' +
'<TABLE BORDER="0" ALIGN="DEFAULT">' +
'<TR>' +
'<TD>First name: </TD>' +
'<TD><INPUT TYPE="TEXT" NAME="FirstName"' +
' MAXLENGTH="25"></TD>' +
'</TR>' +
'<TR>' +
'<TD>Last name: </TD>' +
'<TD><INPUT TYPE="TEXT" NAME="LastName"' +
' MAXLENGTH="25"></TD>' +
'</TR>' +
'<TR>' +
'<TD> </TD><TD><INPUT TYPE="SUBMIT" NAME="Submit"' +
' VALUE="Send"></TD>' +
'</TR>' +
'</TABLE>' +
'<HR><A HREF="/demo.htm">Demo menu</A>' +
'</FORM>' +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered when HTTP server component receive a POST }
{ command from any client. }
{ We count the request, display a message and trap posted data. }
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -