pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

+ XmlRpc format support ( server and client )

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@198 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2007-06-28 23:33:38 +00:00
parent a378b15cb3
commit 6ca7b4a51d
28 changed files with 1789 additions and 572 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
wst/trunk/base_service_intf.pas
View File

@ -101,7 +101,8 @@ type
['{E4D69D2A-F0A5-43E1-8C56-B47E7AB5D1AF}']
function Find(const AFormatterName : string):IFormatterBase;
procedure Register(
const AFormatterName : string;
const AFormatterName,
AContentType : string;
AFactory : IItemFactory
);
End;
@ -2043,8 +2044,8 @@ end;
constructor TBaseFactoryRegistry.Create();
begin
FList := TObjectList.Create(True);
inherited Create();
FList := TObjectList.Create(True);
end;
destructor TBaseFactoryRegistry.Destroy();

2
wst/trunk/base_soap_formatter.pas
View File

@ -24,7 +24,7 @@ uses
DOM,
base_service_intf;
Const
const
sPROTOCOL_NAME = 'SOAP';
sXML_NS = 'xmlns';

42
wst/trunk/base_xmlrpc_formatter.pas
View File

@ -12,10 +12,8 @@
}
unit base_xmlrpc_formatter;
{$mode objfpc}{$H+}
{$IF (FPC_VERSION = 2) and (FPC_RELEASE > 0)}
{$define FPC_211}
{$ENDIF}
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
interface
@ -31,6 +29,19 @@ const
sCONTENT_TYPE = 'contenttype';
sXMLRPC_CONTENT_TYPE = 'text/xml';
sDATA = 'data';
sFAULT = 'fault';
sFAULT_CODE = 'faultCode';
sFAULT_STRING = 'faultString';
sMEMBER = 'member';
sMETHOD_CALL = 'methodCall';
sMETHOD_NAME = 'methodName';
sMETHOD_RESPONSE = 'methodResponse';
sNAME = 'name';
sPARAM = 'param';
sPARAMS = 'params';
sVALUE = 'value';
type
TEnumIntType = Int64;
@ -218,6 +229,7 @@ type
const AStyle : TArrayStyle;
const AItemName : string
):TStackItem;overload;
function PushStackParams(AScopeObject : TDOMNode) : TStackItem;
function FindAttributeByValueInNode(
Const AAttValue : String;
Const ANode : TDOMNode;
@ -318,16 +330,9 @@ type
{$M-}
implementation
Uses XMLWrite, XMLRead, StrUtils,
Uses XMLWrite, XMLRead,
imp_utils;
const
sDATA = 'data';
sMEMBER = 'member';
sNAME = 'name';
sPARAM = 'param';
sVALUE = 'value';
function GetNodeItemsCount(const ANode : TDOMNode): Integer;
var
chdLst : TDOMNodeList;
@ -457,8 +462,8 @@ begin
if ( FIndex >= FItemList.Count ) then
raise EXmlRpcException.CreateFmt('Index out of bound : %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
Result:= FItemList.Item[FIndex];
if Result.HasChildNodes() then begin
Result := Result.FirstChild;
if Result.HasChildNodes() and Result.FirstChild.HasChildNodes() then begin
Result := Result.FirstChild;//.FirstChild;
Inc(FIndex);
ANodeName := Result.NodeName;
end else begin
@ -509,6 +514,11 @@ begin
Result := FStack.Push(TArrayStackItem.Create(AScopeObject,stArray)) as TStackItem;
end;
function TXmlRpcBaseFormatter.PushStackParams(AScopeObject: TDOMNode): TStackItem;
begin
Result := FStack.Push(TParamsArrayStackItem.Create(AScopeObject,stArray)) as TStackItem;
end;
function TXmlRpcBaseFormatter.BeginObjectRead(
var AScopeName : string;
const ATypeInfo : PTypeInfo
@ -1355,8 +1365,8 @@ begin
if ( FIndex >= FItemList.Count ) then
raise EXmlRpcException.CreateFmt('Index out of bound : %d; Node Name = "%s"; Parent Node = "%s"',[FIndex,ANodeName,ScopeObject.NodeName]);
Result:= FItemList.Item[FIndex];
if Result.HasChildNodes() then begin
Result := Result.FirstChild;
if Result.HasChildNodes() and Result.FirstChild.HasChildNodes() then begin
Result := Result.FirstChild.FirstChild;
Inc(FIndex);
ANodeName := Result.NodeName;
end else begin

1
wst/trunk/binary_formatter.pas
View File

@ -20,6 +20,7 @@ uses
base_binary_formatter;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
Const
sCONTENT_TYPE = 'contenttype';

2
wst/trunk/library_server_intf.pas
View File

@ -89,7 +89,7 @@ begin
inStream.Write(buff[1],Length(buff));
SetLength(buff,0);
inStream.Position := 0;
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream);
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream,'');
HandleServiceRequest(rqst);
bs := bufStream.Size;
wstCheck(ARequestBuffer.SetSize(bs));

145
wst/trunk/samples/apache_module/mod_wst.lpi
View File

@ -24,24 +24,24 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="7">
<Units Count="14">
<Unit0>
<Filename Value="mod_wst.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mod_wst"/>
<CursorPos X="1" Y="52"/>
<TopLine Value="25"/>
<CursorPos X="3" Y="11"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="33"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="wst_apache_binding.pas"/>
<UnitName Value="wst_apache_binding"/>
<CursorPos X="46" Y="15"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="16"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="249"/>
<EditorIndex Value="4"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
@ -49,8 +49,8 @@
<UnitName Value="metadata_wsdl"/>
<CursorPos X="70" Y="30"/>
<TopLine Value="16"/>
<EditorIndex Value="2"/>
<UsageCount Value="16"/>
<EditorIndex Value="8"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -58,8 +58,8 @@
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="71" Y="20"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="16"/>
<EditorIndex Value="9"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -82,68 +82,67 @@
<TopLine Value="61"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\http_protocol.inc"/>
<CursorPos X="47" Y="799"/>
<TopLine Value="777"/>
<EditorIndex Value="7"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\httpd.inc"/>
<CursorPos X="5" Y="794"/>
<TopLine Value="777"/>
<EditorIndex Value="6"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.0\apr\apr_tables.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="16"/>
<EditorIndex Value="5"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit9>
<Unit10>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\http_config.inc"/>
<CursorPos X="71" Y="66"/>
<TopLine Value="32"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\httpd.pas"/>
<UnitName Value="httpd"/>
<CursorPos X="41" Y="134"/>
<TopLine Value="117"/>
<EditorIndex Value="2"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\ap_mmn.inc"/>
<CursorPos X="3" Y="111"/>
<TopLine Value="96"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\packages\base\httpd\httpd-2.0\apr\apr_pools.inc"/>
<CursorPos X="3" Y="48"/>
<TopLine Value="678"/>
<UsageCount Value="10"/>
</Unit13>
</Units>
<JumpHistory Count="15" HistoryIndex="14">
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="mod_wst.lpr"/>
<Caret Line="5" Column="1" TopLine="1"/>
<Caret Line="39" Column="14" TopLine="23"/>
</Position1>
<Position2>
<Filename Value="mod_wst.lpr"/>
<Caret Line="52" Column="5" TopLine="25"/>
</Position2>
<Position3>
<Filename Value="mod_wst.lpr"/>
<Caret Line="18" Column="28" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="wst_apache_binding.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="..\..\metadata_wsdl.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position5>
<Position6>
<Filename Value="..\..\metadata_wsdl.pas"/>
<Caret Line="30" Column="70" TopLine="16"/>
</Position6>
<Position7>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position7>
<Position8>
<Filename Value="wst_apache_binding.pas"/>
<Caret Line="29" Column="68" TopLine="10"/>
</Position8>
<Position9>
<Filename Value="wst_apache_binding.pas"/>
<Caret Line="312" Column="42" TopLine="291"/>
</Position9>
<Position10>
<Filename Value="mod_wst.lpr"/>
<Caret Line="6" Column="22" TopLine="25"/>
</Position10>
<Position11>
<Filename Value="mod_wst.lpr"/>
<Caret Line="52" Column="1" TopLine="25"/>
</Position11>
<Position12>
<Filename Value="mod_wst.lpr"/>
<Caret Line="30" Column="6" TopLine="25"/>
</Position12>
<Position13>
<Filename Value="mod_wst.lpr"/>
<Caret Line="11" Column="7" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="wst_apache_binding.pas"/>
<Caret Line="273" Column="27" TopLine="260"/>
</Position14>
<Position15>
<Filename Value="mod_wst.lpr"/>
<Caret Line="7" Column="1" TopLine="1"/>
</Position15>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -153,13 +152,17 @@
<Filename Value="mod_wst.so"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="$(FPCSrcDir)\packages\base\httpd\httpd-2.2\;..\;..\..\;..\..\wst_rtti_filter\"/>
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apr\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apriconv\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\aprutil\"/>
<UnitOutputDirectory Value="obj"/>
<SrcPath Value="$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apr\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\apriconv\;$(LazarusDir)\fpc\2.1.3\source\packages\base\httpd\httpd-2.2\aprutil\"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>

12
wst/trunk/samples/apache_module/wst_apache_binding.pas
View File

@ -1,4 +1,4 @@
//{$DEFINE WST_DBG}
{$DEFINE WST_DBG}
unit wst_apache_binding;
@ -35,6 +35,7 @@ type
URI : string;
ContentType : string;
Buffer : string;
Argument : string;
end;
TResponseInfo = record
@ -232,7 +233,7 @@ begin
AResponseInfo.ContentType := sHTTP_BINARY_CONTENT_TYPE
else
AResponseInfo.ContentType := ctntyp;
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,outStream);
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,outStream,'');
HandleServiceRequest(rqst);
i := outStream.Size;
if ( i > 0 ) then begin
@ -243,8 +244,8 @@ begin
outStream.Free();
inStream.Free();
{$IFDEF WST_DBG}
{SaveStringToFile('RequestInfo.ContentType=' + ARequestInfo.ContentType + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',False);
SaveStringToFile('RequestInfo.Buffer=' + ARequestInfo.Buffer + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True);
SaveStringToFile('RequestInfo.ContentType=' + ARequestInfo.Argument + LineEnding,'c:\log.log',False);
{SaveStringToFile('RequestInfo.Buffer=' + ARequestInfo.Buffer + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True);
SaveStringToFile('RequestInfo.URI=' + ARequestInfo.URI + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True);
SaveStringToFile('ResponseInfo.ContentType=' + AResponseInfo.ContentType + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True);
SaveStringToFile('ResponseInfo.ContentText=' + AResponseInfo.ContentText + LineEnding,'E:\Inoussa\Sources\lazarus\wst\v0.3\tests\apache_module\log.log',True);
@ -260,6 +261,7 @@ function wst_RequestHandler(r: Prequest_rec): Integer;
ARequestInfo.ContentType := apr_table_get(r^.headers_in,sCONTENT_TYPE);
ARequestInfo.Root := ap_get_server_name(r) + sSEPARATOR + sWST_ROOT + sSEPARATOR;
ARequestInfo.URI := r^.uri;
ARequestInfo.Argument := r^.args;
Result := ReadBuffer(r,ARequestInfo.Buffer);
end;
@ -312,7 +314,7 @@ initialization
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
end.

18
wst/trunk/samples/http_server/app_object.pas
View File

@ -61,7 +61,7 @@ type
implementation
uses base_service_intf,
server_service_intf, server_service_imputils,
server_service_soap, server_binary_formatter,
server_service_soap, server_binary_formatter, server_service_xmlrpc,
metadata_repository, metadata_wsdl, DOM, XMLWrite,
metadata_service, metadata_service_binder, metadata_service_imp,
@ -195,7 +195,7 @@ procedure TwstWebApplication.ProcessServiceRequest(
var APath : string
);
var
trgt,ctntyp : string;
trgt,ctntyp, frmt : string;
rqst : IRequestBuffer;
inStream: TMemoryStream;
begin
@ -214,7 +214,8 @@ begin
inStream.CopyFrom(ARequestInfo.PostStream,0);
inStream.Position := 0;
AResponseInfo.ContentType := ctntyp;
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,AResponseInfo.ContentStream);
frmt := Trim(ARequestInfo.Params.Values['format']);
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,AResponseInfo.ContentStream,frmt);
HandleServiceRequest(rqst);
finally
inStream.Free();
@ -276,9 +277,6 @@ begin
FHTTPServerObject.ServerSoftware := 'Web Service Toolkit Sample WebServer';
FHTTPServerObject.Active := True;
FHTTPServerObject.OnCommandGet := @Handler_CommandGet;
Server_service_RegisterUserServiceService();
RegisterUserServiceImplementationFactory();
end;
destructor TwstWebApplication.Destroy();
@ -296,14 +294,14 @@ initialization
RegisterStdTypes();
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
Server_service_RegisterUserServiceService();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
Register_user_service_intf_ServiceMetadata();
Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterWSTMetadataServiceService();
end.

279
wst/trunk/samples/http_server/http_server.lpi
View File

@ -12,7 +12,7 @@
<MainUnit Value="0"/>
<IconPath Value="./"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
<ActiveEditorIndexAtStart Value="5"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
@ -34,40 +34,42 @@
<PackageName Value="indylaz"/>
</Item1>
</RequiredPackages>
<Units Count="9">
<Units Count="21">
<Unit0>
<Filename Value="http_server.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="http_server"/>
<CursorPos X="12" Y="13"/>
<CursorPos X="19" Y="14"/>
<TopLine Value="1"/>
<EditorIndex Value="0"/>
<UsageCount Value="22"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="app_object.pas"/>
<UnitName Value="app_object"/>
<CursorPos X="34" Y="65"/>
<TopLine Value="51"/>
<CursorPos X="17" Y="217"/>
<TopLine Value="196"/>
<EditorIndex Value="1"/>
<UsageCount Value="11"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="4149"/>
<TopLine Value="4122"/>
<UsageCount Value="10"/>
<CursorPos X="64" Y="102"/>
<TopLine Value="85"/>
<EditorIndex Value="11"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="..\..\metadata_wsdl.pas"/>
<UnitName Value="metadata_wsdl"/>
<CursorPos X="56" Y="308"/>
<TopLine Value="296"/>
<EditorIndex Value="2"/>
<UsageCount Value="11"/>
<EditorIndex Value="12"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
@ -75,56 +77,260 @@
<UnitName Value="metadata_service_imp"/>
<CursorPos X="73" Y="68"/>
<TopLine Value="54"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit4>
<Unit5>
<Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="53" Y="39"/>
<TopLine Value="34"/>
<UsageCount Value="10"/>
<CursorPos X="1" Y="178"/>
<TopLine Value="160"/>
<EditorIndex Value="9"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="69" Y="11"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit6>
<Unit7>
<Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="59" Y="65"/>
<TopLine Value="46"/>
<UsageCount Value="10"/>
<CursorPos X="3" Y="87"/>
<TopLine Value="158"/>
<EditorIndex Value="4"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="5" Y="45"/>
<TopLine Value="99"/>
<EditorIndex Value="3"/>
<UsageCount Value="11"/>
<EditorIndex Value="13"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="35" Y="85"/>
<TopLine Value="24"/>
<UsageCount Value="10"/>
</Unit9>
<Unit10>
<Filename Value="..\..\server_service_intf.pas"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="14" Y="268"/>
<TopLine Value="267"/>
<EditorIndex Value="8"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit10>
<Unit11>
<Filename Value="..\..\server_service_soap.pas"/>
<UnitName Value="server_service_soap"/>
<CursorPos X="44" Y="196"/>
<TopLine Value="79"/>
<EditorIndex Value="5"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="17" Y="28"/>
<TopLine Value="13"/>
<EditorIndex Value="7"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="..\..\server_service_imputils.pas"/>
<UnitName Value="server_service_imputils"/>
<CursorPos X="25" Y="94"/>
<TopLine Value="68"/>
<EditorIndex Value="10"/>
<UsageCount Value="13"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\indy\indy-10.2.0.1\fpc\Protocols\IdCustomHTTPServer.pas"/>
<UnitName Value="IdCustomHTTPServer"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit14>
<Unit15>
<Filename Value="..\..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\i386\i386.inc"/>
<CursorPos X="49" Y="1252"/>
<TopLine Value="1231"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="9"/>
</Unit16>
<Unit17>
<Filename Value="..\..\xmlrpc_formatter.pas"/>
<UnitName Value="xmlrpc_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="28"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<UnitName Value="server_service_xmlrpc"/>
<CursorPos X="53" Y="177"/>
<TopLine Value="152"/>
<EditorIndex Value="2"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="..\..\server_binary_formatter.pas"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="50" Y="133"/>
<TopLine Value="109"/>
<EditorIndex Value="6"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit19>
<Unit20>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="3" Y="30"/>
<TopLine Value="15"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit20>
</Units>
<JumpHistory Count="4" HistoryIndex="3">
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="http_server.pas"/>
<Caret Line="10" Column="10" TopLine="1"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="2020" Column="1" TopLine="2004"/>
</Position1>
<Position2>
<Filename Value="app_object.pas"/>
<Caret Line="65" Column="34" TopLine="51"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="..\..\metadata_wsdl.pas"/>
<Caret Line="324" Column="51" TopLine="296"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1188" Column="13" TopLine="1173"/>
</Position3>
<Position4>
<Filename Value="http_server.pas"/>
<Caret Line="10" Column="10" TopLine="1"/>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1272" Column="15" TopLine="1243"/>
</Position4>
<Position5>
<Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="1424" Column="44" TopLine="1408"/>
</Position5>
<Position6>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="351" Column="33" TopLine="330"/>
</Position6>
<Position7>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="266" Column="15" TopLine="251"/>
</Position7>
<Position8>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="359" Column="1" TopLine="336"/>
</Position8>
<Position9>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position9>
<Position10>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="351" Column="1" TopLine="336"/>
</Position10>
<Position11>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="371" Column="63" TopLine="348"/>
</Position11>
<Position12>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="253" Column="70" TopLine="244"/>
</Position12>
<Position13>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="260" Column="18" TopLine="244"/>
</Position13>
<Position14>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="314" Column="16" TopLine="306"/>
</Position14>
<Position15>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="306" Column="29" TopLine="291"/>
</Position15>
<Position16>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="260" Column="56" TopLine="260"/>
</Position16>
<Position17>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="306" Column="41" TopLine="306"/>
</Position17>
<Position18>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="260" Column="25" TopLine="260"/>
</Position18>
<Position19>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="306" Column="46" TopLine="306"/>
</Position19>
<Position20>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="310" Column="27" TopLine="295"/>
</Position20>
<Position21>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="365" Column="10" TopLine="356"/>
</Position21>
<Position22>
<Filename Value="..\..\server_service_intf.pas"/>
<Caret Line="364" Column="30" TopLine="349"/>
</Position22>
<Position23>
<Filename Value="..\..\server_service_soap.pas"/>
<Caret Line="21" Column="18" TopLine="31"/>
</Position23>
<Position24>
<Filename Value="..\..\server_service_soap.pas"/>
<Caret Line="196" Column="38" TopLine="171"/>
</Position24>
<Position25>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position25>
<Position26>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Caret Line="132" Column="37" TopLine="108"/>
</Position26>
<Position27>
<Filename Value="..\..\server_service_soap.pas"/>
<Caret Line="196" Column="44" TopLine="171"/>
</Position27>
<Position28>
<Filename Value="..\..\server_binary_formatter.pas"/>
<Caret Line="26" Column="41" TopLine="15"/>
</Position28>
<Position29>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<Caret Line="51" Column="55" TopLine="40"/>
</Position29>
<Position30>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<Caret Line="177" Column="37" TopLine="152"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
@ -137,6 +343,11 @@
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
@ -145,7 +356,7 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="5">
<BreakPoints Count="4">
<Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
@ -162,10 +373,6 @@
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
<Item5>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="176"/>
</Item5>
</BreakPoints>
<Watches Count="2">
<Item1>

73
wst/trunk/samples/library_server/lib_server.lpi
View File

@ -1,19 +1,20 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<IconPath Value=".\"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="4"/>
<ActiveEditorIndexAtStart Value="2"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -21,49 +22,49 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="6">
<Units Count="7">
<Unit0>
<Filename Value="lib_server.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="lib_server"/>
<CursorPos X="45" Y="35"/>
<TopLine Value="14"/>
<CursorPos X="17" Y="32"/>
<TopLine Value="17"/>
<EditorIndex Value="0"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../../library_server_intf.pas"/>
<Filename Value="..\..\library_server_intf.pas"/>
<UnitName Value="library_server_intf"/>
<CursorPos X="51" Y="27"/>
<TopLine Value="14"/>
<CursorPos X="74" Y="92"/>
<TopLine Value="78"/>
<EditorIndex Value="2"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../user_service_intf_imp.pas"/>
<Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="43" Y="179"/>
<TopLine Value="157"/>
<EditorIndex Value="3"/>
<EditorIndex Value="4"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../wst_rtti_filter/rtti_filters.pas"/>
<Filename Value="..\..\wst_rtti_filter\rtti_filters.pas"/>
<UnitName Value="rtti_filters"/>
<CursorPos X="53" Y="43"/>
<TopLine Value="184"/>
<EditorIndex Value="5"/>
<EditorIndex Value="6"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../user_service_intf_binder.pas"/>
<Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="54" Y="32"/>
<TopLine Value="22"/>
@ -72,29 +73,51 @@
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../base_service_intf.pas"/>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="52" Y="4125"/>
<TopLine Value="4118"/>
<EditorIndex Value="4"/>
<EditorIndex Value="5"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="96"/>
<TopLine Value="72"/>
<EditorIndex Value="3"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit6>
</Units>
<JumpHistory Count="1" HistoryIndex="0">
<JumpHistory Count="4" HistoryIndex="3">
<Position1>
<Filename Value="../../base_service_intf.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
<Filename Value="lib_server.lpr"/>
<Caret Line="32" Column="17" TopLine="17"/>
</Position1>
<Position2>
<Filename Value="..\..\semaphore.pas"/>
<Caret Line="1" Column="1" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="..\..\library_server_intf.pas"/>
<Caret Line="61" Column="3" TopLine="47"/>
</Position3>
<Position4>
<Filename Value="..\..\library_server_intf.pas"/>
<Caret Line="92" Column="71" TopLine="27"/>
</Position4>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="lib_server.dll"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="../;../../;../../wst_rtti_filter/"/>
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
@ -112,19 +135,19 @@
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>

451
wst/trunk/samples/tcp_server/tcp_server.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<Flags>
@ -10,15 +10,16 @@
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<IconPath Value=".\"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="2"/>
<ActiveEditorIndexAtStart Value="10"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -26,18 +27,18 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="37">
<Units Count="47">
<Unit0>
<Filename Value="tcp_server.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="tcp_server"/>
<CursorPos X="51" Y="21"/>
<TopLine Value="27"/>
<CursorPos X="1" Y="56"/>
<TopLine Value="30"/>
<EditorIndex Value="0"/>
<UsageCount Value="68"/>
<UsageCount Value="79"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -45,222 +46,226 @@
<UnitName Value="synapse_tcp_server"/>
<CursorPos X="42" Y="211"/>
<TopLine Value="197"/>
<UsageCount Value="65"/>
<UsageCount Value="64"/>
</Unit1>
<Unit2>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/classes/classesh.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="26" Y="686"/>
<TopLine Value="672"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit2>
<Unit3>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/win/sysosh.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\sysosh.inc"/>
<CursorPos X="3" Y="25"/>
<TopLine Value="4"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit3>
<Unit4>
<Filename Value="../../../../../lazarus23_213/others_package/synapse/blcksock.pas"/>
<Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2395"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit4>
<Unit5>
<Filename Value="../../binary_streamer.pas"/>
<Filename Value="..\..\binary_streamer.pas"/>
<UnitName Value="binary_streamer"/>
<CursorPos X="37" Y="13"/>
<TopLine Value="178"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit5>
<Unit6>
<Filename Value="../../server_service_soap.pas"/>
<Filename Value="..\..\server_service_soap.pas"/>
<UnitName Value="server_service_soap"/>
<CursorPos X="35" Y="29"/>
<TopLine Value="8"/>
<UsageCount Value="22"/>
<CursorPos X="53" Y="177"/>
<TopLine Value="157"/>
<EditorIndex Value="2"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../server_binary_formatter.pas"/>
<Filename Value="..\..\server_binary_formatter.pas"/>
<UnitName Value="server_binary_formatter"/>
<CursorPos X="24" Y="22"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit7>
<Unit8>
<Filename Value="../../metadata_service.pas"/>
<Filename Value="..\..\metadata_service.pas"/>
<UnitName Value="metadata_service"/>
<CursorPos X="96" Y="118"/>
<TopLine Value="103"/>
<UsageCount Value="8"/>
<CursorPos X="11" Y="121"/>
<TopLine Value="99"/>
<UsageCount Value="12"/>
</Unit8>
<Unit9>
<Filename Value="../../metadata_service_imp.pas"/>
<Filename Value="..\..\metadata_service_imp.pas"/>
<UnitName Value="metadata_service_imp"/>
<CursorPos X="1" Y="39"/>
<TopLine Value="28"/>
<UsageCount Value="8"/>
<CursorPos X="58" Y="121"/>
<TopLine Value="1"/>
<UsageCount Value="14"/>
</Unit9>
<Unit10>
<Filename Value="../../metadata_service_binder.pas"/>
<Filename Value="..\..\metadata_service_binder.pas"/>
<UnitName Value="metadata_service_binder"/>
<CursorPos X="69" Y="11"/>
<TopLine Value="9"/>
<UsageCount Value="8"/>
<CursorPos X="47" Y="16"/>
<TopLine Value="1"/>
<UsageCount Value="12"/>
</Unit10>
<Unit11>
<Filename Value="../user_service_intf.pas"/>
<Filename Value="..\user_service_intf.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="14" Y="48"/>
<TopLine Value="55"/>
<EditorIndex Value="4"/>
<UsageCount Value="68"/>
<CursorPos X="3" Y="27"/>
<TopLine Value="5"/>
<EditorIndex Value="9"/>
<UsageCount Value="79"/>
<Loaded Value="True"/>
</Unit11>
<Unit12>
<Filename Value="../../base_service_intf.pas"/>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="4148"/>
<TopLine Value="4118"/>
<EditorIndex Value="1"/>
<UsageCount Value="24"/>
<CursorPos X="15" Y="307"/>
<TopLine Value="293"/>
<EditorIndex Value="5"/>
<UsageCount Value="29"/>
<Bookmarks Count="1">
<Item0 X="19" Y="545" ID="0"/>
</Bookmarks>
<Loaded Value="True"/>
</Unit12>
<Unit13>
<Filename Value="../../wst_rtti_filter/std_cursors.pas"/>
<Filename Value="..\..\wst_rtti_filter\std_cursors.pas"/>
<UnitName Value="std_cursors"/>
<CursorPos X="1" Y="48"/>
<TopLine Value="36"/>
<EditorIndex Value="6"/>
<UsageCount Value="33"/>
<CursorPos X="14" Y="21"/>
<TopLine Value="7"/>
<EditorIndex Value="12"/>
<UsageCount Value="34"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
<Filename Value="../../wst_rtti_filter/cursor_intf.pas"/>
<Filename Value="..\..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/>
<CursorPos X="3" Y="27"/>
<TopLine Value="15"/>
<UsageCount Value="24"/>
<UsageCount Value="23"/>
</Unit14>
<Unit15>
<Filename Value="../user_service_intf_binder.pas"/>
<Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/>
<CursorPos X="30" Y="7"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="34"/>
<CursorPos X="48" Y="34"/>
<TopLine Value="11"/>
<EditorIndex Value="8"/>
<UsageCount Value="37"/>
<Loaded Value="True"/>
</Unit15>
<Unit16>
<Filename Value="../user_service_intf.wst"/>
<Filename Value="..\user_service_intf.wst"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
<SyntaxHighlighter Value="None"/>
</Unit16>
<Unit17>
<Filename Value="../../metadata_repository.pas"/>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="37" Y="571"/>
<TopLine Value="562"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit17>
<Unit18>
<Filename Value="../../wst_resources_imp.pas"/>
<Filename Value="..\..\wst_resources_imp.pas"/>
<UnitName Value="wst_resources_imp"/>
<CursorPos X="15" Y="63"/>
<TopLine Value="45"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit18>
<Unit19>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/inc/except.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\except.inc"/>
<CursorPos X="3" Y="95"/>
<TopLine Value="73"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit19>
<Unit20>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/i386/setjump.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\i386\setjump.inc"/>
<CursorPos X="1" Y="36"/>
<TopLine Value="16"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit20>
<Unit21>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/inc/objpas.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\objpas.inc"/>
<CursorPos X="1" Y="76"/>
<TopLine Value="64"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit21>
<Unit22>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/classes/collect.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\collect.inc"/>
<CursorPos X="1" Y="264"/>
<TopLine Value="252"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit22>
<Unit23>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/classes/lists.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\lists.inc"/>
<CursorPos X="1" Y="381"/>
<TopLine Value="369"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit23>
<Unit24>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/inc/system.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\system.inc"/>
<CursorPos X="1" Y="674"/>
<TopLine Value="662"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit24>
<Unit25>
<Filename Value="../../server_service_intf.pas"/>
<Filename Value="..\..\server_service_intf.pas"/>
<UnitName Value="server_service_intf"/>
<CursorPos X="16" Y="346"/>
<TopLine Value="323"/>
<UsageCount Value="8"/>
<CursorPos X="1" Y="356"/>
<TopLine Value="342"/>
<EditorIndex Value="7"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit25>
<Unit26>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/i386/i386.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\i386\i386.inc"/>
<CursorPos X="1" Y="1125"/>
<TopLine Value="1113"/>
<UsageCount Value="6"/>
<UsageCount Value="5"/>
</Unit26>
<Unit27>
<Filename Value="../user_service_intf_imp.pas"/>
<Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/>
<CursorPos X="25" Y="13"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="34"/>
<CursorPos X="1" Y="63"/>
<TopLine Value="107"/>
<EditorIndex Value="10"/>
<UsageCount Value="39"/>
<Loaded Value="True"/>
</Unit27>
<Unit28>
<Filename Value="../../service_intf.pas"/>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="15" Y="23"/>
<TopLine Value="19"/>
<UsageCount Value="7"/>
<UsageCount Value="6"/>
</Unit28>
<Unit29>
<Filename Value="../../base_soap_formatter.pas"/>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="65" Y="313"/>
<TopLine Value="304"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit29>
<Unit30>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/typinfo.pp"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="11" Y="247"/>
<TopLine Value="226"/>
<UsageCount Value="8"/>
<UsageCount Value="7"/>
</Unit30>
<Unit31>
<Filename Value="../../base_binary_formatter.pas"/>
<Filename Value="..\..\base_binary_formatter.pas"/>
<UnitName Value="base_binary_formatter"/>
<CursorPos X="3" Y="1063"/>
<TopLine Value="1055"/>
<UsageCount Value="10"/>
<UsageCount Value="9"/>
</Unit31>
<Unit32>
<Filename Value="imp_helper.pas"/>
@ -268,49 +273,251 @@
<UnitName Value="imp_helper"/>
<CursorPos X="1" Y="44"/>
<TopLine Value="32"/>
<UsageCount Value="37"/>
<UsageCount Value="48"/>
</Unit32>
<Unit33>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/classes/persist.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\persist.inc"/>
<CursorPos X="3" Y="36"/>
<TopLine Value="32"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit33>
<Unit34>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/classes/streams.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\classes\streams.inc"/>
<CursorPos X="43" Y="511"/>
<TopLine Value="506"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit34>
<Unit35>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/win/sysutils.pp"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\sysutils.pp"/>
<UnitName Value="sysutils"/>
<CursorPos X="1" Y="326"/>
<TopLine Value="314"/>
<UsageCount Value="9"/>
<UsageCount Value="8"/>
</Unit35>
<Unit36>
<Filename Value="../../synapse_tcp_server.pas"/>
<Filename Value="..\..\synapse_tcp_server.pas"/>
<UnitName Value="synapse_tcp_server"/>
<CursorPos X="34" Y="240"/>
<TopLine Value="231"/>
<EditorIndex Value="2"/>
<UsageCount Value="12"/>
<CursorPos X="1" Y="209"/>
<TopLine Value="26"/>
<EditorIndex Value="6"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit36>
<Unit37>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="96"/>
<TopLine Value="56"/>
<UsageCount Value="9"/>
</Unit37>
<Unit38>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="4" Y="6"/>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit38>
<Unit39>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\i386\i386.inc"/>
<CursorPos X="1" Y="1246"/>
<TopLine Value="1234"/>
<UsageCount Value="9"/>
</Unit39>
<Unit40>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysutils.inc"/>
<CursorPos X="1" Y="347"/>
<TopLine Value="334"/>
<UsageCount Value="9"/>
</Unit40>
<Unit41>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2393"/>
<EditorIndex Value="11"/>
<UsageCount Value="11"/>
<Loaded Value="True"/>
</Unit41>
<Unit42>
<Filename Value="..\..\server_service_xmlrpc.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="server_service_xmlrpc"/>
<CursorPos X="1" Y="83"/>
<TopLine Value="69"/>
<EditorIndex Value="3"/>
<UsageCount Value="30"/>
<Loaded Value="True"/>
</Unit42>
<Unit43>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="4"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit43>
<Unit44>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="10" Y="111"/>
<TopLine Value="97"/>
<UsageCount Value="9"/>
</Unit44>
<Unit45>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\sysutils\sysstr.inc"/>
<CursorPos X="3" Y="759"/>
<TopLine Value="756"/>
<UsageCount Value="9"/>
</Unit45>
<Unit46>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="483"/>
<TopLine Value="469"/>
<UsageCount Value="10"/>
</Unit46>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="182" Column="36" TopLine="168"/>
</Position1>
<Position2>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="191" Column="32" TopLine="176"/>
</Position2>
<Position3>
<Filename Value="tcp_server.pas"/>
<Caret Line="42" Column="5" TopLine="14"/>
</Position3>
<Position4>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="88" Column="1" TopLine="74"/>
</Position4>
<Position5>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<Caret Line="1198" Column="1" TopLine="1184"/>
</Position5>
<Position6>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="88" Column="1" TopLine="74"/>
</Position6>
<Position7>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="89" Column="1" TopLine="75"/>
</Position7>
<Position8>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="93" Column="62" TopLine="76"/>
</Position8>
<Position9>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="92" Column="26" TopLine="74"/>
</Position9>
<Position10>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="111" Column="1" TopLine="97"/>
</Position10>
<Position11>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="112" Column="1" TopLine="98"/>
</Position11>
<Position12>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="113" Column="1" TopLine="99"/>
</Position12>
<Position13>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="89" Column="1" TopLine="75"/>
</Position13>
<Position14>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="91" Column="1" TopLine="77"/>
</Position14>
<Position15>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="92" Column="1" TopLine="78"/>
</Position15>
<Position16>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="93" Column="1" TopLine="79"/>
</Position16>
<Position17>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="76" Column="19" TopLine="62"/>
</Position17>
<Position18>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="54" Column="1" TopLine="42"/>
</Position18>
<Position19>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="83" Column="47" TopLine="62"/>
</Position19>
<Position20>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="56" Column="1" TopLine="40"/>
</Position20>
<Position21>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="76" Column="1" TopLine="62"/>
</Position21>
<Position22>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="54" Column="1" TopLine="40"/>
</Position22>
<Position23>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="56" Column="1" TopLine="42"/>
</Position23>
<Position24>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="54" Column="1" TopLine="40"/>
</Position24>
<Position25>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="63" Column="1" TopLine="49"/>
</Position25>
<Position26>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<Caret Line="2407" Column="1" TopLine="2393"/>
</Position26>
<Position27>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="64" Column="52" TopLine="40"/>
</Position27>
<Position28>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="56" Column="1" TopLine="42"/>
</Position28>
<Position29>
<Filename Value="..\user_service_intf_imp.pas"/>
<Caret Line="63" Column="1" TopLine="49"/>
</Position29>
<Position30>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<Caret Line="2407" Column="1" TopLine="2393"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="tcp_server.exe"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../../"/>
<OtherUnitFiles Value="../;../../;../../wst_rtti_filter/;$(LazarusDir)/others_package/synapse/"/>
<IncludeFiles Value="..\..\;..\"/>
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
@ -319,27 +526,39 @@
</Other>
</CompilerOptions>
<Debugging>
<BreakPoints Count="5">
<BreakPoints Count="8">
<Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
<Item5>
<Source Value="../user_service_intf_imp.pas"/>
<Line Value="176"/>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="89"/>
</Item5>
<Item6>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="88"/>
</Item6>
<Item7>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="54"/>
</Item7>
<Item8>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="56"/>
</Item8>
</BreakPoints>
<Watches Count="2">
<Item1>

12
wst/trunk/samples/tcp_server/tcp_server.pas
View File

@ -29,7 +29,8 @@ uses
metadata_service, metadata_service_imp, metadata_service_binder,
synapse_tcp_server,
user_service_intf, user_service_intf_binder, user_service_intf_imp , imp_helper;
user_service_intf, user_service_intf_binder, user_service_intf_imp , imp_helper,
server_service_xmlrpc;
var
@ -38,12 +39,15 @@ begin
SetLogger(TConsoleLogger.Create());
Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat();
Server_service_RegisterWSTMetadataServiceService();
//Server_service_RegisterSoapFormat();
Server_service_RegisterXmlRpcFormat();
RegisterWSTMetadataServiceImplementationFactory();
//Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterUserServiceService();
RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
Logger().Log('WST sample TCP Server listning on "%s"',[sSERVER_PORT]);
Logger().Log('Hit <enter> to stop.');

223
wst/trunk/samples/user_client_console/user_client_console.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<PathDelim Value="/"/>
<PathDelim Value="\"/>
<Version Value="5"/>
<General>
<Flags>
@ -10,15 +10,16 @@
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<MainUnit Value="0"/>
<IconPath Value="./"/>
<IconPath Value=".\"/>
<TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/>
<ActiveEditorIndexAtStart Value="0"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -26,165 +27,249 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<Units Count="19">
<Units Count="30">
<Unit0>
<Filename Value="user_client_console.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="user_client_console"/>
<CursorPos X="12" Y="14"/>
<TopLine Value="16"/>
<CursorPos X="40" Y="150"/>
<TopLine Value="133"/>
<EditorIndex Value="0"/>
<UsageCount Value="34"/>
<UsageCount Value="50"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="../user_service_intf_proxy.pas"/>
<Filename Value="..\user_service_intf_proxy.pas"/>
<UnitName Value="user_service_intf_proxy"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="5"/>
<UsageCount Value="17"/>
<CursorPos X="1" Y="68"/>
<TopLine Value="54"/>
<EditorIndex Value="6"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../synapse_tcp_protocol.pas"/>
<Filename Value="..\..\synapse_tcp_protocol.pas"/>
<UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="17"/>
<CursorPos X="29" Y="132"/>
<TopLine Value="101"/>
<EditorIndex Value="9"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../service_intf.pas"/>
<Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<CursorPos X="3" Y="31"/>
<TopLine Value="9"/>
<EditorIndex Value="4"/>
<UsageCount Value="17"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit3>
<Unit4>
<Filename Value="../user_service_intf.pas"/>
<Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/>
<CursorPos X="1" Y="1"/>
<CursorPos X="3" Y="3"/>
<TopLine Value="1"/>
<EditorIndex Value="7"/>
<UsageCount Value="17"/>
<EditorIndex Value="1"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="../../../../../lazarus23_213/others_package/synapse/blcksock.pas"/>
<Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="60" Y="2413"/>
<TopLine Value="2393"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit5>
<Unit6>
<Filename Value="../../base_service_intf.pas"/>
<Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/>
<CursorPos X="52" Y="4135"/>
<TopLine Value="4000"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="3"/>
<UsageCount Value="17"/>
<UsageCount Value="25"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="../../library_protocol.pas"/>
<Filename Value="..\..\library_protocol.pas"/>
<UnitName Value="library_protocol"/>
<CursorPos X="18" Y="5"/>
<TopLine Value="26"/>
<EditorIndex Value="1"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
<UsageCount Value="15"/>
</Unit7>
<Unit8>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/sysutils/finah.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\finah.inc"/>
<CursorPos X="10" Y="33"/>
<TopLine Value="17"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit8>
<Unit9>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/sysutils/fina.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\fina.inc"/>
<CursorPos X="13" Y="112"/>
<TopLine Value="105"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit9>
<Unit10>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/sysutils/sysutilh.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\sysutilh.inc"/>
<CursorPos X="33" Y="202"/>
<TopLine Value="188"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit10>
<Unit11>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/win32/system.pp"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win32\system.pp"/>
<UnitName Value="System"/>
<CursorPos X="20" Y="35"/>
<TopLine Value="21"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit11>
<Unit12>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/inc/fexpand.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\inc\fexpand.inc"/>
<CursorPos X="10" Y="86"/>
<TopLine Value="226"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit12>
<Unit13>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/objpas/sysutils/sysstrh.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\objpas\sysutils\sysstrh.inc"/>
<CursorPos X="54" Y="33"/>
<TopLine Value="19"/>
<UsageCount Value="9"/>
<UsageCount Value="7"/>
</Unit13>
<Unit14>
<Filename Value="../../synapse_http_protocol.pas"/>
<Filename Value="..\..\synapse_http_protocol.pas"/>
<UnitName Value="synapse_http_protocol"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="22"/>
<UsageCount Value="17"/>
<UsageCount Value="15"/>
</Unit14>
<Unit15>
<Filename Value="../../metadata_repository.pas"/>
<Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
<UsageCount Value="15"/>
</Unit15>
<Unit16>
<Filename Value="../../wst.inc"/>
<CursorPos X="1" Y="1"/>
<Filename Value="..\..\wst.inc"/>
<CursorPos X="17" Y="15"/>
<TopLine Value="1"/>
<UsageCount Value="12"/>
<UsageCount Value="15"/>
</Unit16>
<Unit17>
<Filename Value="../../library_imp_utils.pas"/>
<Filename Value="..\..\library_imp_utils.pas"/>
<UnitName Value="library_imp_utils"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="../../../../../lazarus23_213/fpc/2.1.3/source/rtl/win/dynlibs.inc"/>
<Filename Value="..\..\..\..\..\lazarus23_213\fpc\2.1.3\source\rtl\win\dynlibs.inc"/>
<CursorPos X="17" Y="27"/>
<TopLine Value="13"/>
<UsageCount Value="10"/>
<UsageCount Value="8"/>
</Unit18>
<Unit19>
<Filename Value="..\..\semaphore.pas"/>
<UnitName Value="semaphore"/>
<CursorPos X="1" Y="96"/>
<TopLine Value="72"/>
<UsageCount Value="8"/>
</Unit19>
<Unit20>
<Filename Value="..\..\soap_formatter.pas"/>
<UnitName Value="soap_formatter"/>
<CursorPos X="21" Y="42"/>
<TopLine Value="46"/>
<UsageCount Value="18"/>
</Unit20>
<Unit21>
<Filename Value="..\..\xmlrpc_formatter.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="xmlrpc_formatter"/>
<CursorPos X="18" Y="139"/>
<TopLine Value="128"/>
<EditorIndex Value="5"/>
<UsageCount Value="36"/>
<Loaded Value="True"/>
</Unit21>
<Unit22>
<Filename Value="..\..\binary_formatter.pas"/>
<UnitName Value="binary_formatter"/>
<CursorPos X="17" Y="23"/>
<TopLine Value="1"/>
<EditorIndex Value="8"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit22>
<Unit23>
<Filename Value="..\..\wst_delphi.inc"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="8"/>
</Unit23>
<Unit24>
<Filename Value="..\..\base_xmlrpc_formatter.pas"/>
<UnitName Value="base_xmlrpc_formatter"/>
<CursorPos X="1" Y="1323"/>
<TopLine Value="1309"/>
<EditorIndex Value="7"/>
<UsageCount Value="18"/>
<Loaded Value="True"/>
</Unit24>
<Unit25>
<Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit25>
<Unit26>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\classes\classesh.inc"/>
<CursorPos X="3" Y="592"/>
<TopLine Value="590"/>
<UsageCount Value="13"/>
</Unit26>
<Unit27>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\rtl\objpas\typinfo.pp"/>
<UnitName Value="typinfo"/>
<CursorPos X="1" Y="483"/>
<TopLine Value="469"/>
<UsageCount Value="13"/>
</Unit27>
<Unit28>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/>
<TopLine Value="2393"/>
<UsageCount Value="13"/>
</Unit28>
<Unit29>
<Filename Value="..\..\..\..\..\..\lazarus_23_215\fpc\2.1.5\source\packages\fcl-xml\src\xmlread.pp"/>
<UnitName Value="XMLRead"/>
<CursorPos X="1" Y="2763"/>
<TopLine Value="2749"/>
<UsageCount Value="13"/>
</Unit29>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
<JumpHistory Count="1" HistoryIndex="0">
<Position1>
<Filename Value="user_client_console.pas"/>
<Caret Line="147" Column="27" TopLine="133"/>
</Position1>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="user_client_console.exe"/>
</Target>
<SearchPaths>
<OtherUnitFiles Value="../;../../;$(LazarusDir)/others_package/synapse/"/>
<OtherUnitFiles Value="..\;..\..\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/>
</SearchPaths>
<CodeGeneration>
@ -197,19 +282,19 @@
<Debugging>
<BreakPoints Count="4">
<Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/>
</Item1>
<Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/>
</Item2>
<Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/>
</Item3>
<Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/>
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/>
</Item4>
</BreakPoints>

112
wst/trunk/samples/user_client_console/user_client_console.pas
View File

@ -7,7 +7,11 @@ uses
user_service_intf_proxy,
synapse_tcp_protocol, synapse_http_protocol, library_protocol,
soap_formatter, binary_formatter,
user_service_intf;
user_service_intf, xmlrpc_formatter;
type
TUser = TUser_Type;
TUserCategory = TUserCategory_Type;
var
UserServiceInst : UserService;
@ -56,8 +60,9 @@ begin
end;
end;
procedure HandleAdd();
type TAddType = ( atAdd, atUpdate );
procedure HandleAdd(const AType :TAddType);
const CAPTIONS : array[TAddType] of string = ( 'Adding a user :', 'Updating a user :' );
function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
begin
Result := '';
@ -72,7 +77,7 @@ var
buff : string;
begin
buff := '';
WriteLn('Adding a user :');
WriteLn(CAPTIONS[AType]);
try
usr := TUser.Create();
try
@ -84,6 +89,9 @@ begin
usr.Category:= Normal;
usr.eMail := ReadItem('Enter user e-mail : ',False);
usr.Preferences := ReadItem('Enter user Preferences : ',False);
if ( AType = atUpdate ) then
UserServiceInst.Update(usr)
else
UserServiceInst.Add(usr);
finally
FreeAndNil(usr);
@ -110,28 +118,46 @@ begin
end;
end;
type TTransportType = ( ttLibrary, ttTCP, ttHTTP );
procedure CreateProxy(const ATransportType :TTransportType);
const ADDRESS_MAP : array[TTransportType] of string = (
'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
'TCP:Address=127.0.0.1;Port=1234;target=UserService',
'http:Address=http://127.0.0.1:8080/wst/services/UserService'
//'http:Address=http://127.0.0.1:8000/services/UserService'
);
procedure HandleDeleteUser();
var
buff : string;
begin
buff := ADDRESS_MAP[ATransportType];
if ( ATransportType = ttLibrary ) then
Write('Enter User Name : ');
ReadLn(buff);
UserServiceInst.Delete(buff);
end;
type
TTransportType = ( ttLibrary, ttTCP, ttHTTP );
TFormatType = ( ftBinary, ftSoap, ftXmlRPC );
var
TransportType : TTransportType;
FormatValue : TFormatType;
procedure CreateProxy();
const ADDRESS_MAP : array[TTransportType] of string = (
'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
'TCP:Address=127.0.0.1;Port=1234;target=UserService',
//'http:Address=http://127.0.0.1:8080/wst/services/UserService/?format=soap'
'http:Address=http://127.0.0.1:8000/services/UserService'
);
FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc' );
var
buff : string;
begin
if ( TransportType = ttHTTP ) then
buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
else
buff := ADDRESS_MAP[TransportType];
if ( TransportType = ttLibrary ) then
buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
UserServiceInst := TUserService_Proxy.Create(
'UserService',
'binary:',
FORMAT_MAP[FormatValue] + ':',
buff
);
end;
function ReadTransportType():TTransportType;
procedure ReadTransportType();
var
buff : string;
begin
@ -147,9 +173,34 @@ begin
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
case buff[1] of
'L' : Result := ttLibrary;
'T' : Result := ttTCP;
'H' : Result := ttHTTP;
'L' : TransportType := ttLibrary;
'T' : TransportType := ttTCP;
'H' : TransportType := ttHTTP;
end;
Break;
end;
end;
end;
procedure ReadFormatType();
var
buff : string;
begin
WriteLn();
WriteLn('Select a messaging format : ');
WriteLn(' B : binary ( binary_formatter.pas )');
WriteLn(' S : soap ( soap_formatter.pas )');
WriteLn(' X : XmlRpc ( xmlrpc_formatter.pas )');
WriteLn();
Write('Your selection : ');
while True do begin
ReadLn(buff);
buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['B','S', 'X'] ) then begin
case buff[1] of
'B' : FormatValue := ftBinary;
'S' : FormatValue := ftSoap;
'X' : FormatValue := ftXmlRPC;
end;
Break;
end;
@ -158,18 +209,22 @@ end;
var
strBuffer : string;
tt : TTransportType;
begin
SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport();
WriteLn('Sample Application using Web Services Toolkit');
CreateProxy(ReadTransportType());
ReadFormatType();
ReadTransportType();
CreateProxy();
WriteLn('Menu :');
WriteLn(' L : Show the user list');
WriteLn(' A : Add a new user');
WriteLn(' U : Update a user');
WriteLn(' D : Delete a user');
WriteLn(' F : Find a new');
WriteLn(' C : Change the communication protocol');
WriteLn(' Z : Change the messaging format');
WriteLn(' X : Exit');
WriteLn();
Write('Choose a item : ');
@ -180,9 +235,20 @@ begin
if ( Length(strBuffer) > 0 ) then begin
case strBuffer[1] of
'L' : HandleShowAll();
'A' : HandleAdd();
'A' : HandleAdd(atAdd);
'U' : HandleAdd(atUpdate);
'D' : HandleDeleteUser();
'F' : HandleFindUser();
'C' : CreateProxy(ReadTransportType());
'C' :
begin
ReadTransportType();
CreateProxy();
end;
'Z' :
begin
ReadFormatType();
CreateProxy();
end;
'X' : Break;
end;
WriteLn();

