Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project BROKCGI

Project Structure

BROKCGI.DPR

program BrokCgi;

{$APPTYPE CONSOLE}

uses
  WebBroker,
  CGIApp,
  BrokWm in 'BrokWm.pas' {WebModule1: TWebModule};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TWebModule1, WebModule1);
  Application.Run;
end.

BROKWM.PAS

unit BrokWm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, Db, DBTables, DSProd,
  DBWeb;

type
  TWebModule1 = class(TWebModule)
    Table1: TTable;
    Table1EmpNo: TIntegerField;
    Table1LastName: TStringField;
    Table1FirstName: TStringField;
    Table1PhoneExt: TStringField;
    Table1HireDate: TDateTimeField;
    Table1Salary: TFloatField;
    PageHead: TPageProducer;
    DataSetPage: TDataSetPageProducer;
    PageTail: TPageProducer;
    procedure TimeAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure DateAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure MenuAction(Sender: TObject; Request: TWebRequest;
      Response: TWebResponse; var Handled: Boolean);
    procedure StatusAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure RecordAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure PageTailHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebModule1BeforeDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure DataSetTableProducer1FormatCell(Sender: TObject; CellRow,
      CellColumn: Integer; var BgColor: THTMLBgColor;
      var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
      CellData: String);
    procedure WebModule1AfterDispatch(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
  private
    ScriptName: string;
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.TimeAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := 'Time at this site: ' +
    FormatDateTime('hh:mm:ss AM/PM', Now) + '<p>';
end;

procedure TWebModule1.DateAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := 'Today is ' +
    FormatDateTime('dddd, mmmm d, yyyy', Now) + '<p>';
end;

procedure TWebModule1.MenuAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  Response.Content := '<H3>Menu</H3><ul>'#13;
  for I := 0 to Actions.Count - 1 do
    Response.Content := Response.Content +
      '<li> <a href="' + ScriptName +
      Action[I].PathInfo + '"> ' + Action[I].Name + '</a>'#13;
  Response.Content := Response.Content + '</ul>';
end;

procedure TWebModule1.StatusAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  Response.Content := '<H3>Status</H3>'#13 +
    'Method: ' + Request.Method + '<br>'#13 +
    'ProtocolVersion: ' + Request.ProtocolVersion + '<br>'#13 +
    'URL: ' + Request.URL + '<br>'#13 +
    'Query: ' + Request.Query + '<br>'#13 +
    'PathInfo: ' + Request.PathInfo + '<br>'#13 +
    'PathTranslated: ' + Request.PathTranslated + '<br>'#13 +
    'Authorization: ' + Request.Authorization + '<br>'#13 +
    'CacheControl: ' + Request.CacheControl + '<br>'#13 +
    'Cookie: ' + Request.Cookie + '<br>'#13 +
    'Date: ' + DateTimeToStr (Request.Date) + '<br>'#13 +
    'Accept: ' + Request.Accept + '<br>'#13 +
    'From: ' + Request.From + '<br>'#13 +
    'Host: ' + Request.Host + '<br>'#13 +
    'IfModifiedSince: ' + DateTimeToStr (Request.IfModifiedSince) + '<br>'#13 +
    'Referer: ' + Request.Referer + '<br>'#13 +
    'UserAgent: ' + Request.UserAgent + '<br>'#13 +
    'ContentEncoding: ' + Request.ContentEncoding + '<br>'#13 +
    'ContentType: ' + Request.ContentType + '<br>'#13 +
    'ContentLength: ' + IntToStr (Request.ContentLength) + '<br>'#13 +
    'ContentVersion: ' + Request.ContentVersion + '<br>'#13 +
    'Content: ' + Request.Content + '<br>'#13 +
    'Connection: ' + Request.Connection + '<br>'#13 +
    'DerivedFrom: ' + Request.DerivedFrom + '<br>'#13 +
    'Expires: ' + DateTimeToStr (Request.Expires) + '<br>'#13 +
    'Title: ' + Request.Title + '<br>'#13 +
    'RemoteAddr: ' + Request.RemoteAddr + '<br>'#13 +
    'RemoteHost: ' + Request.RemoteHost + '<br>'#13 +
    'ScriptName: ' + Request.ScriptName + '<br>'#13 +
    'ServerPort: ' + IntToStr (Request.ServerPort) + '<br>'#13;
  // list of strings
  Response.Content := Response.Content +
    'ContentFields:<ul>'#13;
  for I := 0 to Request.ContentFields.Count - 1 do
    Response.Content := Response.Content +
      '<li>' + Request.ContentFields [I]+ #13;
  Response.Content := Response.Content +
    '</ul>CookieFields:<ul>'#13;
  for I := 0 to Request.CookieFields.Count - 1 do
    Response.Content := Response.Content +
      '<li>' + Request.CookieFields [I] + #13;
  Response.Content := Response.Content +
    '</ul>QueryFields:<ul>'#13;
  for I := 0 to Request.QueryFields.Count - 1 do
    Response.Content := Response.Content +
      '<li>' + Request.QueryFields [I] + #13;
end;

procedure TWebModule1.RecordAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  // go to the requested record
  Table1.FindNearest ([Request.QueryFields.Values['LastName'],
    Request.QueryFields.Values['FirstName']]);
  // get the output
  Response.Content := DataSetPage.Content;
end;

procedure TWebModule1.PageTailHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'script' then
    ReplaceText := ScriptName;
end;

procedure TWebModule1.WebModule1BeforeDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  // code shared by all actions
  ScriptName := Request.ScriptName;
  Table1.Open;
end;

procedure TWebModule1.DataSetTableProducer1FormatCell(Sender: TObject;
  CellRow, CellColumn: Integer; var BgColor: THTMLBgColor;
  var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
  CellData: String);
begin
  if (CellColumn = 0) and (CellRow <> 0) then
    CellData := '<a href="' + ScriptName + '/record?LastName=' +
      Table1['LastName'] + '&FirstName=' + Table1 ['FirstName'] + '"> '
      + CellData + ' </a>';
end;

procedure TWebModule1.WebModule1AfterDispatch(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := PageHead.Content +
    Response.Content + PageTail.Content;
end;

end.

BROKWM.DFM

object WebModule1: TWebModule1
  OldCreateOrder = True
  Actions = <
    item
      Name = 'WaTime'
      PathInfo = '/time'
      OnAction = TimeAction
    end
    item
      Name = 'WaDate'
      PathInfo = '/date'
      OnAction = DateAction
    end
    item
      Default = True
      Name = 'WaMenu'
      PathInfo = '/menu'
      OnAction = MenuAction
    end
    item
      Name = 'WaStatus'
      PathInfo = '/status'
      OnAction = StatusAction
    end
    item
      Name = 'WaTable'
      PathInfo = '/table'
    end
    item
      Name = 'WaRecord'
      PathInfo = '/record'
      Producer = DataSetPage
      OnAction = RecordAction
    end>
  BeforeDispatch = WebModule1BeforeDispatch
  AfterDispatch = WebModule1AfterDispatch
  Left = 278
  Top = 272
  Height = 392
  Width = 726
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    IndexName = 'ByName'
    TableName = 'EMPLOYEE.DB'
    Left = 48
    Top = 24
    object Table1EmpNo: TIntegerField
      FieldName = 'EmpNo'
    end
    object Table1LastName: TStringField
      FieldName = 'LastName'
    end
    object Table1FirstName: TStringField
      FieldName = 'FirstName'
      Size = 15
    end
    object Table1PhoneExt: TStringField
      FieldName = 'PhoneExt'
      Size = 4
    end
    object Table1HireDate: TDateTimeField
      FieldName = 'HireDate'
    end
    object Table1Salary: TFloatField
      FieldName = 'Salary'
    end
  end
  object PageHead: TPageProducer
    HTMLDoc.Strings = (
      '<HTML><HEAD>'
      '<TITLE>WebBroker Demo</TITLE>'
      '</HEAD>'
      '<BODY>'
      '<H1>Web Broker Demo</H1>')
    Left = 110
    Top = 25
  end
  object DataSetPage: TDataSetPageProducer
    HTMLDoc.Strings = (
      '<H3>Employee: <#LastName></H3>'
      '<ul>'
      '<li> Employee ID: <#EmpNo>'
      '<li> Name: <#FirstName> <#LastName>'
      '<li> Phone: <#PhoneExt>'
      '<li> Hired On: <#HireDate>'
      '<li> Salary: <#Salary>'
      '</ul>')
    OnHTMLTag = PageTailHTMLTag
    DataSet = Table1
    Left = 168
    Top = 80
  end
  object PageTail: TPageProducer
    HTMLDoc.Strings = (
      '<hr><I>Page generated by <#script></I>'
      '</BODY>'
      '</HTML>')
    OnHTMLTag = PageTailHTMLTag
    Left = 168
    Top = 27
  end
end