------------------------------程------------------------------
(程式1)
unit ServerController;
{PUBDIST}

interface

uses
  SysUtils, Classes, IWServerControllerBase,
  // For OnNewSession Event
  IWApplication, IWAppForm;

type
  TIWServerController = class(TIWServerControllerBase)
    procedure IWServerControllerBaseNewSession(ASession: TIWApplication;
      var VMainForm: TIWAppForm);
  private
  public
  end;

  TUserSession = class
  private
    FUserName:string;
  public
    property UserName:string read FUserName write FUserName;
  end;
  function UserSession: TUserSession;

implementation
{$R *.dfm}

uses
  IWInit;

function UserSession: TUserSession;
begin
  Result := TUserSession(RWebApplication.Data);
end;

procedure TIWServerController.IWServerControllerBaseNewSession(
  ASession: TIWApplication; var VMainForm: TIWAppForm);
begin
  ASession.Data := TUserSession.Create;
end;

end.
------------------------------------------------------------------------



----------------------------------程----------------------------------
(程式2)
unit uformWelcome;
{PUBDIST}

interface

uses
  SysUtils,IWAppForm, IWApplication, IWTypes, Classes, Controls, IWControl,
  IWCompLabel;

type
  TformWelcome = class(TIWAppForm)
    IWLabel1: TIWLabel;
    procedure IWAppFormRender(Sender: TObject);
  public
  end;

implementation
{$R *.dfm}

uses
  ServerController;

procedure TformWelcome.IWAppFormRender(Sender: TObject);
begin
   IWLabel1.Caption:=Format('歡迎 %s',[UserSession.UserName]);
end;

end.
------------------------------------------------------------------------




----------------------------------程----------------------------------
(程式3) 
unit uformLogin;
{PUBDIST}

interface

uses
  IWAppForm, IWApplication, IWTypes, IWCompButton, IWCompEdit, Classes,
  Controls, IWControl, IWCompLabel,SysUtils;

type
  TformMain = class(TIWAppForm)
    IWLabel1: TIWLabel;
    IWLabel2: TIWLabel;
    edtUser: TIWEdit;
    edtPassword: TIWEdit;
    IWButton1: TIWButton;
    procedure IWButton1Click(Sender: TObject);
  private
    function  CheckUser(AUserName:string;APassword:string=''):Boolean;
  end;

implementation
{$R *.dfm}

uses
  ServerController,uformWelcome,IWInit;


function TformMain.CheckUser(AUserName:string;APassword:string=''):Boolean;
begin
  if (AUserName = 'code6421') and (APassword = '1234') then
     Result:=True
  else Result:=False;
end;

procedure TformMain.IWButton1Click(Sender: TObject);
begin
 if CheckUser(edtUser.Text,edtPassword.Text) then
  begin
   TIWAppForm(RWebApplication.ActiveForm).Release;
   TformWelcome.Create(RWebApplication).Show;
   UserSession.UserName:=edtUser.Text;
  end
 else
   RWebApplication.ShowMessage('密碼錯誤!');
end;

end.
------------------------------------------------------------------------




----------------------------------程----------------------------------
(uUserSession.pas)
unit uUserSession;
// Created with Thor-Mjollnir Complex-Type Module Creator

interface

uses InvokeRegistry,Types,XMLSchema;

type
 TXSUserSession = class(TRemotable)
  private
    FUserName:string;
    //declare your data member,remember! data member need publish in published section
    { Private declarations }
  published
    property UserName:string read FUserName write FUserName;
    { Public declarations }
  end;

implementation

initialization
  RemClassRegistry.RegisterXSClass(TXSUserSession, '', 'TXSUserSession','');
finalization
  RemClassRegistry.UnRegisterXSClass(TXSUserSession);
end.
------------------------------------------------------------------------
----------------------------------程----------------------------------
(IWStateServerIntf.pas)
{ Invokable interface IIWStateServer }

unit IWStateServerIntf;

interface

uses InvokeRegistry, Types, XSBuiltIns,uUserSession;