39
wst/trunk/samples/user_service_intf.pas
View File

@ -2,7 +2,7 @@
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf".
Date : "05/05/2007 19:07".
Date : "26/06/2007 23:46:28".
}
unit user_service_intf;
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
@ -16,22 +16,22 @@ const
type
TUser = class;
TUserArray = class;
TUser_Type = class;
TUserCategory = (
TUserCategory_Type = (
Normal
,Admin
);
TUser = class(TBaseComplexRemotable)
TUser_Type = class(TBaseComplexRemotable)
private
FCategory : TUserCategory;
FCategory : TUserCategory_Type;
FUserName : string;
FeMail : string;
FPreferences : string;
published
property Category : TUserCategory read FCategory write FCategory;
property Category : TUserCategory_Type 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;
@ -39,26 +39,26 @@ type
TUserArray = class(TBaseObjectArrayRemotable)
private
function GetItem(AIndex: Integer): TUser;
function GetItem(AIndex: Integer): TUser_Type;
public
class function GetItemClass():TBaseRemotableClass;override;
property Item[AIndex:Integer] : TUser Read GetItem;Default;
property Item[AIndex:Integer] : TUser_Type Read GetItem;Default;
end;
UserService = interface(IInvokable)
['{842D8408-E142-470F-9CDD-FAD0D8AEEB12}']
['{757DE451-CE83-454C-8757-6D72428EB1AA}']
function GetList():TUserArray;
procedure Add(
Const AUser : TUser
const AUser : TUser_Type
);
procedure Update(
Const AUser : TUser
const AUser : TUser_Type
);
function Find(
Const AName : string
):TUser;
const AName : string
):TUser_Type;
function Delete(
Const AName : string
const AName : string
):boolean;
end;
@ -69,14 +69,14 @@ uses metadata_repository;
{ TUserArray }
function TUserArray.GetItem(AIndex: Integer): TUser;
function TUserArray.GetItem(AIndex: Integer): TUser_Type;
begin
Result := Inherited GetItem(AIndex) As TUser;
Result := Inherited GetItem(AIndex) As TUser_Type;
end;
class function TUserArray.GetItemClass(): TBaseRemotableClass;
begin
Result:= TUser;
Result:= TUser_Type;
end;
@ -207,10 +207,11 @@ end;
initialization
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserCategory),'TUserCategory');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUser),'TUser');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserCategory_Type),'TUserCategory');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUser_Type),'TUser');
GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserArray),'TUserArray');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TUserArray)].RegisterExternalPropertyName(sARRAY_ITEM,'item');
GetTypeRegistry().ItemByTypeInfo[TypeInfo(TUser_Type)].RegisterExternalPropertyName('Category','item');
End.

