📄 webserv1.pas
字号:
{ <BODY> }
{ <H2>Enter your first and last name</H2> }
{ <FORM METHOD="POST" ACTION="/cgi-bin/cgifrm1.exe"> }
{ <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
Remote : TMyHttpConnection;
begin
{ It's easyer to do the cast one time. Could use with clause... }
Remote := TMyHttpConnection(Client);
{ Count request and display a message }
Inc(FCountRequests);
Display(IntToStr(FCountRequests) + ': POST ' + Remote.Path);
DisplayHeader(Remote);
{ Check for request past. We only accept data for '/cgi-bin/cgifrm1.exe' }
if CompareText(Remote.Path, '/cgi-bin/cgifrm1.exe') = 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. }
Remote.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 Remote.FPostedDataSize = 0 then begin
Remote.FPostedDataSize := Remote.RequestContentLength + 1;
GetMem(Remote.FPostedDataBuffer, Remote.FPostedDataSize);
end
else begin
ReallocMem(Remote.FPostedDataBuffer, Remote.FPostedDataSize, Remote.RequestContentLength + 1);
Remote.FPostedDataSize := Remote.RequestContentLength + 1;
end;
{$ELSE}
ReallocMem(Remote.FPostedDataBuffer, Remote.RequestContentLength + 1);
{$ENDIF}
{ Clear received length }
Remote.FDataLen := 0;
end
else
Flags := hg404;
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;
Remote : TMyHttpConnection;
begin
{ It's easyer to do the cast one time. Could use with clause... }
Remote := TMyHttpConnection(Client);
{ How much data do we have to receive ? }
Remains := Remote.RequestContentLength - Remote.FDataLen;
if Remains <= 0 then begin
{ We got all our data. Junk anything else ! }
Len := Remote.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 := Remote.Receive(Remote.FPostedDataBuffer + Remote.FDataLen, Remains);
{ Sometimes, winsock doesn't wants to givve any data... }
if Len <= 0 then
Exit;
{ Add received length to our count }
Inc(Remote.FDataLen, Len);
{ Add a nul terminating byte (handy to handle data as a string) }
Remote.FPostedDataBuffer[Remote.FDataLen] := #0;
{ Display receive data so far }
Display('Data: ''' + StrPas(Remote.FPostedDataBuffer) + '''');
{ When we received the whole thing, we can process it }
if Remote.FDataLen = Remote.RequestContentLength then begin
if CompareText(Remote.Path, '/cgi-bin/cgifrm1.exe') = 0 then
ProcessPostedData_CgiFrm1(Remote)
else
Remote.Answer404;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{ This will process posted data for CgiFrm1.exe }
procedure TWebServForm.ProcessPostedData_CgiFrm1(Client : TMyHttpConnection);
var
Stream : TStream;
FileName : String;
Body : String;
Header : String;
FirstName : String;
LastName : String;
HostName : String;
Buf : String;
begin
{ Extract fields from posted data. }
ExtractURLEncodedValue(Client.FPostedDataBuffer, 'FirstName', FirstName);
ExtractURLEncodedValue(Client.FPostedDataBuffer, 'LastName', LastName);
{ Get client IP address. We could to ReverseDnsLookup to get hostname }
HostName := Client.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) + 'CgiFrm1.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;
{ Now create output stream to send back to remote client }
Stream := TMemoryStream.Create;
Body := '<HTML>' +
'<HEAD>' +
'<TITLE>ICS WebServer Demo</TITLE>' +
'</HEAD>' + #13#10 +
'<BODY>' +
'<H2>Your data has been recorded:</H2>' + #13#10 +
'<P>' + FirstName + '.' + LastName + '@' + HostName +'</P>' +
'</BODY>' +
'</HTML>' + #13#10;
Header := Client.Version + ' 200 OK' + #13#10 +
'Content-Type: text/html' + #13#10 +
'Content-Length: ' +
IntToStr(Length(Body)) + #13#10 +
#13#10;
Stream.Write(Header[1], Length(Header));
Stream.Write(Body[1], Length(Body));
Stream.Seek(0, 0);
{ Ask HTTP server component to send data stream for us }
Client.DocStream := Stream;
Client.SendStream;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TWebServForm.DisplayHeader(Client : TMyHttpConnection);
var
I : Integer;
begin
if not DisplayHeaderCheckBox.Checked then
Exit;
for I := 0 to Client.RequestHeader.Count - 1 do
Display('HDR' + IntToStr(I + 1) + ') ' +
Client.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 + -