Marco Cantù 1998, Mastering Delphi 4
Project: ISAMULTI.DPR
Project Structure
ISAMULTI.DPR
library IsaMulti;
uses
HTTPApp,
ISAPIApp,
MultiWm in 'MultiWm.pas' {WebModule1: TWebModule};
{$R *.RES}
exports
GetExtensionVersion,
HttpExtensionProc,
TerminateExtension;
begin
Application.Initialize;
Application.CreateForm(TWebModule1, WebModule1);
Application.Run;
end.
MULTIWM.PAS
unit MultiWm;
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;
DataSetTableProducer1: TDataSetTableProducer;
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 TableAction(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 := 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 := 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 := Response.Content +
'<H3>Menu</H3>'#13 +
'<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 := 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.TableAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Table1.Open;
Table1.First; // otherwise prints only from current record
Response.Content := Response.Content +
DataSetTableProducer1.Content;
end;
procedure TWebModule1.RecordAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
Table1.Open;
// debug
{Response.Content := Response.Content +
'<I>Last Name = ' + Request.QueryFields.Values['LastName'] +
', First Name = ' + Request.QueryFields.Values['FirstName'] + '</I><p>';}
// go to the requested record
Table1.FindNearest ([Request.QueryFields.Values['LastName'],
Request.QueryFields.Values['FirstName']]);
// get the output
Response.Content := 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;
Response.Content := PageHead.Content;
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 := Response.Content + PageTail.Content;
end;
end.
MULTIWM.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'
OnAction = TableAction
end
item
Name = 'WaRecord'
PathInfo = '/record'
OnAction = RecordAction
end>
BeforeDispatch = WebModule1BeforeDispatch
AfterDispatch = WebModule1AfterDispatch
Left = 188
Top = 322
Height = 179
Width = 291
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>IsaMulti Demo</TITLE></HEAD>'
'<BODY>'
'<H1>IsaMulti Demo</H1>')
Left = 110
Top = 25
end
object DataSetTableProducer1: TDataSetTableProducer
Columns = <
item
FieldName = 'LastName'
end
item
FieldName = 'FirstName'
end
item
FieldName = 'PhoneExt'
end
item
FieldName = 'HireDate'
end>
DataSet = Table1
OnFormatCell = DataSetTableProducer1FormatCell
Left = 48
Top = 80
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 = 112
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
Copyright Marco Cantù 1998