210
wst/trunk/samples/user_service_intf_binder.pas
View File

@ -2,10 +2,10 @@
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_binder".
Date : "02/05/2007 20:07".
Date : "26/06/2007 23:46:28".
}
unit user_service_intf_binder;
{$mode objfpc}{$H+}
{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
interface
uses SysUtils, Classes, base_service_intf, server_service_intf, user_service_intf;
@ -14,20 +14,25 @@ type
TUserService_ServiceBinder = class(TBaseServiceBinder)
Protected
procedure GetListHandler(AFormatter:IFormatterResponse);
procedure AddHandler(AFormatter:IFormatterResponse);
procedure UpdateHandler(AFormatter:IFormatterResponse);
procedure FindHandler(AFormatter:IFormatterResponse);
procedure DeleteHandler(AFormatter:IFormatterResponse);
Public
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;
end;
TUserService_ServiceBinderFactory = class(TInterfacedObject,IItemFactory)
private
FInstance : IInterface;
protected
function CreateInstance():IInterface;
End;
public
constructor Create();
destructor Destroy();override;
end;
procedure Server_service_RegisterUserServiceService();
@ -35,26 +40,30 @@ Implementation
uses TypInfo, wst_resources_imp,metadata_repository;
{ TUserService_ServiceBinder implementation }
procedure TUserService_ServiceBinder.GetListHandler(AFormatter:IFormatterResponse);
Var
procedure TUserService_ServiceBinder.GetListHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
returnVal : TUserArray;
Begin
callCtx := GetCallContext();
If ( PTypeInfo(TypeInfo(TUserArray))^.Kind in [tkClass,tkInterface] ) Then
Pointer(returnVal) := Nil;
begin
callCtx := AContext;
TObject(returnVal) := nil;
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(GetCallContext());
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.GetList();
If ( PTypeInfo(TypeInfo(TUserArray))^.Kind = tkClass ) And Assigned(Pointer(returnVal)) Then
if Assigned(TObject(returnVal)) then
callCtx.AddObjectToFree(TObject(returnVal));
procName := AFormatter.GetCallProcedureName();
@ -64,29 +73,39 @@ Begin
AFormatter.Put('result',TypeInfo(TUserArray),returnVal);
AFormatter.EndCallResponse();
callCtx := Nil;
End;
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.AddHandler(AFormatter:IFormatterResponse);
Var
procedure TUserService_ServiceBinder.AddHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AUser : TUser;
Begin
callCtx := GetCallContext();
TObject(AUser) := Nil;
AUser : TUser_Type;
begin
callCtx := AContext;
TObject(AUser) := nil;
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser),strPrmName,AUser);
If Assigned(Pointer(AUser)) Then
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser_Type),strPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(GetCallContext());
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Add(AUser);
procName := AFormatter.GetCallProcedureName();
@ -95,29 +114,39 @@ Begin
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := Nil;
End;
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.UpdateHandler(AFormatter:IFormatterResponse);
Var
procedure TUserService_ServiceBinder.UpdateHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AUser : TUser;
Begin
callCtx := GetCallContext();
TObject(AUser) := Nil;
AUser : TUser_Type;
begin
callCtx := AContext;
TObject(AUser) := nil;
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser),strPrmName,AUser);
If Assigned(Pointer(AUser)) Then
strPrmName := 'AUser'; AFormatter.Get(TypeInfo(TUser_Type),strPrmName,AUser);
if Assigned(Pointer(AUser)) then
callCtx.AddObjectToFree(TObject(AUser));
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(GetCallContext());
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
tmpObj.Update(AUser);
procName := AFormatter.GetCallProcedureName();
@ -126,60 +155,80 @@ Begin
AFormatter.BeginCallResponse(procName,trgName);
AFormatter.EndCallResponse();
callCtx := Nil;
End;
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.FindHandler(AFormatter:IFormatterResponse);
Var
procedure TUserService_ServiceBinder.FindHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AName : string;
returnVal : TUser;
Begin
callCtx := GetCallContext();
TObject(returnVal) := Nil;
returnVal : TUser_Type;
begin
callCtx := AContext;
TObject(returnVal) := nil;
strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(GetCallContext());
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Find(AName);
If Assigned(TObject(returnVal)) Then
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.Put('result',TypeInfo(TUser_Type),returnVal);
AFormatter.EndCallResponse();
callCtx := Nil;
End;
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
procedure TUserService_ServiceBinder.DeleteHandler(AFormatter:IFormatterResponse);
Var
procedure TUserService_ServiceBinder.DeleteHandler(AFormatter : IFormatterResponse; AContext : ICallContext);
var
cllCntrl : ICallControl;
objCntrl : IObjectControl;
hasObjCntrl : Boolean;
tmpObj : UserService;
callCtx : ICallContext;
strPrmName : string;
procName,trgName : string;
AName : string;
returnVal : boolean;
Begin
callCtx := GetCallContext();
begin
callCtx := AContext;
strPrmName := 'AName'; AFormatter.Get(TypeInfo(string),strPrmName,AName);
tmpObj := Self.GetFactory().CreateInstance() as UserService;
if Supports(tmpObj,ICallControl,cllCntrl) then
cllCntrl.SetCallContext(GetCallContext());
cllCntrl.SetCallContext(callCtx);
hasObjCntrl := Supports(tmpObj,IObjectControl,objCntrl);
if hasObjCntrl then
objCntrl.Activate();
try
returnVal := tmpObj.Delete(AName);
procName := AFormatter.GetCallProcedureName();
@ -189,26 +238,43 @@ Begin
AFormatter.Put('result',TypeInfo(boolean),returnVal);
AFormatter.EndCallResponse();
callCtx := Nil;
End;
callCtx := nil;
finally
if hasObjCntrl then
objCntrl.Deactivate();
Self.GetFactory().ReleaseInstance(tmpObj);
end;
end;
constructor TUserService_ServiceBinder.Create();
Begin
Inherited Create(GetServiceImplementationRegistry().FindFactory('UserService'));
begin
inherited Create(GetServiceImplementationRegistry().FindFactory('UserService'));
RegisterVerbHandler('GetList',@GetListHandler);
RegisterVerbHandler('Add',@AddHandler);
RegisterVerbHandler('Update',@UpdateHandler);
RegisterVerbHandler('Find',@FindHandler);
RegisterVerbHandler('Delete',@DeleteHandler);
End;
end;
{ TUserService_ServiceBinderFactory }
function TUserService_ServiceBinderFactory.CreateInstance():IInterface;
Begin
Result := TUserService_ServiceBinder.Create() as IInterface;
End;
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();

