📄 webserv1.pas
字号:
{ To check for posted data, you may construct the following HTML document: }
{ <HTML> }
{ <HEAD> }
{ <TITLE>Test Form 1</TITLE> }
{ </HEAD> }
{ <BODY> }
{ <H2>Enter your first and last name</H2> }
{ <FORM METHOD="POST" ACTION="/cgi-bin/FormHandler"> }
{ <TABLE BORDER="0" ALIGN="DEFAULT" WIDTH="100%"> }
{ <TR> }
{ <TD>First name</TD> }
{ <TD><INPUT TYPE="TEXT" NAME="FirstName" }
{ MAXLENGTH="25" VALUE="YourFirstName"></TD> }
{ </TR> }
{ <TR> }
{ <TD>Last name</TD> }
{ <TD><INPUT TYPE="TEXT" NAME="LastName" }
{ MAXLENGTH="25" VALUE="YourLastName"></TD> }
{ </TR> }
{ </TABLE> }
{ <P><INPUT TYPE="SUBMIT" NAME="Submit" VALUE="Button"></P> }
{ </FORM> }
{ </BODY> }
{ </HTML> }
procedure TWebServForm.HttpServer1PostDocument(
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 + ' POST ' + ClientCnx.Path);
DisplayHeader(ClientCnx);
{ Check for request past. We only accept data for '/cgi-bin/FormHandler' }
if CompareText(ClientCnx.Path, '/cgi-bin/FormHandler') = 0 then begin
{ Tell HTTP server that we will accept posted data }
{ OnPostedData event will be triggered when data comes in }
Flags := hgAcceptData;
{ We wants to receive any data type. So we turn line mode off on }
{ client connection. }
ClientCnx.LineMode := FALSE;
{ We need a buffer to hold posted data. We allocate as much as the }
{ size of posted data plus one byte for terminating nul char. }
{ We should check for ContentLength = 0 and handle that case... }
{$IFDEF VER80}
if ClientCnx.FPostedDataSize = 0 then begin
ClientCnx.FPostedDataSize := ClientCnx.RequestContentLength + 1;
GetMem(ClientCnx.FPostedDataBuffer, ClientCnx.FPostedDataSize);
end
else begin
ReallocMem(ClientCnx.FPostedDataBuffer, ClientCnx.FPostedDataSize,
ClientCnx.RequestContentLength + 1);
ClientCnx.FPostedDataSize := ClientCnx.RequestContentLength + 1;
end;
{$ELSE}
ReallocMem(ClientCnx.FPostedDataBuffer,
ClientCnx.RequestContentLength + 1);
{$ENDIF}
{ Clear received length }
ClientCnx.FDataLen := 0;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This event handler is triggered for each data packet posted by client }
{ when we told HTTP server component that we will accept posted data. }
{ We have to receive ALL data which is sent by remote client, even if there }
{ is more than what ContentLength tells us ! }
{ If ContentLength = 0, then we should receive data until connection is }
{ closed... }
procedure TWebServForm.HttpServer1PostedData(
Sender : TObject; { HTTP server component }
Client : TObject; { Client posting data }
Error : Word); { Error in data receiving }
var
Len : Integer;
Remains : Integer;
Junk : array [0..255] of char;
ClientCnx : TMyHttpConnection;
begin
{ It's easyer to do the cast one time. Could use with clause... }
ClientCnx := TMyHttpConnection(Client);
{ How much data do we have to receive ? }
Remains := ClientCnx.RequestContentLength - ClientCnx.FDataLen;
if Remains <= 0 then begin
{ We got all our data. Junk anything else ! }
Len := ClientCnx.Receive(@Junk, SizeOf(Junk) - 1);
if Len >= 0 then
Junk[Len] := #0;
Exit;
end;
{ Receive as much data as we need to receive. But warning: we may }
{ receive much less data. Data will be split into several packets we }
{ have to assemble in our buffer. }
Len := ClientCnx.Receive(ClientCnx.FPostedDataBuffer + ClientCnx.FDataLen, Remains);
{ Sometimes, winsock doesn't wants to givve any data... }
if Len <= 0 then
Exit;
{ Add received length to our count }
Inc(ClientCnx.FDataLen, Len);
{ Add a nul terminating byte (handy to handle data as a string) }
ClientCnx.FPostedDataBuffer[ClientCnx.FDataLen] := #0;
{ Display receive data so far }
Display('Data: ''' + StrPas(ClientCnx.FPostedDataBuffer) + '''');
{ When we received the whole thing, we can process it }
if ClientCnx.FDataLen = ClientCnx.RequestContentLength then begin
{ First we must tell the component that we've got all the data }
ClientCnx.PostedDataReceived;
{ Then we check if the request is one we handle }
if CompareText(ClientCnx.Path, '/cgi-bin/FormHandler') = 0 then
{ We are happy to handle this one }
ProcessPostedData_FormHandler(ClientCnx)
else
{ We don't accept any other request }
ClientCnx.Answer404;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will process posted data for FormHandler }
{ Data is saved in FormHandler.txt file }
procedure TWebServForm.ProcessPostedData_FormHandler(
ClientCnx : TMyHttpConnection);
var
Stream : TStream;
FileName : String;
FirstName : String;
LastName : String;
HostName : String;
Buf : String;
Dummy : THttpGetFlag;
begin
{ Extract fields from posted data. }
ExtractURLEncodedValue(ClientCnx.FPostedDataBuffer, 'FirstName', FirstName);
ExtractURLEncodedValue(ClientCnx.FPostedDataBuffer, 'LastName', LastName);
{ Get client IP address. We could to ReverseDnsLookup to get hostname }
HostName := ClientCnx.PeerAddr;
{ Build the record to write to data file }
Buf := FormatDateTime('YYYYMMDD HHNNSS ', Now) +
FirstName + '.' + LastName + '@' + HostName + #13#10;
{ Save data to a text file }
FileName := ExtractFilePath(Application.ExeName) + 'FormHandler.txt';
if FileExists(FileName) then
Stream := TFileStream.Create(FileName, fmOpenWrite)
else
Stream := TFileStream.Create(FileName, fmCreate);
Stream.Seek(0, soFromEnd);
Stream.Write(Buf[1], Length(Buf));
Stream.Destroy;
{ Here is the place to check for valid input data and produce a HTML }
{ answer according to data validation. }
{ Here for simplicity, we don't check data and always produce the }
{ same HTML answer. }
ClientCnx.AnswerString(Dummy,
'', { Default Status '200 OK' }
'', { Default Content-Type: text/html }
'', { Default header }
'<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Form Demo</TITLE>' +
'</HEAD>' + #13#10 +
'<BODY>' +
'<H2>Your data has been recorded:</H2>' + #13#10 +
'<P>' + TextToHtmlText(FirstName) + '.' +
TextToHtmlText(LastName) + '@' +
TextToHtmlText(HostName) +'</P>' +
'<A HREF="/form.htm">More data entry</A><BR>' +
'<A HREF="/FormData.htm">View data file</A><BR>' +
'<A HREF="/demo.htm">Back to demo menu</A><BR>' +
'</BODY>' +
'</HTML>');
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.DisplayHeader(ClientCnx : TMyHttpConnection);
var
I : Integer;
begin
if not DisplayHeaderCheckBox.Checked then
Exit;
for I := 0 to ClientCnx.RequestHeader.Count - 1 do
Display('HDR' + IntToStr(I + 1) + ') ' +
ClientCnx.RequestHeader.Strings[I]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ We need to override parent class destructor because we have allocated }
{ memory for our data buffer. }
destructor TMyHttpConnection.Destroy;
begin
if Assigned(FPostedDataBuffer) then begin
FreeMem(FPostedDataBuffer, FPostedDataSize);
FPostedDataBuffer := nil;
FPostedDataSize := 0;
end;
inherited Destroy;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.OpenLogFile;
begin
if FLogFileOpened then
Exit;
try
AssignFile(FLogFile, FLogFileName);
if FileExists(FLogFileName) then
Append(FLogFile)
else
Rewrite(FLogFile);
WriteLn(FLogFile, '[' + FormatDateTime('HH:NN:SS YYYY/MM/DD', Now) +
' Log file opened.]');
FLogFileOpened := TRUE;
except
FLogFileOpened := FALSE;
Display('*** Unable to open log file ***');
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.CloseLogFile;
begin
if not FLogFileOpened then
Exit;
FLogFileOpened := FALSE;
WriteLn(FLogFile, '[' + FormatDateTime('HH:NN:SS YYYY/MM/DD', Now) +
' Log file Closed.]');
CloseFile(FLogFile);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.WriteLogFileCheckBoxClick(Sender: TObject);
begin
if WriteLogFileCheckBox.Checked then
OpenLogFile
else
CloseLogFile;
WriteLogFileCheckBox.Checked := FLogFileOpened;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -