fcl-web module to integrate WST in a fcl-web application by Michael Van Canneyt

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1230 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2010-05-26 08:43:29 +00:00
parent 06ae369ff5
commit 739b3a43cb
21 changed files with 2416 additions and 0 deletions

View File

@ -0,0 +1,54 @@
This is a fcl-web module to integrate WST in a fcl-web application.
The main class is the TWSTModule web module. It is registered in the Lazarus
IDE when the package is installed, and can be created using the File-New
module.
All that needs to be done is register the module in the correct location.
For instance using WST as the module name will make the module available
through the following URL:
http://myhost/WST
The default action is to display a list of defined service repositories.
The WSDL of a Service can be obtained through
http://myhost/WST/WSDL/ServiceName
To call a service, the URL is as follows:
http://myhost/WST/FORMAT/ServiceName
Where FORMAT is one of the supported encoding formats: SOAP, JSON, XML-RPC.
For example:
http://myhost/WST/SOAP/UserService
The following events exist:
BeforeGenerateWSDLTable,
AfterGenerateWSDLTable : Called before/after the list of services is generated.
BeforeGenerateWSDL,
AfterGenerateWSDL : Called before/after the WSDL for a specific service is
generated.
BeforeServiceRequest,
AfterServiceRequest: Called before/after a service request. In the
beforeservcierequest, a parameter can be set to indicate that the request
was handled by the event handler. Further processing of the request will
then be postponed
OnSetSessionProperties: Called when the request properties (using
IPropertyManager) are set. By default, the following properties are set:
SessionID : If CreateSession is 'True' the session ID is passed.
RemoteIP : The remote IP address (if available)
RemoteHost: The remote hostname (if available)
Additional properties can be written in a stringlist in the form
Name=Value.
Enjoy!
Michael.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,542 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<Runnable Value="False"/>
</Flags>
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<VersionInfo>
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="fclwebwst"/>
</Item1>
<Item2>
<PackageName Value="WebLaz"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
</Item4>
</RequiredPackages>
<Units Count="38">
<Unit0>
<Filename Value="demoservice.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="demoservice"/>
<EditorIndex Value="12"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="6" Y="1"/>
<UsageCount Value="71"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="wmhandler.pp"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="WSTModule1"/>
<ResourceBaseClass Value="DataModule"/>
<UnitName Value="wmhandler"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="19"/>
<CursorPos X="53" Y="29"/>
<ComponentState Value="1"/>
<UsageCount Value="71"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="imp_helper.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="imp_helper"/>
<TopLine Value="1"/>
<CursorPos X="6" Y="11"/>
<UsageCount Value="71"/>
</Unit2>
<Unit3>
<Filename Value="user_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/>
<EditorIndex Value="4"/>
<WindowIndex Value="0"/>
<TopLine Value="67"/>
<CursorPos X="11" Y="77"/>
<UsageCount Value="71"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="user_service_intf_binder.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf_binder"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<TopLine Value="270"/>
<CursorPos X="1" Y="290"/>
<UsageCount Value="71"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="user_service_intf_imp.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf_imp"/>
<EditorIndex Value="17"/>
<WindowIndex Value="0"/>
<TopLine Value="22"/>
<CursorPos X="26" Y="46"/>
<UsageCount Value="71"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="user_service_intf_proxy.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf_proxy"/>
<TopLine Value="148"/>
<CursorPos X="4" Y="185"/>
<UsageCount Value="71"/>
</Unit6>
<Unit7>
<Filename Value="std_cursors.pas"/>
<UnitName Value="std_cursors"/>
<TopLine Value="2"/>
<CursorPos X="3" Y="23"/>
<UsageCount Value="5"/>
</Unit7>
<Unit8>
<Filename Value="../wstmodule.pas"/>
<HasResources Value="True"/>
<UnitName Value="wstmodule"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="6"/>
<WindowIndex Value="0"/>
<TopLine Value="45"/>
<CursorPos X="10" Y="66"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="../../../Documents/source/wst/wst_global.inc"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="36" Y="18"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="../../../fpc/packages/fcl-web/src/httpdefs.pp"/>
<UnitName Value="HTTPDefs"/>
<WindowIndex Value="0"/>
<TopLine Value="12"/>
<CursorPos X="27" Y="25"/>
<UsageCount Value="15"/>
</Unit10>
<Unit11>
<Filename Value="../../../fpc/packages/fcl-web/src/fphttp.pp"/>
<UnitName Value="fphttp"/>
<WindowIndex Value="0"/>
<TopLine Value="101"/>
<CursorPos X="14" Y="112"/>
<UsageCount Value="16"/>
</Unit11>
<Unit12>
<Filename Value="../../../fpc/packages/fcl-web/src/fpweb.pp"/>
<UnitName Value="fpWeb"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="442"/>
<UsageCount Value="5"/>
</Unit12>
<Unit13>
<Filename Value="../../../fpc/packages/fcl-web/src/fpcgi.pp"/>
<UnitName Value="fpcgi"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="27" Y="20"/>
<UsageCount Value="16"/>
</Unit13>
<Unit14>
<Filename Value="../../../fpc/packages/fcl-web/src/custcgi.pp"/>
<UnitName Value="custcgi"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="16"/>
</Unit14>
<Unit15>
<Filename Value="../../../fpc/packages/fcl-web/src/custweb.pp"/>
<UnitName Value="custweb"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="3" Y="15"/>
<UsageCount Value="16"/>
</Unit15>
<Unit16>
<Filename Value="../../../fpc/lazarus/components/fpweb/weblazideintf.pp"/>
<UnitName Value="WebLazIDEIntf"/>
<TopLine Value="109"/>
<CursorPos X="40" Y="122"/>
<UsageCount Value="5"/>
</Unit16>
<Unit17>
<Filename Value="../regwstmodule.pp"/>
<UnitName Value="regwstmodule"/>
<TopLine Value="22"/>
<CursorPos X="48" Y="40"/>
<UsageCount Value="5"/>
</Unit17>
<Unit18>
<Filename Value="../../../Documents/source/wst/metadata_wsdl.pas"/>
<UnitName Value="metadata_wsdl"/>
<TopLine Value="46"/>
<CursorPos X="49" Y="67"/>
<UsageCount Value="5"/>
</Unit18>
<Unit19>
<Filename Value="../../../Documents/source/wst/wst_rtti_filter/cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<TopLine Value="1"/>
<CursorPos X="14" Y="13"/>
<UsageCount Value="5"/>
</Unit19>
<Unit20>
<Filename Value="../../../Documents/source/wst/wst_rtti_filter/rtti_filters.pas"/>
<UnitName Value="rtti_filters"/>
<TopLine Value="1"/>
<CursorPos X="14" Y="13"/>
<UsageCount Value="5"/>
</Unit20>
<Unit21>
<Filename Value="../../../Documents/source/wst/wst_rtti_filter/std_cursors.pas"/>
<UnitName Value="std_cursors"/>
<TopLine Value="1"/>
<CursorPos X="14" Y="23"/>
<UsageCount Value="5"/>
</Unit21>
<Unit22>
<Filename Value="../../../Documents/source/wst/wst_rtti_filter/wst_cursors.pas"/>
<UnitName Value="wst_cursors"/>
<TopLine Value="1"/>
<CursorPos X="14" Y="13"/>
<UsageCount Value="5"/>
</Unit22>
<Unit23>
<Filename Value="../../../Documents/source/wst/server_service_json.pas"/>
<UnitName Value="server_service_json"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="91"/>
<CursorPos X="18" Y="111"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit23>
<Unit24>
<Filename Value="../../../Documents/source/wst/base_json_formatter.pas"/>
<UnitName Value="base_json_formatter"/>
<EditorIndex Value="5"/>
<WindowIndex Value="0"/>
<TopLine Value="677"/>
<CursorPos X="45" Y="697"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit24>
<Unit25>
<Filename Value="../../../Documents/source/wst/base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="5"/>
</Unit25>
<Unit26>
<Filename Value="../../../Documents/source/wst/server_service_intf.pas"/>
<UnitName Value="server_service_intf"/>
<EditorIndex Value="11"/>
<WindowIndex Value="0"/>
<TopLine Value="42"/>
<CursorPos X="35" Y="53"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit26>
<Unit27>
<Filename Value="../../../fpc/rtl/unix/sysutils.pp"/>
<UnitName Value="sysutils"/>
<EditorIndex Value="16"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="18" Y="7"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="../../../Documents/source/wst/wst_rtti_filter/dom_cursors.pas"/>
<UnitName Value="dom_cursors"/>
<EditorIndex Value="14"/>
<WindowIndex Value="0"/>
<TopLine Value="7"/>
<CursorPos X="14" Y="29"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit28>
<Unit29>
<Filename Value="../../../Documents/source/wst/type_lib_edtr/uwsttypelibraryedit.pas"/>
<ComponentName Value="fWstTypeLibraryEdit"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uwsttypelibraryedit"/>
<EditorIndex Value="15"/>
<WindowIndex Value="0"/>
<TopLine Value="485"/>
<CursorPos X="40" Y="503"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit29>
<Unit30>
<Filename Value="user_service_intf.wst"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="1" Y="1"/>
<UsageCount Value="9"/>
<DefaultSyntaxHighlighter Value="None"/>
</Unit30>
<Unit31>
<Filename Value="../../../fpc/packages/fcl-web/src/fpapache.pp"/>
<UnitName Value="fpapache"/>
<WindowIndex Value="0"/>
<TopLine Value="251"/>
<CursorPos X="14" Y="256"/>
<UsageCount Value="13"/>
</Unit31>
<Unit32>
<Filename Value="../../../Documents/source/wst/metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<EditorIndex Value="9"/>
<WindowIndex Value="0"/>
<TopLine Value="80"/>
<CursorPos X="3" Y="95"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit32>
<Unit33>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<UnitName Value="ssfpc"/>
<EditorIndex Value="10"/>
<WindowIndex Value="0"/>
<TopLine Value="634"/>
<CursorPos X="139" Y="635"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit33>
<Unit34>
<Filename Value="../../../Documents/source/synapse-38/source/lib/ssfpc.pas"/>
<UnitName Value="ssfpc"/>
<WindowIndex Value="0"/>
<TopLine Value="506"/>
<CursorPos X="6" Y="517"/>
<UsageCount Value="10"/>
</Unit34>
<Unit35>
<Filename Value="../../../fpc/rtl/objpas/sysutils/sysutilh.inc"/>
<EditorIndex Value="13"/>
<WindowIndex Value="0"/>
<TopLine Value="246"/>
<CursorPos X="25" Y="257"/>
<SyntaxHighlighter Value="FreePascal"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Text"/>
</Unit35>
<Unit36>
<Filename Value="../../../Documents/source/wst/server_service_imputils.pas"/>
<UnitName Value="server_service_imputils"/>
<EditorIndex Value="8"/>
<WindowIndex Value="0"/>
<TopLine Value="15"/>
<CursorPos X="3" Y="26"/>
<SyntaxHighlighter Value="FreePascal"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Text"/>
</Unit36>
<Unit37>
<Filename Value="../../../fpc/packages/fcl-web/src/websession.pp"/>
<UnitName Value="websession"/>
<EditorIndex Value="7"/>
<WindowIndex Value="0"/>
<TopLine Value="308"/>
<CursorPos X="1" Y="310"/>
<SyntaxHighlighter Value="FreePascal"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Text"/>
</Unit37>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="../wstmodule.pas"/>
<Caret Line="116" Column="22" TopLine="105"/>
</Position1>
<Position2>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="519" Column="23" TopLine="506"/>
</Position3>
<Position4>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="517" Column="16" TopLine="506"/>
</Position4>
<Position5>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="521" Column="29" TopLine="506"/>
</Position5>
<Position6>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="543" Column="29" TopLine="522"/>
</Position6>
<Position7>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="539" Column="35" TopLine="528"/>
</Position7>
<Position8>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="562" Column="41" TopLine="552"/>
</Position8>
<Position9>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="577" Column="38" TopLine="556"/>
</Position9>
<Position10>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="569" Column="51" TopLine="557"/>
</Position10>
<Position11>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="576" Column="59" TopLine="565"/>
</Position11>
<Position12>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="589" Column="23" TopLine="578"/>
</Position12>
<Position13>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="595" Column="31" TopLine="584"/>
</Position13>
<Position14>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="606" Column="23" TopLine="585"/>
</Position14>
<Position15>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="601" Column="62" TopLine="590"/>
</Position15>
<Position16>
<Filename Value="/wisa/projects/fpcpackages/synapse/source/lib/ssfpc.pas"/>
<Caret Line="620" Column="29" TopLine="605"/>
</Position16>
<Position17>
<Filename Value="../wstmodule.pas"/>
<Caret Line="199" Column="29" TopLine="180"/>
</Position17>
<Position18>
<Filename Value="../wstmodule.pas"/>
<Caret Line="172" Column="18" TopLine="165"/>
</Position18>
<Position19>
<Filename Value="../wstmodule.pas"/>
<Caret Line="179" Column="24" TopLine="178"/>
</Position19>
<Position20>
<Filename Value="../wstmodule.pas"/>
<Caret Line="41" Column="122" TopLine="23"/>
</Position20>
<Position21>
<Filename Value="../wstmodule.pas"/>
<Caret Line="182" Column="1" TopLine="175"/>
</Position21>
<Position22>
<Filename Value="../wstmodule.pas"/>
<Caret Line="171" Column="88" TopLine="166"/>
</Position22>
<Position23>
<Filename Value="../wstmodule.pas"/>
<Caret Line="56" Column="27" TopLine="56"/>
</Position23>
<Position24>
<Filename Value="../wstmodule.pas"/>
<Caret Line="8" Column="65" TopLine="1"/>
</Position24>
<Position25>
<Filename Value="../wstmodule.pas"/>
<Caret Line="179" Column="7" TopLine="168"/>
</Position25>
<Position26>
<Filename Value="../wstmodule.pas"/>
<Caret Line="181" Column="51" TopLine="169"/>
</Position26>
<Position27>
<Filename Value="../wstmodule.pas"/>
<Caret Line="176" Column="15" TopLine="173"/>
</Position27>
<Position28>
<Filename Value="../wstmodule.pas"/>
<Caret Line="232" Column="24" TopLine="213"/>
</Position28>
<Position29>
<Filename Value="../wstmodule.pas"/>
<Caret Line="19" Column="36" TopLine="12"/>
</Position29>
<Position30>
<Filename Value="../wstmodule.pas"/>
<Caret Line="245" Column="7" TopLine="245"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Target>
<Filename Value="demoservice.cgi"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)/"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,16 @@
program demoservice;
{$mode objfpc}{$H+}
uses
fpCGI, wmhandler, imp_helper, user_service_intf, user_service_intf_binder,
user_service_intf_imp, user_service_intf_proxy;
{$IFDEF WINDOWS}{$R demoservice.rc}{$ENDIF}
begin
Application.Initialize;
Application.AllowDefaultModule:=True;
Application.Run;
end.