1
wst/trunk/samples/user_service_intf_imp.pas
View File

@ -14,6 +14,7 @@ Uses SysUtils, Classes,
Type
TUser = TUser_Type;
{ TUserService_ServiceImp }

28
wst/trunk/samples/user_service_intf_proxy.pas
View File

@ -2,7 +2,7 @@
This unit has been produced by ws_helper.
Input unit name : "user_service_intf".
This unit name : "user_service_intf_proxy".
Date : "6-5-07 16:06:17".
Date : "26/06/2007 23:46:28".
}
Unit user_service_intf_proxy;
@ -19,16 +19,16 @@ Type
class function GetServiceType() : PTypeInfo;override;
function GetList():TUserArray;
procedure Add(
Const AUser : TUser
const AUser : TUser_Type
);
procedure Update(
Const AUser : TUser
const AUser : TUser_Type
);
function Find(
Const AName : string
):TUser;
const AName : string
):TUser_Type;
function Delete(
Const AName : string
const AName : string
):boolean;
End;
@ -73,7 +73,7 @@ Begin
End;
procedure TUserService_Proxy.Add(
Const AUser : TUser
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
@ -82,7 +82,7 @@ Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser), AUser);
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
@ -95,7 +95,7 @@ Begin
End;
procedure TUserService_Proxy.Update(
Const AUser : TUser
const AUser : TUser_Type
);
Var
locSerializer : IFormatterClient;
@ -104,7 +104,7 @@ Begin
locSerializer := GetSerializer();
Try
locSerializer.BeginCall('Update', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser), AUser);
locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall();
MakeCall();
@ -117,8 +117,8 @@ Begin
End;
function TUserService_Proxy.Find(
Const AName : string
):TUser;
const AName : string
):TUser_Type;
Var
locSerializer : IFormatterClient;
strPrmName : string;
@ -134,7 +134,7 @@ Begin
locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil;
strPrmName := 'result';
locSerializer.Get(TypeInfo(TUser), strPrmName, Result);
locSerializer.Get(TypeInfo(TUser_Type), strPrmName, Result);
Finally
locSerializer.Clear();
@ -142,7 +142,7 @@ Begin
End;
function TUserService_Proxy.Delete(
Const AName : string
const AName : string
):boolean;
Var
locSerializer : IFormatterClient;

