📄 cgiempl.dpr

📁 Delphi高级开发指南是开发程序的好帮手
💻 DPR
字号:
program CgiEmpl;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, DBTables, DB;

var
  ScriptName: array [0..100] of Char;
  MethodName: array [0..5] of Char;
  Table1: TTable;

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('<H3>from Delphi Developer''s Handbook</H3>');
  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 names with a link to the CGI application
    writeln (Format (
      '<li> <a HREF="%s?%s+%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
  I: Integer;
begin
  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?%s+%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?%s+%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);
    nPos := Pos ('&', Result);
    if nPos > 0 then
      Result := Copy (Result, 1, nPos - 1);
  end
  else
    Result := '';
end;

procedure GetToRecordPost;
var
  DataStr, First, Last: string;
  ContentLength: array [0..10] of Char;
begin
  GetEnvironmentVariable ('CONTENT_LENGTH',
    ContentLength, sizeof (ContentLength));
  SetLength (DataStr, StrToIntDef (ContentLength, 100));
  readln (DataStr);
//  writeln ('<i>Debug: DataStr = ' + DataStr + '</i><p>');
  First := ExtractFromData (DataStr, 'FirstName');
  Last := ExtractFromData (DataStr, 'LastName');
  writeln ('<i>Request: Last Name = "' + Last +
    '", First Name = "' + First + '"</i><p>');
  if Last <> '' then
    Table1.FindNearest ([Last, First])
  else
    // look for the first name only
    Table1.Locate('FirstName', First,
      [loPartialKey, loCaseInsensitive]);
end;

begin
  ShowHeader;
  // get the name of the CGI script and the method
  GetEnvironmentVariable ('SCRIPT_NAME',
    ScriptName, sizeof (ScriptName));
  GetEnvironmentVariable ('REQUEST_METHOD',
    MethodName, sizeof (MethodName));
  // writeln ('<i>Debug: Method Name = ' + MethodName + '</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 method is post then read in the data
    if StrComp (MethodName, 'POST') = 0 then
    begin
      GetToRecordPost;
      ShowRecord;
    end
    else if ParamCount <= 0 then
      ShowTableIndex
    else
    begin
      // select the record
      if ParamCount = 1 then
        Table1.FindNearest ([ParamStr (1)])
      else
        Table1.FindNearest ([ParamStr (1),
          ParamStr (2)]);
      // show a single record
      ShowRecord;
    end;
  finally
    Table1.Close;
    Table1.Free;
  end;
  // show footer
  writeln('</BODY></HTML>');
end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -