Marco Cantù 1998, Mastering Delphi 4
Project: CGIEMPL.DPR
Project Structure
CGIEMPL.DPR
program CgiEmpl;
{$APPTYPE CONSOLE}
uses
Windows, SysUtils, DBTables, DB;
var
ScriptName: array [0..100] of Char;
PathName: array [0..30] of Char;
MethodName: array [0..5] of Char;
Table1: TTable;
procedure ShowHeader; forward;
procedure ShowRecord; forward;
function ExtractFromData (
DataStr: string; SearchTag: string): string; forward;
procedure ShowHeader;
begin
writeln('Content type: text/html');
writeln;
writeln('<HTML><HEAD>');
writeln('<TITLE>CgiEmpl</TITLE>');
writeln('</HEAD><BODY>');
writeln('<H2>CGI Employee Demo</H2>');
writeln('<HR>');
end;
procedure ShowTableIndex;
begin
// show a summary of the entire table
Table1.First;
// show a list
writeln ('<ul>');
while not Table1.EOF do
begin
// show the names with a link to the CGI application
writeln (Format (
'<li> <a HREF="%s/record?LastName=%s+FirstName=%s">%s %s</a>',
[ScriptName,
Table1.FieldByName ('LastName').AsString,
Table1.FieldByName ('FirstName').AsString,
Table1.FieldByName ('FirstName').AsString,
Table1.FieldByName ('LastName').AsString]));
Table1.Next;
end;
// end of the list
writeln ('</ul>');
end;
procedure ShowRecord;
var
DataStr, First, Last: string;
ContentLength: array [0..10] of Char;
I: Integer;
ch: Char;
begin
if StrComp (MethodName, 'POST') = 0 then
begin
// method is post: read from the input
GetEnvironmentVariable ('CONTENT_LENGTH',
ContentLength, sizeof (ContentLength));
SetLength (DataStr, StrToIntDef (ContentLength, 255));
// doesn't work on PWS for Win98!
readln (DataStr);
end
else
begin
// method is get: read the query string
SetLength (DataStr, 255);
GetEnvironmentVariable ('QUERY_STRING',
PChar (DataStr), Length (DataStr));
DataStr := pChar (DataStr);
end;
// extract the paraemters
First := ExtractFromData (DataStr, 'FirstName');
Last := ExtractFromData (DataStr, 'LastName');
// debug information
writeln ('<i>Request (Post): Last Name = "' + Last +
'", First Name = "' + First + '"</i><p>');
// move to the requested record
if Last <> '' then
Table1.FindNearest ([Last, First])
else
// look for the first name only
Table1.Locate('FirstName', First,
[loPartialKey, loCaseInsensitive]);
// output the current record
writeln ('<table border>');
for I := 1 to Table1.FieldCount - 1 do
writeln ('<tr><td>' + Table1.Fields [I].FieldName +
'</td><td>' + Table1.Fields [I].AsString +
'</td></tr>');
writeln ('</table><hr>');
writeln ('<table border><tr>');
// add pointer to the index
writeln ('<td><a HREF="' +
ScriptName + '"> Index </a></td>');
// add pointer to the prior record
Table1.Prior;
if not Table1.BOF then
begin
writeln (Format (
'<td><a HREF="%s/record?LastName=%s+FirstName=%s"> Prior </a></td>',
[ScriptName,
Table1.FieldByName ('LastName').AsString,
Table1.FieldByName ('FirstName').AsString]));
// get back
Table1.Next;
end
else
// empty spot
writeln ('<td><i>Prior</i></td>');
// add pointer to the next record
Table1.Next;
if not Table1.EOF then
write (Format (
'<td><a HREF="%s/record?LastName=%s+FirstName=%s"> Next </a></td>',
[ScriptName,
Table1.FieldByName ('LastName').AsString,
Table1.FieldByName ('FirstName').AsString]))
else
// empty spot
writeln ('<td><i>Next</i></td>');
// end of the line and table
writeln ('</tr></table>');
end;
function ExtractFromData (
DataStr: string; SearchTag: string): string;
var
nPos: Integer;
begin
nPos := Pos (SearchTag + '=', DataStr);
if nPos > 0 then
begin
Result := Copy (DataStr, nPos + 1 + Length (SearchTag),
Length (DataStr) - nPos);
// the separator is +
nPos := Pos ('+', Result);
if nPos > 0 then
Result := Copy (Result, 1, nPos - 1);
end
else
Result := '';
// check for converted white spaces
repeat
nPos := Pos ('%20', Result);
if nPos > 0 then
Result := Copy (Result, 0, nPos - 1) + ' ' +
Copy (Result, nPos + 3, Length (Result));
until nPos = 0;
end;
// main program
begin
ShowHeader;
// get the name of the script,
// the method, and the path name
GetEnvironmentVariable ('SCRIPT_NAME',
ScriptName, sizeof (ScriptName));
GetEnvironmentVariable ('REQUEST_METHOD',
MethodName, sizeof (MethodName));
GetEnvironmentVariable ('PATH_INFO',
PathName, sizeof (PathName));
// debug
writeln ('<i>Script: ' + ScriptName +
', Method: ' + MethodName +
', Path: ' + PathName + '</i><p>');
// create and connect the table
Table1 := TTable.Create (nil);
try
Table1.DatabaseName := 'DBDEMOS';
Table1.TableName := 'Employee.db';
Table1.IndexName := 'ByName';
Table1.Open;
// if the pathname is 'record' then read the data
if (StrComp (PathName, '/record') = 0) then
begin
ShowRecord;
end
else
// no pathname: get the index
ShowTableIndex
finally
Table1.Close;
Table1.Free;
end;
// show footer
writeln('</BODY></HTML>');
end.
Copyright Marco Cantù 1998