3
wst/trunk/server_binary_formatter.pas
View File

@ -23,6 +23,7 @@ uses
const
sBINARY_CONTENT_TYPE = 'binary';
sPROTOCOL_NAME = sBINARY_CONTENT_TYPE;
procedure Server_service_RegisterBinaryFormat();
@ -129,7 +130,7 @@ end;
procedure Server_service_RegisterBinaryFormat();
begin
GetFormatterRegistry().Register(sBINARY_CONTENT_TYPE,TBinaryFormatterFactory.Create() as IItemFactory);
GetFormatterRegistry().Register(sPROTOCOL_NAME,sBINARY_CONTENT_TYPE,TBinaryFormatterFactory.Create() as IItemFactory);
end;
Initialization

28
wst/trunk/server_service_imputils.pas
View File

@ -28,7 +28,7 @@ Type
private
FTargetService : string;
FContentType : string;
//FLength : Integer;
FFormat : string;
FContent : TStream;
FResponse : TStream;
protected
@ -37,15 +37,16 @@ Type
//function GetLength():Integer;
function GetContent():TStream;
function GetResponse():TStream;
function GetFormat() : string;
public
constructor Create(
ATargetService : string;
AContentType : string;
//ALength : Integer;
const ATargetService : string;
const AContentType : string;
AContent : TStream;
AResponse : TStream
AResponse : TStream;
AFormat : string
);
End;
end;
function IsStrEmpty(Const AStr:String):Boolean;
@ -84,17 +85,22 @@ begin
Result := FResponse;
end;
function TRequestBuffer.GetFormat(): string;
begin
Result := FFormat;
end;
constructor TRequestBuffer.Create(
ATargetService : string;
AContentType : string;
//ALength : Integer;
const ATargetService : string;
const AContentType : string;
AContent : TStream;
AResponse : TStream
AResponse : TStream;
AFormat : string
);
begin
FTargetService := ATargetService;
FContentType := AContentType;
//FLength := ALength;
FFormat := AFormat;
FContent := AContent;
FResponse := AResponse;
end;