type

  { Invokable interfaces must derive from IInvokable }
  IIWStateServer = interface(IInvokable)
  ['{9CDE74CF-BF1A-4D24-A6F1-A050DAD9EA94}']
    function  GetSession(AAppID:string;out AData:TXSUserSession):Boolean;stdcall;
    procedure PutSession(AAppID:string;AData:TXSUserSession);stdcall;
    procedure RemoveSession(AAppID:string);stdcall;
    { Methods of Invokable interface must not use the default }
    { calling convention; stdcall is recommended }
  end;

implementation

initialization
  { Invokable interfaces must be registered }
  InvRegistry.RegisterInterface(TypeInfo(IIWStateServer));

end.
------------------------------------------------------------------------
----------------------------------程----------------------------------
(IWStateServerImpl.pas)
{ Invokable implementation File for TIWStateServer which implements IIWStateServer }

unit IWStateServerImpl;

interface

uses Classes,InvokeRegistry, Types, XSBuiltIns, IWStateServerIntf,uUserSession;

type
  TSessionObject=class(TObject)
  private
      FAppID:string;
      FUserName:string;
  end;

  { TIWStateServer }
  TIWStateServer = class(TInvokableClass, IIWStateServer)
  private
    function  FindSession(AList:TList;AAppID:string):TSessionObject;
  public
    function  GetSession(AAppID:string;out AData:TXSUserSession):Boolean;stdcall;
    procedure PutSession(AAppID:string;AData:TXSUserSession);stdcall;
    procedure RemoveSession(AAppID:string);stdcall;
  end;

var
  GStateList:TThreadList;
implementation


function  TIWStateServer.FindSession(AList:TList;AAppID:string):TSessionObject;
var
   I:Integer;
begin
   for I:=0 to AList.Count-1 do
    begin
      if TSessionObject(AList[I]).FAppID = AAppID then
       begin
         Result:=TSessionObject(AList[I]);
         exit;
       end;
    end;
   Result:=Nil;
end;

function  TIWStateServer.GetSession(AAppID:string;out AData:TXSUserSession):Boolean;
var
  vList:TList;
  vSessObj:TSessionObject;
begin
  vList:=GStateList.LockList;
  try
    vSessObj:=FindSession(vList,AAppID);
    if Assigned(vSessObj) then
     begin
       AData:=TXSUserSession.Create;
       AData.UserName:=vSessObj.FUserName;
       Result:=True;
       exit;
     end;
  finally
    GStateList.UnlockList;
  end;
  Result:=False;
end;

procedure TIWStateServer.PutSession(AAppID:string;AData:TXSUserSession);
var
  vList:TList;
  vSessObj:TSessionObject;
begin
  vList:=GStateList.LockList;
  try
    vSessObj:=FindSession(vList,AAppID);
    if Assigned(vSessObj) then
       vSessObj.FUserName:=AData.UserName
    else
      begin
       vSessObj:=TSessionObject.Create;
       vSessObj.FUserName:=AData.UserName;
       vSessObj.FAppID:=AAppID;
       vList.Add(vSessObj);
      end;
  finally
    GStateList.UnlockList;
  end;
end;

procedure TIWStateServer.RemoveSession(AAppID:string);
var
  vList:TList;
  vSessObj:TSessionObject;
begin
  vList:=GStateList.LockList;
  try
    vSessObj:=FindSession(vList,AAppID);
    if Assigned(vSessObj) then
      begin
        vList.Remove(vSessObj);
        vSessObj.Free;
      end;
  finally
    GStateList.UnlockList;
  end;
end;


procedure FreeStateList;
var
  I:Integer;
  vList:TList;
begin
  vList:=GStateList.LockList;
  try
   for I:=0 to vList.Count-1 do
       TObject(vList[I]).Free;
  finally
   GStateList.UnlockList;
   GStateList.Free;
  end;
end;

initialization
  { Invokable classes must be registered }
  InvRegistry.RegisterInvokableClass(TIWStateServer);
  GStateList:=TThreadList.Create;
finalization
  FreeStateList;
End
------------------------------------------------------------------------





----------------------------------程----------------------------------
(IWStateServer1.pas)
unit IIWStateServer1;

interface

uses InvokeRegistry, SOAPHTTPClient, Types, XSBuiltIns;