View File

@ -0,0 +1 @@
MAINICON ICON "demoservice.ico"

Binary file not shown.

View File

@ -0,0 +1,77 @@
{$mode objfpc}{$h+}
{ $INCLUDE wst_global.inc}
unit imp_helper;
interface
uses
Classes, SysUtils,
base_service_intf,
base_binary_formatter;
procedure SaveObjectToStream(AObject : TPersistent; AStream : TStream);
procedure LoadObjectFromStream(AObject : TPersistent; AStream : TStream);
procedure SaveObjectToFile(AObject : TPersistent; const AFileName : string);
procedure LoadObjectFromFile(AObject : TPersistent; const AFileName : string);
implementation
uses TypInfo;
procedure SaveObjectToFile(AObject : TPersistent; const AFileName : string);
var
strm : TFileStream;
begin
if FileExists(AFileName) then
DeleteFile(AFileName);
strm := TFileStream.Create(AFileName,fmCreate);
try
SaveObjectToStream(AObject,strm);
finally
strm.Free();
end;
end;
procedure LoadObjectFromFile(AObject : TPersistent; const AFileName : string);
var
strm : TFileStream;
begin
if not FileExists(AFileName) then
raise Exception.CreateFmt('File not found : "%s"',[AFileName]);
strm := TFileStream.Create(AFileName,fmOpenRead);
try
LoadObjectFromStream(AObject,strm);
finally
strm.Free();
end;
end;
procedure SaveObjectToStream(AObject : TPersistent; AStream : TStream);
var
srlzr : IFormatterBase;
begin
srlzr := TBaseBinaryFormatter.Create();
srlzr.BeginObject('root',TypeInfo(TPersistent));
srlzr.Put('object',PTypeInfo(AObject.ClassInfo),AObject);
srlzr.EndScope();
srlzr.SaveToStream(AStream);
end;
procedure LoadObjectFromStream(AObject : TPersistent; AStream : TStream);
var
srlzr : IFormatterBase;
nme : string;
begin
srlzr := TBaseBinaryFormatter.Create();
srlzr.LoadFromStream(AStream);
nme := 'root';
srlzr.BeginObjectRead(nme,TypeInfo(TPersistent));
nme := 'object';
srlzr.Get(PTypeInfo(AObject.ClassInfo),nme,AObject);
srlzr.EndScopeRead();
end;
end.

