Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 22 - Project CustQueP

Project Structure

CustQueP.dpr
program CustQueP;

{$APPTYPE CONSOLE}

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

{$R *.RES}

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

interface

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

type
  TWebModule1 = class(TWebModule)
    QueryTableProducer1: TQueryTableProducer;
    Query1: TQuery;
    Query1Company: TStringField;
    Query1State: TStringField;
    Query1Country: TStringField;
    PageProducer1: TPageProducer;
    Query2: TQuery;
    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);
  end;

var
  WebModule1: TWebModule1;

implementation

uses WebReq;

{$R *.DFM}

procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'script' then
    ReplaceText := Request.InternalScriptName
  else
  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;
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.InternalScriptName + '/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.InternalScriptName +
      '/record?' + CellData + '">' + CellData + '</a>'#13;
  if CellData = '' then
    CellData := '&nbsp;';
end;

initialization
  WebRequestHandler.WebModuleClass := TWebModule1;

end.
CustWebM.dfm
object WebModule1: TWebModule1
  OldCreateOrder = True
  Actions = <
    item
      Name = 'ActionSearch'
      PathInfo = '/search'
      Producer = QueryTableProducer1
    end
    item
      Default = True
      Name = 'ActionForm'
      PathInfo = '/form'
      Producer = PageProducer1
    end
    item
      Name = 'ActionRecord'
      PathInfo = '/record'
      OnAction = RecordAction
    end>
  Left = 384
  Top = 174
  Height = 207
  Width = 319
  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 = 0
    TableAttributes.CellPadding = 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="<#script>/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' +
        '>'
      '</table></form>')
    OnHTMLTag = PageProducer1HTMLTag
    Left = 48
    Top = 64
  end
  object Query2: TQuery
    DatabaseName = 'DBDEMOS'
    Left = 120
    Top = 64
  end
end