Marco Web Center
[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 22 - Project WSnap2

Project Structure

WSnap2.dpr
program WSnap2;

{$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},
  demoscript_dm in 'demoscript_dm.pas' {demoscript: TWebPageModule} {*.html},
  inout_dm in 'inout_dm.pas' {inout: 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 = '{B404078F-9948-4F04-99CB-3CA072D43A56}';

initialization
  TWebAppAutoObjectFactory.Create(Class_ComWebApp,
    'WSnap2', '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;
    Count: TAdapterField;
    procedure PageDispatcherBeforeDispatchPage(Sender: TObject;
      const PageName: String; var Handled: Boolean);
    procedure CountGetValue(Sender: TObject; var Value: Variant);
  private
    HitCount: Integer;
  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;

procedure Thome.PageDispatcherBeforeDispatchPage(Sender: TObject;
  const PageName: String; var Handled: Boolean);
begin
  Inc (HitCount);
end;

procedure Thome.CountGetValue(Sender: TObject; var Value: Variant);
begin
  Value := HitCount;
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.
demoscript_dm.pas

unit demoscript_dm;

interface

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

type
  Tdemoscript = class(TWebPageModule)
    PageProducer: TPageProducer;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  function demoscript: Tdemoscript;

implementation

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

uses WebReq, WebCntxt, WebFact, Variants;

function demoscript: Tdemoscript;
begin
  Result := Tdemoscript(WebContext.FindModuleClass(Tdemoscript));
end;

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

end.
inout_dm.pas

unit inout_dm;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd,
  WebAdapt, WebComp, CompProd, PagItems, SiteProd, MidItems, WebForm;

type
  Tinout = class(TWebPageModule)
    AdapterPageProducer: TAdapterPageProducer;
    Adapter1: TAdapter;
    Text: TAdapterField;
    AddPlus: TAdapterAction;
    AdapterForm1: TAdapterForm;
    AdapterFieldGroup1: TAdapterFieldGroup;
    AdapterCommandGroup1: TAdapterCommandGroup;
    CmdAddPlus: TAdapterActionButton;
    FldText: TAdapterDisplayField;
    Post: TAdapterAction;
    CmdPost: TAdapterActionButton;
    Auto: TAdapterBooleanField;
    FldAuto: TAdapterDisplayField;
    procedure AddPlusExecute(Sender: TObject; Params: TStrings);
    procedure TextGetValue(Sender: TObject; var Value: Variant);
    procedure PostExecute(Sender: TObject; Params: TStrings);
    procedure Adapter1BeforeExecuteAction(Sender, Action: TObject;
      Params: TStrings; var Handled: Boolean);
    procedure AutoGetValue(Sender: TObject; var Value: Boolean);
  private
    fAuto: Boolean;
    fText: String;
  public
    { Public declarations }
  end;

  function inout: Tinout;

implementation

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

uses WebReq, WebCntxt, WebFact, Variants, AdaptReq;

function inout: Tinout;
begin
  Result := Tinout(WebContext.FindModuleClass(Tinout));
end;

procedure Tinout.AddPlusExecute(Sender: TObject; Params: TStrings);
begin
  fText := fText + '+';
end;

procedure Tinout.TextGetValue(Sender: TObject; var Value: Variant);
begin
  Value := fText;
end;

procedure Tinout.PostExecute(Sender: TObject; Params: TStrings);
begin
  if fAuto then
    AddPlusExecute (Self, nil);
end;

procedure Tinout.Adapter1BeforeExecuteAction(Sender, Action: TObject;
  Params: TStrings; var Handled: Boolean);
begin
  if Assigned (Text.ActionValue) then
    fText := Text.ActionValue.Values [0];
  fAuto := Assigned (Auto.ActionValue);
end;

procedure Tinout.AutoGetValue(Sender: TObject; var Value: Boolean);
begin
  Value := fAuto;
end;

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

end.
WSnapForm.dfm
object Form1: TForm1
  Left = 250
  Top = 107
  Width = 154
  Height = 66
  Caption = 'WSnap2'
  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 = 'WSnap2'
    Left = 48
    Top = 104
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
      object Count: TAdapterField
        OnGetValue = CountGetValue
      end
    end
  end
  object PageDispatcher: TPageDispatcher
    DefaultPage = 'home'
    OnBeforeDispatchPage = PageDispatcherBeforeDispatchPage
    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 = 382
  Top = 147
  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
demoscript_dm.dfm
object demoscript: Tdemoscript
  OldCreateOrder = False
  PageProducer = PageProducer
  Left = 254
  Top = 107
  Height = 150
  Width = 215
  object PageProducer: TPageProducer
    ScriptEngine = 'JScript'
    Left = 48
    Top = 8
  end
end
inout_dm.dfm
object inout: Tinout
  OldCreateOrder = False
  PageProducer = AdapterPageProducer
  Left = 254
  Top = 107
  Height = 168
  Width = 227
  object AdapterPageProducer: TAdapterPageProducer
    HTMLDoc.Strings = (
      '<html>'
      '<head>'
      '</head>'
      '<body>'
      '<#STYLES><#WARNINGS><#SERVERSCRIPT>'
      '</body>'
      '</html>')
    Left = 48
    Top = 8
    object AdapterForm1: TAdapterForm
      object AdapterFieldGroup1: TAdapterFieldGroup
        Adapter = Adapter1
        object FldText: TAdapterDisplayField
          FieldName = 'Text'
        end
        object FldAuto: TAdapterDisplayField
          FieldName = 'Auto'
        end
      end
      object AdapterCommandGroup1: TAdapterCommandGroup
        DisplayComponent = AdapterFieldGroup1
        object CmdPost: TAdapterActionButton
          ActionName = 'Post'
        end
        object CmdAddPlus: TAdapterActionButton
          ActionName = 'AddPlus'
        end
      end
    end
  end
  object Adapter1: TAdapter
    OnBeforeExecuteAction = Adapter1BeforeExecuteAction
    Left = 48
    Top = 72
    object TAdapterActions
      object AddPlus: TAdapterAction
        OnExecute = AddPlusExecute
      end
      object Post: TAdapterAction
        OnExecute = PostExecute
      end
    end
    object TAdapterFields
      object Text: TAdapterField
        OnGetValue = TextGetValue
      end
      object Auto: TAdapterBooleanField
        OnGetValue = AutoGetValue
      end
    end
  end
end

 
© Copyright Marco Cantù, 1995-2020, All rights reserved