Project Structure

• WSnapSession.dpr
• mainform.pas
• homepage_dm.pas
• mainform.dfm
• homepage_dm.dfm

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.

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.

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.

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

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