View File

@ -0,0 +1,132 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2006, 2007, 2008 by Inoussa OUEDRAOGO
This file is provide under modified LGPL licence
( the files COPYING.modifiedLGPL and COPYING.LGPL).
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
{ $INCLUDE wst_global.inc}
unit std_cursors;
interface
uses
Classes, SysUtils, Contnrs,
cursor_intf;
{ $INCLUDE wst.inc}
{ $INCLUDE wst_delphi.inc}
type
{ TObjectListCursor }
TObjectListCursor = class(TInterfacedObject,ICursor,IObjectCursor)
private
FList : TObjectList;
FCurrentIndex : Integer;
protected
procedure Reset();
function MoveNext() : Boolean;virtual;
function Clone():ICursor;
function GetCount() : PtrInt;
function GetCurrent() : TObject;
public
constructor Create(ADataList : TObjectList);
end;
{ TObjectListFilterableCursor }
TObjectListFilterableCursor = class(TObjectListCursor,IFilterableObjectCursor)
private
FFilter : IObjectFilter;
protected
function MoveNext() : Boolean;override;
function GetFilter() : IObjectFilter;
function SetFilter(const AFilter : IObjectFilter) : IObjectFilter;
public
destructor Destroy();override;
end;
implementation
{ TObjectListCursor }
procedure TObjectListCursor.Reset();
begin
FCurrentIndex := -1;
end;
function TObjectListCursor.MoveNext(): Boolean;
begin
Inc(FCurrentIndex);
Result := ( FCurrentIndex < FList.Count );
end;
function TObjectListCursor.Clone(): ICursor;
begin
Result := TObjectListCursor.Create(FList) as ICursor;
end;
function TObjectListCursor.GetCount() : PtrInt;
begin
Result := FList.Count;
end;
function TObjectListCursor.GetCurrent(): TObject;
begin
if ( FCurrentIndex < 0 ) or ( FCurrentIndex >= FList.Count ) then
raise ECursorException.Create('Invalid cursor state.');
Result := FList[FCurrentIndex];
end;
constructor TObjectListCursor.Create(ADataList: TObjectList);
begin
Assert(Assigned(ADataList));
FList := ADataList;
Reset();
end;
{ TObjectListFilterableCursor }
function TObjectListFilterableCursor.MoveNext(): Boolean;
begin
if ( FFilter = nil ) then begin
Result := inherited MoveNext();
end else begin
while ( inherited MoveNext() ) do begin
if FFilter.Evaluate(GetCurrent()) then begin
Result := True;
Exit;
end;
end;
Result := False;
end;
end;
function TObjectListFilterableCursor.GetFilter(): IObjectFilter;
begin
Result := FFilter;
end;
function TObjectListFilterableCursor.SetFilter(
const AFilter: IObjectFilter
): IObjectFilter;
begin
FFilter := AFilter;
Result := FFilter;
end;
destructor TObjectListFilterableCursor.Destroy();
begin
FFilter := nil;
inherited Destroy();
end;
end.

View File

