You've already forked lazarus-ccr
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
54
wst/trunk/ide/lazarus/wstmodule/README.txt
Normal file
54
wst/trunk/ide/lazarus/wstmodule/README.txt
Normal 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.
|
||||||
BIN
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.ico
Normal file
BIN
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 134 KiB |
542
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.lpi
Normal file
542
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.lpi
Normal 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>
|
||||||
16
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.lpr
Normal file
16
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.lpr
Normal 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.
|
||||||
|
|
||||||
1
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.rc
Normal file
1
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.rc
Normal file
@ -0,0 +1 @@
|
|||||||
|
MAINICON ICON "demoservice.ico"
|
||||||
BIN
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.res
Normal file
BIN
wst/trunk/ide/lazarus/wstmodule/demo/demoservice.res
Normal file
Binary file not shown.
77
wst/trunk/ide/lazarus/wstmodule/demo/imp_helper.pas
Normal file
77
wst/trunk/ide/lazarus/wstmodule/demo/imp_helper.pas
Normal 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.
|
||||||
|
|
||||||
132
wst/trunk/ide/lazarus/wstmodule/demo/std_cursors.pas
Normal file
132
wst/trunk/ide/lazarus/wstmodule/demo/std_cursors.pas
Normal 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.
|
||||||
|
|
||||||
293
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf.pas
Normal file
293
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf.pas
Normal 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.
|
||||||
@ -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''
|
||||||
|
);
|
||||||
75
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_.pas
Normal file
75
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_.pas
Normal 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.
|
||||||
@ -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.
|
||||||
234
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_imp.pas
Normal file
234
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_imp.pas
Normal 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.
|
||||||
190
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_proxy.pas
Normal file
190
wst/trunk/ide/lazarus/wstmodule/demo/user_service_intf_proxy.pas
Normal 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.
|
||||||
7
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.lfm
Normal file
7
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.lfm
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
object WSTModule1: TWSTModule1
|
||||||
|
OldCreateOrder = False
|
||||||
|
Height = 300
|
||||||
|
HorizontalOffset = 635
|
||||||
|
VerticalOffset = 230
|
||||||
|
Width = 400
|
||||||
|
end
|
||||||
6
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.lrs
Normal file
6
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.lrs
Normal 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
|
||||||
|
]);
|
||||||
40
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.pp
Normal file
40
wst/trunk/ide/lazarus/wstmodule/demo/wmhandler.pp
Normal 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.
|
||||||
|
|
||||||
51
wst/trunk/ide/lazarus/wstmodule/fclwebwst.lpk
Normal file
51
wst/trunk/ide/lazarus/wstmodule/fclwebwst.lpk
Normal 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>
|
||||||
21
wst/trunk/ide/lazarus/wstmodule/fclwebwst.pas
Normal file
21
wst/trunk/ide/lazarus/wstmodule/fclwebwst.pas
Normal 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.
|
||||||
76
wst/trunk/ide/lazarus/wstmodule/regwstmodule.pp
Normal file
76
wst/trunk/ide/lazarus/wstmodule/regwstmodule.pp
Normal 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.
|
||||||
|
|
||||||
299
wst/trunk/ide/lazarus/wstmodule/wstmodule.pas
Normal file
299
wst/trunk/ide/lazarus/wstmodule/wstmodule.pas
Normal 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.
|
||||||
Reference in New Issue
Block a user