type
  TXSUserSession       = class;                 { "urn:uUserSession" }
  TXSUserSession = class(TRemotable)
  private
    FUserName: WideString;
  published
    property UserName: WideString read FUserName write FUserName;
  end;
  IIWStateServer = interface(IInvokable)
  ['{4F7FAAF2-58BB-0AFC-E6D1-3806671A0481}']
    function  GetSession(const AAppID: WideString; out AData: TXSUserSession): Boolean; stdcall;
    procedure PutSession(const AAppID: WideString; const AData: TXSUserSession); stdcall;
    procedure RemoveSession(const AAppID: WideString); stdcall;
  end;

function GetIIWStateServer(UseWSDL: Boolean=System.False; Addr: string=''; HTTPRIO: THTTPRIO = nil): IIWStateServer;

implementation

function GetIIWStateServer(UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): IIWStateServer;
const
  defWSDL = 'http://192.168.0.1/TESTSRV/IWStateServerISAPI.dll/wsdl/IIWStateServer';
  defURL  = 'http://192.168.0.1/TESTSRV/IWStateServerISAPI.dll/soap/IIWStateServer';
  defSvc  = 'IIWStateServerservice';
  defPrt  = 'IIWStateServerPort';
var
  RIO: THTTPRIO;
begin
  Result := nil;
  if (Addr = '') then
  begin
    if UseWSDL then
      Addr := defWSDL
    else
      Addr := defURL;
  end;
  if HTTPRIO = nil then
    RIO := THTTPRIO.Create(nil)
  else
    RIO := HTTPRIO;
  try
    Result := (RIO as IIWStateServer);
    if UseWSDL then
    begin
      RIO.WSDLLocation := Addr;
      RIO.Service := defSvc;
      RIO.Port := defPrt;
    end else
      RIO.URL := Addr;
  finally
    if (Result = nil) and (HTTPRIO = nil) then
      RIO.Free;
  end;
end;


initialization
  InvRegistry.RegisterInterface(TypeInfo(IIWStateServer), 'urn:IWStateServerIntf-IIWStateServer', 'utf-8');
  InvRegistry.RegisterDefaultSOAPAction(TypeInfo(IIWStateServer), 'urn:IWStateServerIntf-IIWStateServer#%operationName%');
  RemClassRegistry.RegisterXSClass(TXSUserSession, 'urn:uUserSession', 'TXSUserSession');

end.
------------------------------------------------------------------------
----------------------------------程----------------------------------
(ServerController.pas)
Unit ServerController;
{PUBDIST}

interface

uses
  SysUtils, Classes, IWServerControllerBase,
  IWApplication, IWAppForm,IIWStateServer1;

type
  TIWServerController = class(TIWServerControllerBase)
    procedure IWServerControllerBaseNewSession(ASession: TIWApplication;
      var VMainForm: TIWAppForm);
    procedure IWServerControllerBaseCloseSession(ASession: TIWApplication);
  private
  public
  end;

  TUserInfo=class
  private
    FUserName:string;
  public
    property UserName:string read FUserName write FUserName;
  end;

  TUserSession = class
  private
    FServer:IIWStateServer;
  public
    constructor Create;
    function GetUserInfo:TUserInfo;
    procedure SetUserInfo(Value:TUserInfo);
  end;

  function UserSession: TUserSession;

implementation
{$R *.dfm}

uses
  IWInit;

function TUserSession.GetUserInfo:TUserInfo;
var
  vXSInfo:TXSUserSession;
begin
  FServer.GetSession(RWebApplication.AppID,vXSInfo);
  Result:=TUserInfo.Create;
  try
   Result.UserName:=vXSInfo.UserName;
  finally
   vXSInfo.Free;
  end;
end;

procedure TUserSession.SetUserInfo(Value:TUserInfo);
var
  vXSInfo:TXSUserSession;
begin
  vXSInfo:=TXSUserSession.Create;
  try
   vXSInfo.UserName:=Value.UserName;
   FServer.PutSession(RWebApplication.AppID,vXSInfo);
  finally
   vXSInfo.Free;
  end;
end;

constructor TUserSession.Create;
var
  vInitData:TXSUserSession;
begin
  FServer:=GetIIWStateServer;
  vInitData:=TXSUserSession.Create;
  try
    vInitData.UserName:='';
    FServer.PutSession(RWebApplication.AppID,vInitData);
  finally
    vInitData.Free;
  end;
end;


function UserSession: TUserSession;
begin
  Result := TUserSession(RWebApplication.Data);