@ -0,0 +1,293 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf".
Date : "29/01/2010 14:54:18".
}
unit user_service_intf;
{$IFDEF FPC}
{$mode objfpc} {$H+}
{$ENDIF}
{$IFNDEF FPC}
{$DEFINE WST_RECORD_RTTI}
{$ENDIF}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'urn:UserService';
sUNIT_NAME = 'user_service_intf';
type
TUserArray = class;
TUser = class;
TNote = class;
TUserCategory = (
Normal
,Admin
);
TUser = class(TBaseComplexRemotable)
private
FCategory : TUserCategory;
FUserName : string;
FeMail : string;
FPreferences : string;
FNote : TNote;
public
constructor Create();override;
procedure FreeObjectProperties();override;
published
property Category : TUserCategory read FCategory write FCategory;
property UserName : string read FUserName write FUserName;
property eMail : string read FeMail write FeMail;
property Preferences : string read FPreferences write FPreferences;
property Note : TNote read FNote write FNote;
end;
TNote = class(TBaseComplexRemotable)
private
FHeader : string;
FAuthor : string;
FDate : string;
published
property Header : string read FHeader write FHeader;
property Author : string read FAuthor write FAuthor;
property Date : string read FDate write FDate;
end;
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TUser;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TUser Read GetItem;Default;
end;
UserService = interface(IInvokable)
['{2F9B181F-BA33-4148-A2A3-42CB450C43CE}']
function GetList():TUserArray;
procedure Add(
const AUser : TUser
);
procedure Update(
const AUser : TUser
);
function Find(
const AName : string
):TUser;
function Delete(
const AName : string
):boolean;
end;
procedure Register_user_service_intf_ServiceMetadata();
Implementation
uses metadata_repository, record_rtti, wst_types;
{ TUser }
constructor TUser.Create();
begin
inherited Create();
FNote := TNote.Create();
end;
procedure TUser.FreeObjectProperties();
begin
if Assigned(FNote) then
FreeAndNil(FNote);
inherited FreeObjectProperties();
end;
{ TUserArray }
function TUserArray.GetItem(AIndex: Integer): TUser;
begin
Result := TUser(Inherited GetItem(AIndex));
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result:= TUser;
end;
procedure Register_user_service_intf_ServiceMetadata();
var
mm : IModuleMetadataMngr;
begin
mm := GetModuleMetadataMngr();
mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'TRANSPORT_Address',
'http://127.0.0.1:8000/services/UserService'
);
mm.SetServiceCustomData(
sUNIT_NAME,
'UserService',
'FORMAT_Style',
'rpc'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'_E_N_',
'GetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceGetList'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'GetList',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'_E_N_',
'Add'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceAdd'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Add',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'_E_N_',
'Update'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceUpdate'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Update',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'_E_N_',
'Find'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceFind'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Find',
'FORMAT_OutputEncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'_E_N_',
'Delete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'TRANSPORT_soapAction',
'urn:UserService/UserServiceDelete'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_Input_EncodingStyle',
'literal'
);
mm.SetOperationCustomData(
sUNIT_NAME,
'UserService',
'Delete',
'FORMAT_OutputEncodingStyle',
'literal'
);
end;
var
typeRegistryInstance : TTypeRegistry = nil;
initialization
typeRegistryInstance := GetTypeRegistry();
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TUserCategory),'TUserCategory');
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TUser),'TUser');
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TNote),'TNote');
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TUserArray),'TUserArray');
End.

View File

@ -0,0 +1,9 @@
GetWSTResourceManager().AddResource('USER_SERVICE_INTF',
#0#0#0#16'WST_METADATA_0.6'#0#0#0#17'user_service_intf'#0#1#0#0#0#11'UserSer'
+'vice'#0#5#0#0#0#7'GetList'#1#0#0#0#6'Result'#0#0#0#10'TUserArray'#0#0#0#0#0
+#0#0#3#0#0#0#3'Add'#1#0#0#0#5'AUser'#0#0#0#5'TUser'#0#0#0#0#0#0#0#1#0#0#0#6'U'
+'pdate'#1#0#0#0#5'AUser'#0#0#0#5'TUser'#0#0#0#0#0#0#0#1#0#0#0#4'Find'#2#0#0#0
+#5'AName'#0#0#0#6'string'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#5'TUser'#0#0
+#0#0#0#0#0#3#0#0#0#6'Delete'#2#0#0#0#5'AName'#0#0#0#6'string'#0#0#0#0#0#0#0#1
+#0#0#0#6'Result'#0#0#0#7'boolean'#0#0#0#0#0#0#0#3''
);

View File

@ -0,0 +1,75 @@
unit user_service_intf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, base_service_intf;
type
TUserCategory = ( Normal, Admin );
{ TUser }
TUser = class(TBaseComplexRemotable)
private
FCategory: TUserCategory;
FeMail: string;
FName: string;
FPreferences: string;
published
property Category : TUserCategory read FCategory write FCategory;
property Name : string read FName write FName;
property eMail : string read FeMail write FeMail;
property Preferences : string read FPreferences write FPreferences;
end;
{ TUserArray }
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetUser(AIndex: Integer): TUser;
public
class function GetItemClass():TBaseRemotableClass;override;
Property Item[AIndex:Integer] : TUser Read GetUser;Default;
End;
UserService = interface(IInvokable)
['{101F2CA7-19FC-4A73-AA98-F13FCDA75EE1}']
function GetList():TUserArray;
procedure Add(AUser : TUser);
function Find(const AName : string):TUser;
function Delete(const AName : string):Boolean;
end;
procedure Register_user_service_intf_NameSpace();
implementation
uses metadata_repository;
procedure Register_user_service_intf_NameSpace();
begin
GetModuleMetadataMngr().SetRepositoryNameSpace('user_service_intf','urn:UserService');
end;
{ TUserArray }
function TUserArray.GetUser(AIndex: Integer): TUser;
begin
Result := GetItem(AIndex) as TUser;
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result := TUser;
end;
initialization
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUserCategory),'TUserCategory');
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUser),'TUser');
GetTypeRegistry().Register('urn:UserService',TypeInfo(TUserArray),'TUserArray');
end.

View File