127
wst/trunk/server_service_intf.pas
View File

@ -45,10 +45,10 @@ Type
['{6BF71D1F-DDC0-4432-83C6-6D50D26762C3}']
function GetTargetService():string;
function GetContentType():string;
//function GetLength():Integer;
function GetContent():TStream;
function GetResponse():TStream;
End;
function GetFormat() : string;
end;
IServerService = Interface
['{EEBF8E24-8B20-462F-AA4A-48A5C8BAE680}']
@ -234,12 +234,42 @@ Begin
s.HandleRequest(ARequestBuffer);
End;
Type
type
TFormatterRegistry = class(TBaseFactoryRegistry,IFormatterRegistry)
protected
function Find(const AFormatterName : string):IFormatterBase;
End;
{ TFormatterRegistryItem }
TFormatterRegistryItem = class(TBaseFactoryRegistryItem)
private
FContentType: string;
public
constructor Create(
const AName,
AContentType : string;
const AFactory : IItemFactory
);
property ContentType : string read FContentType;
end;
TFormatterRegistry = class(TInterfacedObject,IInterface,IFormatterRegistry)
private
FList : TObjectList;
private
function GetCount: Integer;
function GetItem(Index: Integer): TFormatterRegistryItem;
function FindFactory(const AName: string): IItemFactory;
function Find(const AName: string): IFormatterBase;
private
property Count : Integer read GetCount;
property Item[Index:Integer] : TFormatterRegistryItem read GetItem;
public
constructor Create();
destructor Destroy();override;
procedure Register(
const AName,
AContentType : string;
AFactory : IItemFactory
);
end;
{ TServerServiceRegistry }
@ -248,6 +278,18 @@ Type
function Find(const AServiceName : string):IServerService;
End;
{ TBaseFormatterRegistryItem }
constructor TFormatterRegistryItem.Create(
const AName,
AContentType : string;
const AFactory : IItemFactory
);
begin
inherited Create(AName,AFactory);
FContentType := AContentType;
end;
{ TServerServiceRegistry }
function TServerServiceRegistry.Find(const AServiceName: string): IServerService;
@ -261,15 +303,73 @@ begin
Result := Nil;
end;
function TFormatterRegistry.Find(const AFormatterName: string): IFormatterBase;
function TFormatterRegistry.Find(const AName : string): IFormatterBase;
Var
fct : IItemFactory;
begin
fct := FindFactory(AFormatterName);
If Assigned(fct) Then
fct := FindFactory(AName);
if Assigned(fct) then
Result := fct.CreateInstance() as IFormatterBase
Else
Result := Nil;
else
Result := nil;
end;
function TFormatterRegistry.GetCount: Integer;
begin
Result := FList.Count;
end;
function TFormatterRegistry.GetItem(Index: Integer) : TFormatterRegistryItem;
begin
Result := FList[Index] as TFormatterRegistryItem;
end;
function TFormatterRegistry.FindFactory(const AName: string): IItemFactory;
var
i , c : Integer;
s : string;
itm : TFormatterRegistryItem;
begin
s := LowerCase(Trim(AName));
c := Pred(FList.Count);
for i := 0 to c do begin
itm := Item[i];
if AnsiSameText(itm.Name,s) then begin
Result := itm.Factory;
Exit;
end;
end;
for i := 0 to c do begin
itm := Item[i];
if AnsiSameText(itm.ContentType,s) then begin
Result := itm.Factory;
Exit;
end;
end;
Result := nil;
end;
constructor TFormatterRegistry.Create();
begin
inherited Create();
FList := TObjectList.Create(True);
end;
destructor TFormatterRegistry.Destroy();
begin
FreeAndNil(FList);
inherited Destroy();
end;
procedure TFormatterRegistry.Register(
const AName,
AContentType : string;
AFactory : IItemFactory
);
begin
Assert(Assigned(AFactory));
if not Assigned(FindFactory(AName)) then
FList.Add(TFormatterRegistryItem.Create(AName,AContentType,AFactory));
end;
Type
@ -341,7 +441,10 @@ Var
hdr : THeaderBlock;
typRegItm : TTypeRegistryItem;
begin
s := Trim(ARequestBuffer.GetFormat());
if ( Length(s) = 0 ) then begin
s := ARequestBuffer.GetContentType();
end;
f := GetFormatterRegistry().Find(s) as IFormatterResponse;
if not Assigned(f) then
Error('No formatter for that content type : "%s"',[s]);

