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:
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