@ -0,0 +1,293 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_binder".
Date : "24-3-10 14:38:50".
}
unit user_service_intf_binder;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, base_service_intf, server_service_intf, user_service_intf;
type
TUserService_ServiceBinder = class(TBaseServiceBinder)
protected
procedure GetListHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure UpdateHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure FindHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
procedure DeleteHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
public
constructor Create();
end;
type
TUserService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
private
FInstance : IInterface;
protected
function CreateInstance():IInterface;
public
constructor Create();
destructor Destroy();override;
end;
procedure Server_service_RegisterUserServiceService();
Implementation
uses TypInfo, wst_resources_imp,metadata_repository;
{ TUserService_ServiceBinder implementation }
procedure TUserService_ServiceBinder.GetListHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
locStrPrmName : string;
procName,trgName : string;
returnVal : TUserArray;
begin
callCtx := AContext;
Fillchar(returnVal,SizeOf(TUserArray),#0);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.GetList();
if Assigned(TObject(returnVal)) then
callCtx.AddObjectToFree(TObject(returnVal));
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(TUserArray),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
locStrPrmName : string;
procName,trgName : string;
AUser : TUser;
begin
callCtx := AContext;
Fillchar(AUser,SizeOf(TUser),#0);
locStrPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser),locStrPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Add(AUser);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.UpdateHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
locStrPrmName : string;
procName,trgName : string;
AUser : TUser;
begin
callCtx := AContext;
Fillchar(AUser,SizeOf(TUser),#0);
locStrPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser),locStrPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Update(AUser);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.FindHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
locStrPrmName : string;
procName,trgName : string;
AName : string;
returnVal : TUser;
begin
callCtx := AContext;
Fillchar(returnVal,SizeOf(TUser),#0);
locStrPrmName := 'AName'; AFormatter.Get(TypeInfo(string),locStrPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Find(AName);
if Assigned(TObject(returnVal)) then
callCtx.AddObjectToFree(TObject(returnVal));
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(TUser),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.DeleteHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
locStrPrmName : string;
procName,trgName : string;
AName : string;
returnVal : boolean;
begin
callCtx := AContext;
locStrPrmName := 'AName'; AFormatter.Get(TypeInfo(string),locStrPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Delete(AName);
procName := AFormatter.GetCallProcedureName();
trgName := AFormatter.GetCallTarget();
AFormatter.Clear();
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.Put('result',TypeInfo(boolean),returnVal);
AFormatter.EndCallResponse();
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
constructor TUserService_ServiceBinder.Create();
begin
inherited Create(GetServiceImplementationRegistry().FindFactory('UserService'));
RegisterVerbHandler('GetList',{$IFDEF FPC}@{$ENDIF}GetListHandler);
RegisterVerbHandler('Add',{$IFDEF FPC}@{$ENDIF}AddHandler);
RegisterVerbHandler('Update',{$IFDEF FPC}@{$ENDIF}UpdateHandler);
RegisterVerbHandler('Find',{$IFDEF FPC}@{$ENDIF}FindHandler);
RegisterVerbHandler('Delete',{$IFDEF FPC}@{$ENDIF}DeleteHandler);
end;
{ TUserService_ServiceBinderFactory }
function TUserService_ServiceBinderFactory.CreateInstance():IInterface;
begin
Result := FInstance;
end;
constructor TUserService_ServiceBinderFactory.Create();
begin
FInstance := TUserService_ServiceBinder.Create() as IInterface;
end;
destructor TUserService_ServiceBinderFactory.Destroy();
begin
FInstance := nil;
inherited Destroy();
end;
procedure Server_service_RegisterUserServiceService();
Begin
GetServerServiceRegistry().Register('UserService',TUserService_ServiceBinderFactory.Create() as IItemFactory);
End;
initialization
{$i user_service_intf.wst}
{$IF DECLARED(Register_user_service_intf_ServiceMetadata)}
Register_user_service_intf_ServiceMetadata();
{$IFEND}
End.

View File

@ -0,0 +1,234 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_imp".
Date : "30/04/2007 00:07".
}
Unit user_service_intf_imp;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes,
base_service_intf, server_service_intf, server_service_imputils,
user_service_intf, cursor_intf;
Type
{ TUserService_ServiceImp }
TUserService_ServiceImp=class(TActivableServiceImplementation,UserService)
protected
procedure Activate();override;
procedure Deactivate();override;
function CanBePooled() : Boolean;override;
Protected
function GetList():TUserArray;
procedure Add(
Const AUser : TUser
);
procedure Update(
Const AUser : TUser
);
function Find(
Const AName : string
):TUser;
function Delete(
Const AName : string
):boolean;
public
constructor Create();override;
destructor Destroy();override;
End;
const sDATA_FILE_NAME = 'sample.data';
procedure RegisterUserServiceImplementationFactory();
procedure SaveDataToFile(const AFileName : string);
Implementation
uses Contnrs, std_cursors, rtti_filters, imp_helper, config_objects;
var
FUserList : TObjectList = nil;
FUserCursor : IObjectCursor = nil;
procedure FillArrayFromCursor(ACursor: IObjectCursor;ARes: TUserArray);
var
i, c : Integer;
begin
ACursor.Reset();
c := 0;
while ACursor.MoveNext() do begin
Inc(c);
end;
ARes.SetLength(c);
i := 0;
ACursor.Reset();
while ACursor.MoveNext() do begin
ARes[i].Assign(ACursor.GetCurrent() as TUser);
Inc(i);
end;
end;
{ TUserService_ServiceImp implementation }
function TUserService_ServiceImp.GetList():TUserArray;
Begin
Result := TUserArray.Create();
try
FillArrayFromCursor(FUserCursor.Clone() as IObjectCursor,Result);
except
FreeAndNil(Result);
raise;
end;
SaveDataToFile(sDATA_FILE_NAME);
End;
procedure TUserService_ServiceImp.Add(Const AUser : TUser);
var
locObj : TUser;
Begin
locObj := Find(AUser.UserName);
if ( locObj <> nil ) then
raise Exception.CreateFmt('Duplicated user : "%s"',[AUser.UserName]);
locObj := TUser.Create();
locObj.Assign(AUser);
FUserList.Add(locObj);
End;
procedure TUserService_ServiceImp.Update(const AUser: TUser);
var
locCrs : IObjectCursor;
Begin
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AUser.UserName)]),TUser));
if locCrs.MoveNext() then begin
(locCrs.GetCurrent() as TUser).Assign(AUser);
end;
end;
function TUserService_ServiceImp.Find(Const AName : string):TUser;
var
locCrs : IObjectCursor;
Begin
Result := nil;
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AName)]),TUser));
if locCrs.MoveNext() then begin
Result := TUser.Create();
Result.Assign(locCrs.GetCurrent() as TUser);
end;
End;
function TUserService_ServiceImp.Delete(Const AName : string):boolean;
var
locCrs : IObjectCursor;
Begin
Result := False;
locCrs := FUserCursor.Clone() as IObjectCursor;
locCrs.Reset();
locCrs := CreateCursorOn(locCrs,ParseFilter(Format('%s=%s',['UserName',QuotedStr(AName)]),TUser));
if locCrs.MoveNext() then begin
FUserList.Delete(FUserList.IndexOf(locCrs.GetCurrent() as TUser));
Result := True;
end;
End;
procedure RegisterUserServiceImplementationFactory();
Begin
GetServiceImplementationRegistry().Register('UserService',TImplementationFactory.Create(TUserService_ServiceImp,wst_GetServiceConfigText('UserService')) as IServiceImplementationFactory);
End;
procedure FillSampleData();
var
locUser : TUser;
begin
locUser := TUser.Create();
locUser.UserName := 'Lazarus FreePascal';
locUser.eMail := 'Lazarus@FreePascal.wst';
FUserList.Add(locUser);
locUser := TUser.Create();
locUser.UserName := 'Inoussa OUEDRAOGO';
locUser.eMail := 'sample@example.wst';
FUserList.Add(locUser);
end;
procedure FillDataFromFile(const AFileName : string);
var
objArray : TUserArray;
i : PtrInt;
obj : TUser;
begin
objArray := TUserArray.Create();
try
LoadObjectFromFile(objArray,AFileName);
FUserList.Clear();
for i := 0 to Pred(objArray.Length) do begin
obj := TUser.Create();
FUserList.Add(obj);
obj.Assign(objArray[i]);
end;
finally
FreeAndNil(objArray);
end;
end;
procedure SaveDataToFile(const AFileName : string);
var
objArray : TUserArray;
begin
objArray := TUserArray.Create();
try
FUserCursor.Reset();
FillArrayFromCursor(FUserCursor,objArray);
SaveObjectToFile(objArray,AFileName);
finally
FreeAndNil(objArray);
end;
end;
constructor TUserService_ServiceImp.Create;
begin
inherited;
WriteLn('TUserService_ServiceImp.Create();');
end;
procedure TUserService_ServiceImp.Activate;
begin
inherited;
WriteLn(Format('TUserService_ServiceImp.Activate(), Self = %p',[Pointer(Self)]));
end;
function TUserService_ServiceImp.CanBePooled: Boolean;
begin
Result := True;
end;
procedure TUserService_ServiceImp.Deactivate;
begin
WriteLn(Format('TUserService_ServiceImp.Deactivate(), Self = %p',[Pointer(Self)]));
inherited;
end;
destructor TUserService_ServiceImp.Destroy;
begin
WriteLn('TUserService_ServiceImp.Destroy();');
inherited;
end;
initialization
FUserList := TObjectList.Create(True);
FUserCursor := TObjectListCursor.Create(FUserList);
{if FileExists(sDATA_FILE_NAME) then
FillDataFromFile(sDATA_FILE_NAME)
else}
FillSampleData();
finalization
if Assigned(FUserCursor) then
SaveDataToFile(sDATA_FILE_NAME);
FUserCursor := nil;
FreeAndNil(FUserList);
end.