5
wst/trunk/server_service_soap.pas
View File

@ -10,9 +10,8 @@
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit server_service_soap;
{$INCLUDE wst.inc}
unit server_service_soap;
interface
@ -194,7 +193,7 @@ end;
procedure Server_service_RegisterSoapFormat();
begin
GetFormatterRegistry().Register(sSOAP_CONTENT_TYPE,TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory);
GetFormatterRegistry().Register(sPROTOCOL_NAME,sSOAP_CONTENT_TYPE,TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory);
RegisterStdTypes();
end;

181
wst/trunk/server_service_xmlrpc.pas Normal file
View File

@ -0,0 +1,181 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2006 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.
}
unit server_service_xmlrpc;
{$INCLUDE wst.inc}
interface
uses
Classes, SysUtils, TypInfo, DOM,
base_service_intf, server_service_intf,
base_xmlrpc_formatter;
type
{$M+}
{ TXmlRpcFormatter }
TXmlRpcFormatter = class(TXmlRpcBaseFormatter,IFormatterBase,IFormatterResponse)
private
FCallProcedureName : string;
FCallTarget : String;
FCallContext : ICallContext;
public
procedure BeginCallResponse(Const AProcName,ATarget:string);
procedure EndCallResponse();
procedure BeginCallRead(ACallContext : ICallContext);
function GetCallProcedureName():String;
function GetCallTarget():String;
procedure BeginExceptionList(
const AErrorCode : string;
const AErrorMsg : string
);
procedure EndExceptionList();
End;
procedure Server_service_RegisterXmlRpcFormat();
implementation
{ TXmlRpcFormatter }
procedure TXmlRpcFormatter.BeginCallResponse(Const AProcName,ATarget:string);
var
mthdNode, prmsNode : TDOMNode;
doc : TXMLDocument;
begin
Clear();
doc := Self.GetXmlDoc();
mthdNode := doc.CreateElement(sMETHOD_RESPONSE);
doc.AppendChild(mthdNode);
prmsNode := doc.CreateElement(sPARAMS);
mthdNode.AppendChild(prmsNode);
PushStackParams(prmsNode);
end;
procedure TXmlRpcFormatter.EndCallResponse();
begin
EndScope();
end;
procedure TXmlRpcFormatter.BeginCallRead(ACallContext : ICallContext);
var
callNode : TDOMElement;
tmpNode : TDOMNode;
doc : TXMLDocument;
begin
FCallContext := ACallContext;
ClearStack();
doc := GetXmlDoc();
callNode := doc.DocumentElement;
if not SameText(sMETHOD_CALL,callNode.NodeName) then
Error('XML root node must be "%s".',[sMETHOD_CALL]);
tmpNode := callNode.FindNode(sMETHOD_NAME);
if not Assigned(tmpNode) then
Error('Node not found : "%s".',[sMETHOD_NAME]);
if not tmpNode.HasChildNodes() then
Error('"%s" does not provide value node.',[sMETHOD_NAME]);
FCallProcedureName := Trim(tmpNode.FirstChild.NodeValue);
tmpNode := callNode.FindNode(sPARAMS);
if not Assigned(tmpNode) then
Error('Node not found : "%s".',[sPARAMS]);
PushStackParams(tmpNode);
//FCallTarget := tmpNode.NodeValue;
end;
function TXmlRpcFormatter.GetCallProcedureName(): String;
begin
Result := FCallProcedureName;
end;
function TXmlRpcFormatter.GetCallTarget(): String;
begin
Result := FCallTarget;
end;
procedure TXmlRpcFormatter.BeginExceptionList(
const AErrorCode: string;
const AErrorMsg: string
);
var
c,m : string;
i : Integer;
memberNode, mthdNode, faultNode, structNode,
valueNode, nameNode,
internalValueNode, lastValNode : TDOMNode;
doc : TXMLDocument;
begin
c := Trim(AErrorCode);
if not TryStrToInt(c,i) then
c := '123';
m := AErrorMsg;
Clear();
doc := Self.GetXmlDoc();
mthdNode := doc.CreateElement(sMETHOD_RESPONSE);
doc.AppendChild(mthdNode);
//fault node
faultNode := doc.CreateElement(sFAULT);
mthdNode.AppendChild(faultNode);
// value node
valueNode := doc.CreateElement(sVALUE);
faultNode.AppendChild(valueNode);
// structNode
structNode := doc.CreateElement(XmlRpcDataTypeNames[xdtStruct]);
valueNode.AppendChild(structNode);
//faultCode member node
memberNode := doc.CreateElement(sMEMBER);
structNode.AppendChild(memberNode);
//name node
nameNode := doc.CreateElement(sNAME);
memberNode.AppendChild(nameNode);
nameNode.AppendChild(doc.CreateTextNode(sFAULT_CODE));
//value node
internalValueNode := doc.CreateElement(sVALUE);
memberNode.AppendChild(internalValueNode);
lastValNode := doc.CreateElement(XmlRpcDataTypeNames[xdtInt]);
internalValueNode.AppendChild(lastValNode);
lastValNode.AppendChild(doc.CreateTextNode(c));
//faultString member node
memberNode := doc.CreateElement(sMEMBER);
structNode.AppendChild(memberNode);
//name node
nameNode := doc.CreateElement(sNAME);
memberNode.AppendChild(nameNode);
nameNode.AppendChild(doc.CreateTextNode(sFAULT_STRING));
//value node
internalValueNode := doc.CreateElement(sVALUE);
memberNode.AppendChild(internalValueNode);
lastValNode := doc.CreateElement(XmlRpcDataTypeNames[xdtString]);
internalValueNode.AppendChild(lastValNode);
lastValNode.AppendChild(doc.CreateTextNode(m));
end;
procedure TXmlRpcFormatter.EndExceptionList();
begin
end;
procedure Server_service_RegisterXmlRpcFormat();
begin
GetFormatterRegistry().Register(sPROTOCOL_NAME,sXMLRPC_CONTENT_TYPE,TSimpleItemFactory.Create(TXmlRpcFormatter) as IItemFactory);
end;
end.

