Marco Web Center

[an error occurred while processing this directive]

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