View File

@ -0,0 +1,190 @@
{
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_proxy".
Date : "24-3-10 14:38:55".
}
Unit user_service_intf_proxy;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
Interface
Uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, user_service_intf;
Type
TUserService_Proxy=class(TBaseProxy,UserService)
Protected
class function GetServiceType() : PTypeInfo;override;
function GetList():TUserArray;
procedure Add(
const AUser : TUser
);
procedure Update(
const AUser : TUser
);
function Find(
const AName : string
):TUser;
function Delete(
const AName : string
):boolean;
End;
Function wst_CreateInstance_UserService(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'; const AAddress : string = ''):UserService;
Implementation
uses wst_resources_imp, metadata_repository;
Function wst_CreateInstance_UserService(const AFormat : string; const ATransport : string; const AAddress : string):UserService;
Var
locAdr : string;
Begin
locAdr := AAddress;
if ( locAdr = '' ) then
locAdr := GetServiceDefaultAddress(TypeInfo(UserService));
Result := TUserService_Proxy.Create('UserService',AFormat+GetServiceDefaultFormatProperties(TypeInfo(UserService)),ATransport + 'address=' + locAdr);
End;
{ TUserService_Proxy implementation }
class function TUserService_Proxy.GetServiceType() : PTypeInfo;
begin
result := TypeInfo(UserService);
end;
function TUserService_Proxy.GetList():TUserArray;
Var
locSerializer : IFormatterClient;
locCallContext : ICallContext;
locStrPrmName : string;
Begin
locCallContext := Self as ICallContext;
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('GetList', GetTarget(),locCallContext);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead(locCallContext);
TObject(Result) := Nil;
locStrPrmName := 'result';
locSerializer.Get(TypeInfo(TUserArray), locStrPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Add(
const AUser : TUser
);
Var
locSerializer : IFormatterClient;
locCallContext : ICallContext;
locStrPrmName : string;
Begin
locCallContext := Self as ICallContext;
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),locCallContext);
locSerializer.Put('AUser', TypeInfo(TUser), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead(locCallContext);
Finally
locSerializer.Clear();
End;
End;
procedure TUserService_Proxy.Update(
const AUser : TUser
);
Var
locSerializer : IFormatterClient;
locCallContext : ICallContext;
locStrPrmName : string;
Begin
locCallContext := Self as ICallContext;
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Update', GetTarget(),locCallContext);
locSerializer.Put('AUser', TypeInfo(TUser), AUser);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead(locCallContext);
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Find(
const AName : string
):TUser;
Var
locSerializer : IFormatterClient;
locCallContext : ICallContext;
locStrPrmName : string;
Begin
locCallContext := Self as ICallContext;
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Find', GetTarget(),locCallContext);
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead(locCallContext);
TObject(Result) := Nil;
locStrPrmName := 'result';
locSerializer.Get(TypeInfo(TUser), locStrPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
function TUserService_Proxy.Delete(
const AName : string
):boolean;
Var
locSerializer : IFormatterClient;
locCallContext : ICallContext;
locStrPrmName : string;
Begin
locCallContext := Self as ICallContext;
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Delete', GetTarget(),locCallContext);
locSerializer.Put('AName', TypeInfo(string), AName);
locSerializer.EndCall();
MakeCall();
locSerializer.BeginCallRead(locCallContext);
locStrPrmName := 'result';
locSerializer.Get(TypeInfo(boolean), locStrPrmName, Result);
Finally
locSerializer.Clear();
End;
End;
initialization
{$i user_service_intf.wst}
{$IF DECLARED(Register_user_service_intf_ServiceMetadata)}
Register_user_service_intf_ServiceMetadata();
{$IFEND}
End.

View File

@ -0,0 +1,7 @@
object WSTModule1: TWSTModule1
OldCreateOrder = False
Height = 300
HorizontalOffset = 635
VerticalOffset = 230
Width = 400
end

View File

@ -0,0 +1,6 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TWSTModule1','FORMDATA',[
'TPF0'#11'TWSTModule1'#10'WSTModule1'#14'OldCreateOrder'#8#6'Height'#3','#1#16
+'HorizontalOffset'#3'{'#2#14'VerticalOffset'#3#230#0#5'Width'#3#144#1#0#0
]);

View File

@ -0,0 +1,40 @@
unit wmhandler;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, HTTPDefs, websession, fpHTTP,
wstmodule;
type
TWSTModule1 = class(TWSTModule)
private
{ private declarations }
public
{ public declarations }
end;
var
WSTModule1: TWSTModule1;
implementation
uses
user_service_intf_binder,
user_service_intf_imp,
server_service_soap,
server_service_json,
server_service_xmlrpc;
initialization
{$I wmhandler.lrs}
RegisterUserServiceImplementationFactory;
Server_service_RegisterUserServiceService;
Server_service_RegisterSoapFormat;
Server_service_RegisterJSONFormat;
Server_service_RegisterXMLRPCFormat;
RegisterHTTPModule('WST', TWSTModule1);
end.

View File