3
wst/trunk/soap_formatter.pas
View File

@ -12,7 +12,8 @@
}
unit soap_formatter;
{$mode objfpc}{$H+}
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
interface

10
wst/trunk/synapse_tcp_protocol.pas
View File

@ -21,6 +21,8 @@ uses
{$INCLUDE wst.inc}
{$DEFINE WST_DBG}
Const
sTRANSPORT_NAME = 'TCP';
@ -88,9 +90,6 @@ Var
strBuff : string;
bufferLen : LongInt;
i, j, c : PtrInt;
{$IFDEF WST_DBG}
s : string;
{$ENDIF WST_DBG}
begin
buffStream := TMemoryStream.Create();
Try
@ -130,10 +129,7 @@ begin
end;
AResponse.Position := 0;
{$IFDEF WST_DBG}
i := AResponse.Position;
SetLength(s,AResponse.Size);
AResponse.Read(s[1],AResponse.Size);
WriteLn(s);
TMemoryStream(AResponse).SaveToFile('response.log');
{$ENDIF WST_DBG}
Finally
buffStream.Free();

2
wst/trunk/synapse_tcp_server.pas
View File

@ -185,7 +185,7 @@ begin
rdr := CreateBinaryReader(FInputStream);
trgt := rdr.ReadStr();
ctntyp := rdr.ReadStr();
buff := rdr.ReadStr();
buff := rdr.ReadStr(); WriteLn();WriteLn('ContentType=',ctntyp,', ','Target = ',trgt);WriteLn();WriteLn(buff);
rdr := nil;
FInputStream.Size := 0;
FInputStream.Write(buff[1],Length(buff));

243
wst/trunk/xmlrpc_formatter.pas Normal file
View File

@ -0,0 +1,243 @@
{
This file is part of the Web Service Toolkit
Copyright (c) 2006 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.
}
unit xmlrpc_formatter;
interface
uses
Classes, SysUtils, TypInfo, DOM,
base_service_intf, service_intf, imp_utils, base_xmlrpc_formatter;
{$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
type
{ TXmlRpcFormatter }
{$M+}
TXmlRpcFormatter = class(TXmlRpcBaseFormatter,IFormatterClient)
private
FPropMngr : IPropertyManager;
FCallProcedureName : string;
FCallTarget : String;
public
destructor Destroy();override;
function GetPropertyManager():IPropertyManager;
procedure BeginCall(
const AProcName,
ATarget : string;
ACallContext : ICallContext
);
procedure EndCall();
procedure BeginCallRead(ACallContext : ICallContext);
function GetCallProcedureName():String;
function GetCallTarget():String;
end;
{ TXmlRpcCallMaker }
TXmlRpcCallMaker = class(TSimpleFactoryItem,ICallMaker)
private
FPropMngr : IPropertyManager;
FUniqueAddress: Boolean;
public
constructor Create();override;
destructor Destroy();override;
function GetPropertyManager():IPropertyManager;
procedure MakeCall(
ASerializer : IFormatterClient;
ATransport : ITransport
);
published
property UniqueAddress : Boolean read FUniqueAddress Write FUniqueAddress;
end;
{$M-}
implementation
{ TXmlRpcFormatter }
destructor TXmlRpcFormatter.Destroy();
begin
FPropMngr := nil;
inherited Destroy();
end;
function TXmlRpcFormatter.GetPropertyManager(): IPropertyManager;
begin
If Not Assigned(FPropMngr) Then
FPropMngr := TPublishedPropertyManager.Create(Self);
Result := FPropMngr;
end;
procedure TXmlRpcFormatter.BeginCall(
const AProcName,
ATarget : string;
ACallContext : ICallContext
);
var
mthdNode, mthNameNode, prmsNode : TDOMNode;
doc : TXMLDocument;
begin
Clear();
doc := Self.GetXmlDoc();
FCallTarget := ATarget;
FCallProcedureName := AProcName;
// methodCall
mthdNode := doc.CreateElement(sMETHOD_CALL);
doc.AppendChild(mthdNode);
//methodName
mthNameNode := doc.CreateElement(sMETHOD_NAME);
mthdNode.AppendChild(mthNameNode);
mthNameNode.AppendChild(doc.CreateTextNode(FCallProcedureName));
//params
prmsNode := doc.CreateElement(sPARAMS);
mthdNode.AppendChild(prmsNode);
PushStackParams(prmsNode);
end;
procedure TXmlRpcFormatter.EndCall();
begin
EndScope();
end;
procedure TXmlRpcFormatter.BeginCallRead(ACallContext : ICallContext);
var
callNode : TDOMElement;
prmsNode, faultNode, tmpNode : TDOMNode;
doc : TXMLDocument;
errCode : Integer;
eltName, errMsg : string;
excpt_Obj : EXmlRpcException;
begin
ClearStack();
doc := GetXmlDoc();
callNode := doc.DocumentElement;
if not SameText(sMETHOD_RESPONSE,callNode.NodeName) then
Error('XML root node must be "%s".',[sMETHOD_RESPONSE]);
prmsNode := callNode.FindNode(sPARAMS);
if ( prmsNode <> nil ) then begin
PushStackParams(prmsNode);
end else begin
faultNode := callNode.FindNode(sFAULT);
if ( faultNode = nil ) then begin
raise EServiceException.CreateFmt('Invalid XmlRPC response message, "%s" or "%s" are not present.',[sPARAMS,sFAULT]);
end;
tmpNode := faultNode.FindNode(sVALUE);
if ( tmpNode = nil ) then begin
raise EServiceException.CreateFmt('Invalid XmlRPC fault response message, "%s" is not present.',[sVALUE]);
end;
tmpNode := tmpNode.FindNode(XmlRpcDataTypeNames[xdtStruct]);
if ( tmpNode = nil ) then begin
raise EServiceException.CreateFmt('Invalid XmlRPC fault response message, "%s" is not present.',[XmlRpcDataTypeNames[xdtStruct]]);
end;
PushStack(tmpNode);
eltName := sFAULT_CODE;
errCode := 0;
Get(TypeInfo(Integer),eltName,errCode) ;
eltName := sFAULT_STRING;
errMsg := '';
Get(TypeInfo(string),eltName,errMsg);
excpt_Obj := EXmlRpcException.Create('');
excpt_Obj.FaultCode := IntToStr(errCode);
excpt_Obj.FaultString := errMsg; ;
excpt_Obj.Message := Format(
'Service exception :%s Code = "%s"%s Message = "%s"',
[LineEnding,excpt_Obj.FaultCode,LineEnding,excpt_Obj.FaultString]
);
raise excpt_Obj;
end;
end;
function TXmlRpcFormatter.GetCallProcedureName(): String;
begin
Result := FCallProcedureName;
end;
function TXmlRpcFormatter.GetCallTarget(): String;
begin
Result := FCallTarget;
end;
{ TXmlRpcCallMaker }
constructor TXmlRpcCallMaker.Create();
begin
FUniqueAddress := True;
FPropMngr := TPublishedPropertyManager.Create(Self);
end;
destructor TXmlRpcCallMaker.Destroy();
begin
FPropMngr := Nil;
inherited Destroy();
end;
function TXmlRpcCallMaker.GetPropertyManager(): IPropertyManager;
begin
Result := FPropMngr;
end;
procedure TXmlRpcCallMaker.MakeCall(
ASerializer : IFormatterClient;
ATransport : ITransport
);
var
rqt, rsps : TMemoryStream;
begin
Assert(Assigned(ASerializer));
Assert(Assigned(ATransport));
ATransport.GetPropertyManager().SetProperty(
sCONTENT_TYPE,
ASerializer.GetPropertyManager().GetProperty(sCONTENT_TYPE)
);
rsps := nil;
rqt := TMemoryStream.Create();
try
rsps := TMemoryStream.Create();
ASerializer.SaveToStream(rqt);
rqt.Position := 0;
ATransport.SendAndReceive(rqt,rsps);
rqt.Clear();
rsps.Position := 0;
ASerializer.Clear();
ASerializer.LoadFromStream(rsps);
finally
rsps.Free();
rqt.Free();
end;
end;
procedure RegisterXmlRpcProtocol();
begin
RegisterStdTypes();
GetFormaterRegistry().Register(
sPROTOCOL_NAME,
TSimpleItemFactory.Create(TXmlRpcFormatter) as IItemFactory,
TSimpleItemFactory.Create(TXmlRpcCallMaker) as IItemFactory
);
end;
Initialization
RegisterXmlRpcProtocol();
end.