Project CUSTQUEP
Project Structure
CUSTQUEP.DPR
library CustQueP;
uses
WebBroker,
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 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);
procedure WebModule1BeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
ScriptName: string;
end;
var
WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.PageProducer1HTMLTag(Sender: TObject; Tag: TTag;
const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
if TagString = 'script' then
ReplaceText := ScriptName
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="' + 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;
procedure TWebModule1.WebModule1BeforeDispatch(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
ScriptName := Request.ScriptName;
end;
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>
BeforeDispatch = WebModule1BeforeDispatch
Left = 385
Top = 217
Height = 479
Width = 741
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="<#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' +
'>'
'</form>')
OnHTMLTag = PageProducer1HTMLTag
Left = 48
Top = 64
end
object Query2: TQuery
DatabaseName = 'DBDEMOS'
Left = 120
Top = 64
end
end
|