@ -0,0 +1,51 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Name Value="fclwebwst"/>
<AddToProjectUsesSection Value="False"/>
<CompilerOptions>
<Version Value="8"/>
<SearchPaths>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Files Count="2">
<Item1>
<Filename Value="wstmodule.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="wstmodule"/>
</Item1>
<Item2>
<Filename Value="regwstmodule.pp"/>
<HasRegisterProc Value="True"/>
<UnitName Value="regwstmodule"/>
</Item2>
</Files>
<Type Value="DesignTime"/>
<RequiredPkgs Count="4">
<Item1>
<PackageName Value="IDEIntf"/>
</Item1>
<Item2>
<PackageName Value="weblaz"/>
</Item2>
<Item3>
<PackageName Value="wst_core"/>
</Item3>
<Item4>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item4>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

View File

@ -0,0 +1,21 @@
{ This file was automatically created by Lazarus. do not edit!
This source is only used to compile and install the package.
}
unit fclwebwst;
interface
uses
regwstmodule, LazarusPackageIntf;
implementation
procedure Register;
begin
RegisterUnit('regwstmodule', @regwstmodule.Register);
end;
initialization
RegisterPackage('fclwebwst', @Register);
end.

View File

@ -0,0 +1,76 @@
unit regwstmodule;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LazIDEIntf, ProjectIntf, FormEditingIntf, wstmodule;
Type
{ TFileDescWSTModule }
TFileDescWSTModule = class(TFileDescPascalUnitWithResource)
public
constructor Create; override;
function GetInterfaceUsesSection: string; override;
function GetLocalizedName: string; override;
function GetLocalizedDescription: string; override;
function GetImplementationSource(const Filename, SourceName, ResourceName: string): string;override;
end;
Procedure Register;
implementation
Var
FileDescriptorWSTModule: TFileDescWSTModule;
Procedure Register;
begin
FileDescriptorWSTModule:=TFileDescWSTModule.Create;
RegisterProjectFileDescriptor(FileDescriptorWSTModule);
FormEditingHook.RegisterDesignerBaseClass(TWSTModule);
end;
{ TFileDescWSTModule }
constructor TFileDescWSTModule.Create;
begin
inherited Create;
Name:='WST Request processing Module';
ResourceClass:=TWSTModule;
UseCreateFormStatements:=False;
end;
function TFileDescWSTModule.GetInterfaceUsesSection: string;
begin
Result:=inherited GetInterfaceUsesSection;
Result:=Result+', HTTPDefs, websession, fpHTTP, wstmodule';
end;
function TFileDescWSTModule.GetLocalizedName: string;
begin
Result:='WST Request processing Module';
end;
function TFileDescWSTModule.GetLocalizedDescription: string;
begin
Result:='WST Request processing Module'#13#10+
'Module to process WST (Web Services Toolkit) requests and return the result';
end;
function TFileDescWSTModule.GetImplementationSource(const Filename, SourceName,
ResourceName: string): string;
begin
Result:=inherited GetImplementationSource(Filename, SourceName, ResourceName);
Result:=Result+' RegisterHTTPModule(''T'+ResourceName+''',T'+ResourceName+');'+LineEnding;
end;
initialization
finalization
FreeAndNil(FileDescriptorWSTModule)
end.

View File

@ -0,0 +1,299 @@
unit wstmodule;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, httpdefs, fphttp, server_service_imputils, websession;
const
sWSDL = 'WSDL';
Type
{ TCustomWSTModule }
TWSTServiceEvent = procedure(Sender : TObject; Const AServiceName : String) of object;
TServiceRequestEvent = procedure(Sender : TObject; Const AServiceName : String; Var Handled : Boolean)of object;
TSessionPropertiesEvent = Procedure(Sender : TObject; const Props : TStrings) of object;
TCustomWSTModule = Class(TSessionHTTPModule)
private
FAfterGenerateWSDL: TWSTServiceEvent;
FAfterGenerateWSDLTable: TNotifyEvent;
FAfterService: TWSTServiceEvent;
FBeforeGenerateWSDL: TWSTServiceEvent;
FBeforeGenerateWSDLTable: TNotifyEvent;
FBeforeService: TServiceRequestEvent;
FOnSetSessionProperties: TSessionPropertiesEvent;
FRequest: TRequest;
FResponse: TResponse;
function GenerateWSDLTable(Const ABaseURL : String): string;
procedure ProcessServiceRequest(ARequest: TRequest; AResponse: TResponse; AFormat : String);
procedure ProcessWSDLRequest(ARequest: TRequest; AResponse: TResponse);
Protected
procedure AddSessionProperties(ARequest: TRequest; WSTRequest: TRequestBuffer); virtual;
property BeforeGenerateWSDLTable : TNotifyEvent Read FBeforeGenerateWSDLTable Write FBeforeGenerateWSDLTable;
property AfterGenerateWSDLTable : TNotifyEvent Read FAfterGenerateWSDLTable Write FAfterGenerateWSDLTable;
property BeforeGenerateWSDL : TWSTServiceEvent Read FBeforeGenerateWSDL Write FBeforeGenerateWSDL;
property AfterGenerateWSDL : TWSTServiceEvent Read FAfterGenerateWSDL Write FAfterGenerateWSDL;
Property BeforeServiceRequest : TServiceRequestEvent Read FBeforeService Write FBeforeService;
Property AfterServiceRequest : TWSTServiceEvent Read FAfterService Write FAfterService;
Property OnSetSessionProperties : TSessionPropertiesEvent Read FOnSetSessionProperties Write FOnSetSessionProperties;
// Access to request
Property Request: TRequest Read FRequest;
// Access to response
Property Response: TResponse Read FResponse;
Public
Constructor CreateNew(AOwner : TComponent; CreateMode : Integer); override;
Procedure HandleRequest(ARequest : TRequest; AResponse : TResponse); override;
end;
TWSTModule = Class(TCustomWSTModule)
Public
Property Request;
Property Response;
Published
property BeforeGenerateWSDLTable;
property AfterGenerateWSDLTable;
property BeforeGenerateWSDL;
property AfterGenerateWSDL;
Property BeforeServiceRequest;
Property AfterServiceRequest;
end;
implementation
{ $define wmdebug}
uses {$ifdef wmdebug}dbugintf,{$endif}base_service_intf,
server_service_intf,
metadata_repository, metadata_wsdl, dom,xmlwrite,
metadata_service, metadata_service_binder;
function GetWSDL(const ARepName, ARootAddress: shortstring):string;
var
M : TStringStream;
rep : PServiceRepository;
doc :TXMLDocument;
i : SizeInt;
s : string;
begin
Result := '';
rep := nil;
doc := Nil;
i := GetModuleMetadataMngr().IndexOfName(ARepName);
if ( i < 0 ) then
Exit;
s := GetModuleMetadataMngr().GetRepositoryName(i);
GetModuleMetadataMngr().LoadRepositoryName(s,ARootAddress,rep);
doc := TXMLDocument.Create();
try
GenerateWSDL(rep,doc);
M := TStringStream.Create('');
try
WriteXMLFile(doc,M);
Result:=M.DataString;
finally
M.Free();
GetModuleMetadataMngr().ClearRepository(rep);
end;
finally
Doc.free;
end;
end;
Const
STableStart='<html><head><title>%s</title></head><body>' +
'<p BGCOLOR="#DDEEFF"><FONT FACE="Arial" COLOR="#0000A0" SIZE="+2">%s</FONT></p>'+
'<table width="100%%">';
STableRow = '<tr><td><a href="%s%s">%s</a></td></tr>';
STableEnd = '</tr></table></body></html>';
Resourcestring
SWSDLTablePageTitle = 'Available services';
SWSDLTableIntro = 'The following services are available. Click on the link to view the corresponding WSDL.';
function TCustomWSTModule.GenerateWSDLTable(Const ABaseURL : String): string;
var
r : IModuleMetadataMngr;
i : Integer;
N : String;
begin
If Assigned(FBeforeGenerateWSDLTable) then
FBeforeGenerateWSDLTable(Self);
r := GetModuleMetadataMngr();
Result := Format(STableStart,[SWSDLTablePageTitle,SWSDLTableIntro]);
for i := 0 to R.GetCount-1 do
begin
N:=r.GetRepositoryName(i);
Result:=Result+Format(STableRow,[ABaseURL,N,N]);
end;
Result:=Result+STableEnd;
If Assigned(FAfterGenerateWSDLTable) then
FAfterGenerateWSDLTable(Self);
end;
procedure TCustomWSTModule.ProcessWSDLRequest(ARequest : TRequest; AResponse : TResponse);
var
ServiceName,Buf : string;
begin
{$ifdef wmdebug}SendDebug('Entering ProcessWSDLRequest');{$endif}
{$ifdef wmdebug}SendDebug(Format('ProcessWSDLSRequest: BaseURL = "%s"',[BaseURL]));{$endif}
ServiceName:=ARequest.GetNextPathInfo;
{$ifdef wmdebug}SendDebug(Format('ProcessWSDLSRequest: Servicename = "%s"',[ServiceName]));{$endif}
If (ServiceName<>'') then
begin
If Assigned(FBeforeGenerateWSDL) then
FBeforeGenerateWSDL(Self,ServiceName);
Buf:=GetWSDL(ServiceName,ARequest.URI);
If Assigned(FAfterGenerateWSDL) then
FAfterGenerateWSDL(Self,ServiceName);
end;
if (Length(Buf)>0) then
begin
AResponse.ContentType:='text/xml';
AResponse.Content:= Buf;
end
else
begin
AResponse.Content := GenerateWSDLTable(BaseURL+'WSDL/');
AResponse.ContentType := 'text/html';
end;
{$ifdef wmdebug}SendDebug('Exiting ProcessWSDLRequest');{$endif}
end;
Procedure TCustomWSTModule.AddSessionProperties(ARequest : TRequest; WSTRequest : TRequestBuffer);
Var
P : IPropertyManager;
L : TStringList;
I : Integer;
N,V : String;
begin
P:=(WSTRequest As IRequestBuffer).GetPropertyManager();
If CreateSession and Assigned(Session) then
P.SetProperty('SessionID',Self.Session.SessionID);
P.SetProperty(SRemote_IP,ARequest.RemoteAddress);
P.SetProperty('RemoteHost',ARequest.RemoteHost);
If Assigned(FOnSetSessionProperties) then
begin
L:=TStringList.Create;
try
FOnSetSessionProperties(Self,L);
For I:=0 to L.Count-1 do
begin
L.GetNameValue(I,N,V);
P.SetProperty(N,V);
end;
finally
L.Free;
end;
end;
end;
Procedure TCustomWSTModule.ProcessServiceRequest(ARequest : TRequest; AResponse : TResponse; AFormat : String);
var
ServiceName,ContentType : string;
rqst : TRequestBuffer;
inStream, outStream: TStringStream;
B : Boolean;
F : TFileStream;
begin
{$ifdef wmdebug}SendDebug('Entering ProcessServiceRequest');{$endif}
ServiceName:=ARequest.GetNextPathInfo;
// TServiceRequestEvent = procedure(Sender : TObject; Const AServiceName : String; Var Handled : Boolean);
{$ifdef wmdebug}SendDebug(Format('ProcessServiceRequest: Servicename = "%s"',[ServiceName]));{$endif}
B:=False;
If Assigned(FBeforeService) then
FBeforeService(Self,ServiceName,B);
If Not B then
begin
inStream := TStringStream.Create(ARequest.Content);
try
F:=TFileStream.Create('/tmp/request',fmCreate);
try
F.CopyFrom(InStream,0);
Instream.Position:=0;
finally
F.Free;
end;
outStream := TStringStream.Create('');
try
ContentType:= ARequest.ContentType;
Response.ContentType := ContentType;
rqst := TRequestBuffer.Create(ServiceName,ContentType,inStream,outStream,AFormat);
AddSessionProperties(ARequest,Rqst);
{$ifdef wmdebug}SendDebug('Handling request');{$endif}
HandleServiceRequest(rqst);
{$ifdef wmdebug}SendDebug('Handled request');{$endif}
AResponse.Content:=OutStream.DataString;
finally
OutStream.Free;
end;
finally
InStream.Free();
end;
end;
If Assigned(FAfterService) then
FAfterService(Self,ServiceName);
{$ifdef wmdebug}SendDebug('Exiting ProcessServiceRequest');{$endif}
end;
{ TCustomWSTModule }
constructor TCustomWSTModule.CreateNew(AOwner: TComponent; CreateMode: Integer
);
begin
inherited CreateNew(AOwner, CreateMode);
end;
procedure TCustomWSTModule.HandleRequest(ARequest: TRequest;
AResponse: TResponse);
Var
AFormat : String;
F : TFileStream;
begin
{$ifdef wmdebug}SendDebug('Entering HandleRequest');{$endif}
try
FRequest:=ARequest;
FResponse:=AResponse;
try
AFormat:=Request.GetNextPathInfo;
{$ifdef wmdebug}SendDebug(Format('HandleRequest: Format = "%s"',[AFormat]));{$endif}
If SameText(AFormat,SWSDL) or (AFormat='') then
ProcessWSDLRequest(ARequest,AResponse)
else
ProcessServiceRequest(ARequest,AResponse,AFormat);
finally
FRequest:=Nil;
FResponse:=Nil;
end;
except
On E : Exception do
begin
{$ifdef wmdebug}SendDebug('Error during HandleRequest : '+E.Message);{$endif}
With TFileStream.Create('/tmp/request-error',fmCreate) do
try
WriteBuffer(E.Message[1],Length(E.Message));
finally
Free;
end;
Raise;
end;
end;
{$ifdef wmdebug}SendDebug('Exiting HandleRequest');{$endif}
end;
end.