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 WSnap1

Project Structure

WSnap1.dpr
program WSnap1;

{$APPTYPE GUI}

uses
  Forms,
  ComApp,
  WSnapForm in 'WSnapForm.pas' {Form1},
  home_dm in 'home_dm.pas' {home: TWebAppPageModule} {*.html},
  country_dm in 'country_dm.pas' {date: TWebPageModule} {*.html},
  date_dm in 'date_dm.pas' {country: TWebPageModule} {*.html},
  countries_dm in 'countries_dm.pas' {countries: TWebPageModule} {*.html};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
WSnapForm.pas
unit WSnapForm;

interface

uses
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses ComApp;

{$R *.DFM}

const
  CLASS_ComWebApp: TGUID = '{3B672D3F-F633-4F70-B377-E862448F6F9B}';

initialization
  TWebAppAutoObjectFactory.Create(Class_ComWebApp,
    'WSnap1', 'WSnap1 Object');

end.
home_dm.pas
unit home_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd, ReqMulti,
  WebDisp, WebAdapt, WebComp;

type
  Thome = class(TWebAppPageModule)
    PageProducer: TPageProducer;
    WebAppComponents: TWebAppComponents;
    ApplicationAdapter: TApplicationAdapter;
    PageDispatcher: TPageDispatcher;
    AdapterDispatcher: TAdapterDispatcher;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function home: Thome;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants;

function home: Thome;
begin
  Result := Thome(WebContext.FindModuleClass(Thome));
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebAppPageModuleFactory.Create(Thome, TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), caCache));

end.
country_dm.pas

unit country_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd;

type
  Tdate = class(TWebPageModule)
    PageProducer: TPageProducer;
    procedure PageProducerHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function date: Tdate;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants;

function date: Tdate;
begin
  Result := Tdate(WebContext.FindModuleClass(Tdate));
end;

procedure Tdate.PageProducerHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'date' then
    ReplaceText := DateToStr (Now)
  else if TagString = 'time' then
    ReplaceText := TimeToStr (Now);
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(Tdate, TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), crOnDemand, caCache));

end.
date_dm.pas

unit date_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd, DSProd,
  DBTables, DB;

type
  Tcountry = class(TWebPageModule)
    DataSetPageProducer: TDataSetPageProducer;
    Table1: TTable;
    Session1: TSession;
    procedure WebPageModuleBeforeDispatchPage(Sender: TObject;
      const PageName: String; var Handled: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function country: Tcountry;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants;

function country: Tcountry;
begin
  Result := Tcountry(WebContext.FindModuleClass(Tcountry));
end;

procedure Tcountry.WebPageModuleBeforeDispatchPage(Sender: TObject;
  const PageName: String; var Handled: Boolean);
begin
  Table1.Open;
  Table1.First;
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(Tcountry, TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), crOnDemand, caCache));

end.
countries_dm.pas

unit countries_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd,
  DBTables, DB, DBWeb;

type
  Tcountries = class(TWebPageModule)
    DataSetTableProducer1: TDataSetTableProducer;
    Table1: TTable;
    Session1: TSession;
    PageProducer: TPageProducer;
    procedure WebPageModuleBeforeDispatchPage(Sender: TObject;
      const PageName: String; var Handled: Boolean);
    procedure PageProducerHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function countries: Tcountries;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants, country_dm;

function countries: Tcountries;
begin
  Result := Tcountries(WebContext.FindModuleClass(Tcountries));
end;

procedure Tcountries.WebPageModuleBeforeDispatchPage(Sender: TObject;
  const PageName: String; var Handled: Boolean);
begin
  Table1.Open;
  Table1.First;
end;

procedure Tcountries.PageProducerHTMLTag(Sender: TObject; Tag: TTag;
  const TagString: String; TagParams: TStrings; var ReplaceText: String);
begin
  if TagString = 'htmltable' then
    ReplaceText := DataSetTableProducer1.Content;
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(Tcountries, TWebPageInfo.Create([wpPublished {, wpLoginRequired}], '.html'), crOnDemand, caCache));

end.
WSnapForm.dfm
object Form1: TForm1
  Left = 250
  Top = 107
  Width = 154
  Height = 66
  Caption = 'WSnap1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
end
home_dm.dfm
object home: Thome
  OldCreateOrder = False
  PageProducer = PageProducer
  AppServices = WebAppComponents
  Left = 254
  Top = 107
  Height = 296
  Width = 215
  object PageProducer: TPageProducer
    ScriptEngine = 'JScript'
    Left = 48
    Top = 8
  end
  object WebAppComponents: TWebAppComponents
    PageDispatcher = PageDispatcher
    AdapterDispatcher = AdapterDispatcher
    ApplicationAdapter = ApplicationAdapter
    Left = 48
    Top = 56
  end
  object ApplicationAdapter: TApplicationAdapter
    ApplicationTitle = 'WSnap1'
    Left = 48
    Top = 104
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
    end
  end
  object PageDispatcher: TPageDispatcher
    DefaultPage = 'home'
    Left = 48
    Top = 152
  end
  object AdapterDispatcher: TAdapterDispatcher
    Left = 48
    Top = 200
  end
end
country_dm.dfm
object date: Tdate
  OldCreateOrder = False
  PageProducer = PageProducer
  Left = 254
  Top = 107
  Height = 150
  Width = 215
  object PageProducer: TPageProducer
    OnHTMLTag = PageProducerHTMLTag
    ScriptEngine = 'JScript'
    Left = 48
    Top = 8
  end
end
date_dm.dfm
object country: Tcountry
  OldCreateOrder = False
  PageProducer = DataSetPageProducer
  OnBeforeDispatchPage = WebPageModuleBeforeDispatchPage
  Left = 397
  Top = 127
  Height = 186
  Width = 265
  object DataSetPageProducer: TDataSetPageProducer
    DataSet = Table1
    ScriptEngine = 'JScript'
    Left = 48
    Top = 16
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    SessionName = 'Session1_2'
    TableName = 'country.db'
    Left = 128
    Top = 16
  end
  object Session1: TSession
    Active = True
    AutoSessionName = True
    Left = 128
    Top = 80
  end
end
countries_dm.dfm
object countries: Tcountries
  OldCreateOrder = False
  PageProducer = PageProducer
  OnBeforeDispatchPage = WebPageModuleBeforeDispatchPage
  Left = 254
  Top = 107
  Height = 185
  Width = 224
  object DataSetTableProducer1: TDataSetTableProducer
    DataSet = Table1
    TableAttributes.Border = 1
    TableAttributes.CellSpacing = 0
    TableAttributes.CellPadding = 3
    Left = 48
    Top = 24
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    SessionName = 'Session1_3'
    TableName = 'country.db'
    Left = 128
    Top = 16
  end
  object Session1: TSession
    Active = True
    AutoSessionName = True
    Left = 128
    Top = 80
  end
  object PageProducer: TPageProducer
    OnHTMLTag = PageProducerHTMLTag
    ScriptEngine = 'JScript'
    Left = 56
    Top = 88
  end
end