Marco Cantù 1998, Mastering Delphi 4

Project: CUSTQUEP.DPR


Project Structure


CUSTQUEP.DPR

library CustQueP;

uses
  HTTPApp,
  ISAPIApp,
  CustWebM in 'CustWebM.pas' {WebModule1: TWebModule};

{$R *.RES}

exports
  GetExtensionVersion,
  HttpExtensionProc,
  TerminateExtension;

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

CUSTWEBM.PAS

unit CustWebM;

interface

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

type
  TWebModule1 = class(TWebModule)
    QueryTableProducer1: TQueryTableProducer;
    Query1: TQuery;
    Query1Company: TStringField;
    Query1State: TStringField;
    Query1Country: TStringField;
    PageProducer1: TPageProducer;
    Query2: TQuery;
    procedure SearchAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure FormAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure RecordAction(Sender: TObject;
      Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
    procedure QueryTableProducer1FormatCell(Sender: TObject; CellRow,
      CellColumn: Integer; var BgColor: THTMLBgColor;
      var Align: THTMLAlign; var VAlign: THTMLVAlign; var CustomAttrs,
      CellData: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  WebModule1: TWebModule1;

implementation

{$R *.DFM}

procedure TWebModule1.SearchAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := QueryTableProducer1.Content;
end;

procedure TWebModule1.FormAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
  Response.Content := PageProducer1.Content;
end;

procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  ReplaceText := '';
  Query2.SQL.Clear;
  Query2.SQL.Add ('select distinct ' +
    TagString + ' from customer');
  try
    Query2.Open;
    try
      Query2.First;
      while not Query2.EOF do
      begin
        ReplaceText := ReplaceText +
          '<option>' + Query2.Fields[0].AsString +
          '</option>'#13;
        Query2.Next;
      end;
    finally
      Query2.Close;
    end;
  except
    ReplaceText := '{wrong field: ' + TagString + '}';
  end;
end;

procedure TWebModule1.RecordAction(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
  I: Integer;
begin
  if Request.QueryFields.Count = 0 then
    Response.Content := 'Record not found'
  else
  begin
    Query2.SQL.Clear;
    Query2.SQL.Add ('select * from customer ' +
      'where Company="' + Request.QueryFields[0] + '"');
    Query2.Open;
    Response.Content :=
      '<HTML><HEAD><TITLE>Customer Record</TITLE></HEAD><BODY>'#13 +
      '<H1>Customer Record: ' + Request.QueryFields[0] +
      '</H1>'#13 +
      '<table border>'#13;
    for I := 1 to Query2.FieldCount - 1 do
      Response.Content := Response.Content +
        '<tr><td>' + Query2.Fields [I].FieldName +
        '</td>'#13'<td>'   + Query2.Fields [I].AsString +
        '</td></tr>'#13;
    Response.Content := Response.Content +
      '</table><hr>'#13 +
      // pointer to the query form
      '<a HREF="' + Request.ScriptName + '/form">' +
      ' Next Query </a>'#13 +
      '</BODY></HTML>'#13;
  end;
end;

procedure TWebModule1.QueryTableProducer1FormatCell(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="' + Request.ScriptName +
      '/record?' + CellData + '">' + CellData + '</a>'#13;
end;

end.

CUSTWEBM.DFM

object WebModule1: TWebModule1
  OldCreateOrder = True
  Actions = <
    item
      Name = 'ActionSearch'
      PathInfo = '/search'
      OnAction = SearchAction
    end
    item
      Default = True
      Name = 'ActionForm'
      PathInfo = '/form'
      OnAction = FormAction
    end
    item
      Name = 'ActionRecord'
      PathInfo = '/record'
      OnAction = RecordAction
    end>
  Left = 245
  Top = 172
  Height = 150
  Width = 215
  object QueryTableProducer1: TQueryTableProducer
    Caption = '<b>Customers</b>'
    Columns = <
      item
        FieldName = 'Company'
      end
      item
        FieldName = 'State'
      end
      item
        FieldName = 'Country'
      end>
    Query = Query1
    TableAttributes.Border = 1
    TableAttributes.CellSpacing = 3
    OnFormatCell = QueryTableProducer1FormatCell
    Left = 48
    Top = 16
  end
  object Query1: TQuery
    DatabaseName = 'DBDEMOS'
    SQL.Strings = (
      'SELECT Company, State,  Country'
      'FROM CUSTOMER.DB'
      'WHERE '
      '  State = :State OR Country = :Country')
    Left = 120
    Top = 16
    ParamData = <
      item
        DataType = ftString
        Name = 'State'
        ParamType = ptUnknown
      end
      item
        DataType = ftString
        Name = 'Country'
        ParamType = ptUnknown
        Value = 'US'
      end>
    object Query1Company: TStringField
      FieldName = 'Company'
      Size = 30
    end
    object Query1State: TStringField
      FieldName = 'State'
    end
    object Query1Country: TStringField
      FieldName = 'Country'
    end
  end
  object PageProducer1: TPageProducer
    HTMLDoc.Strings = (
      '<h4>Customer QueryProducer Search Form</h4>'
      '<form action="/cgi-bin/CustQueP.dll/search" method="POST">'
      '<table>'
      '<tr><td>State:</td><td><select name="State">'
      '<#State>'
      '</select>'
      '</td></tr>'
      '<tr><td>Country:</td><td><select name="Country">'
      '<option> </option>'
      '<#Country>'
      '</select>'
      '</td></tr>'

              '<tr><td></td><td><center><input type="Submit"></center></td></tr' +
        '>'
      '</form>')
    OnHTMLTag = PageProducer1HTMLTag
    Left = 48
    Top = 64
  end
  object Query2: TQuery
    DatabaseName = 'DBDEMOS'
    Left = 120
    Top = 64
    ParamData = <>
  end
end


Copyright Marco Cantù 1998