end;

procedure TIWServerController.IWServerControllerBaseNewSession(
  ASession: TIWApplication; var VMainForm: TIWAppForm);
begin
  ASession.Data := TUserSession.Create;
end;

procedure TIWServerController.IWServerControllerBaseCloseSession(
  ASession: TIWApplication);
begin
  TUserSession(ASession.Data).FServer.RemoveSession(ASession.AppID);
end;

end.
------------------------------------------------------------------------
----------------------------------程----------------------------------
(uformLogin.pas)
unit uformLogin;
{PUBDIST}

interface

uses
  IWAppForm, IWApplication, IWTypes, IWCompButton, IWCompEdit, Classes,
  Controls, IWControl, IWCompLabel,SysUtils,ServerController;

type
  TformMain = class(TIWAppForm)
    IWLabel1: TIWLabel;
    IWLabel2: TIWLabel;
    edtUser: TIWEdit;
    edtPassword: TIWEdit;
    IWButton1: TIWButton;
    procedure IWButton1Click(Sender: TObject);
    procedure IWAppFormAfterRender(Sender: TObject);
  private
    FCacheInfo:TUserInfo;
    function  CheckUser(AUserName:string;APassword:string=''):Boolean;
  public
    procedure DispatchToPage(APageClass:TIWAppFormClass);
    procedure GenerateForm(AStream:TStream);override;
  end;

implementation
{$R *.dfm}

uses
  uformWelcome,IWInit;

const
  sUserID='UserID';
  sSessionID='LastSessionID';


procedure TformMain.GenerateForm(AStream:TStream);
begin
  if not Assigned(FCacheInfo) then FCacheInfo:=UserSession.GetUserInfo;
  try
   if FCacheInfo.UserName <> '' then
    begin
     DispatchToPage(TformWelcome);
     TIWAppForm(RWebApplication.ActiveForm).GenerateForm(AStream);
     UserSession.SetUserInfo(FCacheInfo);
    end
   else inherited GenerateForm(AStream);
  finally
   FreeAndNil(FCacheInfo);
  end;
end;

procedure TformMain.DispatchToPage(APageClass:TIWAppFormClass);
begin
 TIWAppForm(RWebApplication.ActiveForm).Release;
 APageClass.Create(RWebApplication).Show;
end;


function TformMain.CheckUser(AUserName:string;APassword:string=''):Boolean;
begin
  if (AUserName = 'code6421') and ((APassword = '1234') or (APassword = '')) then
     Result:=True
  else Result:=False;
end;

procedure TformMain.IWButton1Click(Sender: TObject);
begin
 if CheckUser(edtUser.Text,edtPassword.Text) then
  begin
   if not Assigned(FCacheInfo) then FCacheInfo:=UserSession.GetUserInfo;
   TIWAppForm(RWebApplication.ActiveForm).Release;
   TformWelcome.Create(RWebApplication).Show;
   FCacheInfo.UserName:=edtUser.Text;
   UserSession.SetUserInfo(FCacheInfo);
   FreeAndNil(FCacheInfo);
  end
 else
   RWebApplication.ShowMessage('密碼錯誤!');
end;

procedure TformMain.IWAppFormAfterRender(Sender: TObject);
begin
  if Assigned(FCacheInfo) then
   begin
     UserSession.SetUserInfo(FCacheInfo);
     FreeAndNil(FCacheInfo);
   end;
end;

end.
------------------------------------------------------------------------
----------------------------------程----------------------------------
(formWelcome.pas)
unit uformWelcome;
{PUBDIST}

interface

uses
  SysUtils,IWAppForm, IWApplication, IWTypes, Classes, Controls, IWControl,
  IWCompLabel;

type
  TformWelcome = class(TIWAppForm)
    IWLabel1: TIWLabel;
    procedure IWAppFormRender(Sender: TObject);
  public
  end;

implementation
{$R *.dfm}

uses
  ServerController;

procedure TformWelcome.IWAppFormRender(Sender: TObject);
var
   vData:TUserInfo;
begin
   vData:=UserSession.GetUserInfo;
   try
    IWLabel1.Caption:=Format('歡迎 %s',[vData.UserName]);
   finally
    vData.Free;
   end;
end;

end.
------------------------------------------------------------------------