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 WSnapSession

Project Structure

WSnapSession.dpr
program WSnapSession;

{$APPTYPE GUI}

uses
  Forms,
  ComApp,
  mainform in 'mainform.pas' {Form1},
  homepage_dm in 'homepage_dm.pas' {SessionDemo: TWebAppPageModule} {*.html};

{$R *.RES}

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

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 = '{29F0C5DF-9ECA-4949-ADF5-4BA3A349A6BF}';

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

end.
homepage_dm.pas

unit homepage_dm;

interface

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

type
  TSessionDemo = class(TWebAppPageModule)
    WebAppComponents: TWebAppComponents;
    ApplicationAdapter: TApplicationAdapter;
    PageDispatcher: TPageDispatcher;
    AdapterDispatcher: TAdapterDispatcher;
    SessionsService: TSessionsService;
    PageProducer1: TPageProducer;
    Hits: TAdapterField;
    SessionHits: TAdapterField;
    procedure PageProducerHTMLTag(Sender: TObject; Tag: TTag;
      const TagString: String; TagParams: TStrings;
      var ReplaceText: String);
    procedure WebAppPageModuleBeforeDispatchPage(Sender: TObject;
      const PageName: String; var Handled: Boolean);
    procedure HitsGetValue(Sender: TObject; var Value: Variant);
    procedure SessionHitsGetValue(Sender: TObject; var Value: Variant);
  private
    nHits: Integer;
  public
    { Public declarations }
  end;

  function SessionDemo: TSessionDemo;

implementation

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

uses WebReq, WebCntxt, WebFact, Variants;

function SessionDemo: TSessionDemo;
begin
  Result := TSessionDemo(WebContext.FindModuleClass(TSessionDemo));
end;

procedure TSessionDemo.PageProducerHTMLTag(Sender: TObject;
  Tag: TTag; const TagString: String; TagParams: TStrings;
  var ReplaceText: String);
begin
  if TagString = 'SessionID' then
    ReplaceText := WebContext.Session.SessionID
  else if TagString = 'SessionHits' then
    ReplaceText := WebContext.Session.Values ['SessionHits']
end;

procedure TSessionDemo.WebAppPageModuleBeforeDispatchPage(
  Sender: TObject; const PageName: String; var Handled: Boolean);
begin
  // increase application and session hits
  Inc (nHits);
  WebContext.Session.Values ['SessionHits'] :=
    Integer (WebContext.Session.Values ['SessionHits']) + 1;
end;

procedure TSessionDemo.HitsGetValue(Sender: TObject; var Value: Variant);
begin
  Value := nHits;
end;

procedure TSessionDemo.SessionHitsGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := Integer (WebContext.Session.Values ['SessionHits']);
end;

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

end.
mainform.dfm
object Form1: TForm1
  Left = 578
  Top = 103
  Width = 209
  Height = 144
  Caption = 'WSnapSession'
  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
homepage_dm.dfm
object SessionDemo: TSessionDemo
  OldCreateOrder = False
  OnBeforeDispatchPage = WebAppPageModuleBeforeDispatchPage
  PageProducer = PageProducer1
  AppServices = WebAppComponents
  Left = 254
  Top = 107
  Height = 344
  Width = 215
  object WebAppComponents: TWebAppComponents
    Sessions = SessionsService
    PageDispatcher = PageDispatcher
    AdapterDispatcher = AdapterDispatcher
    ApplicationAdapter = ApplicationAdapter
    Left = 48
    Top = 56
  end
  object ApplicationAdapter: TApplicationAdapter
    ApplicationTitle = 'WSnapSession'
    Left = 48
    Top = 104
    object TAdapterDefaultActions
    end
    object TAdapterDefaultFields
      object Hits: TAdapterField
        OnGetValue = HitsGetValue
      end
      object SessionHits: TAdapterField
        OnGetValue = SessionHitsGetValue
      end
    end
  end
  object PageDispatcher: TPageDispatcher
    Left = 48
    Top = 152
  end
  object AdapterDispatcher: TAdapterDispatcher
    Left = 48
    Top = 200
  end
  object SessionsService: TSessionsService
    Left = 48
    Top = 248
  end
  object PageProducer1: TPageProducer
    OnHTMLTag = PageProducerHTMLTag
    ScriptEngine = 'JScript'
    Left = 48
    Top = 16
  end
end