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

2
wst/trunk/base_soap_formatter.pas
View File

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

42
wst/trunk/base_xmlrpc_formatter.pas
View File

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

1
wst/trunk/binary_formatter.pas
View File

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

2
wst/trunk/library_server_intf.pas
View File

@ -89,7 +89,7 @@ begin
inStream.Write(buff[1],Length(buff)); inStream.Write(buff[1],Length(buff));
SetLength(buff,0); SetLength(buff,0);
inStream.Position := 0; inStream.Position := 0;
rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream); rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream,'');
HandleServiceRequest(rqst); HandleServiceRequest(rqst);
bs := bufStream.Size; bs := bufStream.Size;
wstCheck(ARequestBuffer.SetSize(bs)); 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)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="7"> <Units Count="14">
<Unit0> <Unit0>
<Filename Value="mod_wst.lpr"/> <Filename Value="mod_wst.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="mod_wst"/> <UnitName Value="mod_wst"/>
<CursorPos X="1" Y="52"/> <CursorPos X="3" Y="11"/>
<TopLine Value="25"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="33"/> <UsageCount Value="36"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="wst_apache_binding.pas"/> <Filename Value="wst_apache_binding.pas"/>
<UnitName Value="wst_apache_binding"/> <UnitName Value="wst_apache_binding"/>
<CursorPos X="46" Y="15"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="249"/>
<EditorIndex Value="1"/> <EditorIndex Value="4"/>
<UsageCount Value="16"/> <UsageCount Value="18"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
@ -49,8 +49,8 @@
<UnitName Value="metadata_wsdl"/> <UnitName Value="metadata_wsdl"/>
<CursorPos X="70" Y="30"/> <CursorPos X="70" Y="30"/>
<TopLine Value="16"/> <TopLine Value="16"/>
<EditorIndex Value="2"/> <EditorIndex Value="8"/>
<UsageCount Value="16"/> <UsageCount Value="18"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
@ -58,8 +58,8 @@
<UnitName Value="user_service_intf_imp"/> <UnitName Value="user_service_intf_imp"/>
<CursorPos X="71" Y="20"/> <CursorPos X="71" Y="20"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="3"/> <EditorIndex Value="9"/>
<UsageCount Value="16"/> <UsageCount Value="18"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
@ -82,68 +82,67 @@
<TopLine Value="61"/> <TopLine Value="61"/>
<UsageCount Value="9"/> <UsageCount Value="9"/>
</Unit6> </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> </Units>
<JumpHistory Count="15" HistoryIndex="14"> <JumpHistory Count="1" HistoryIndex="0">
<Position1> <Position1>
<Filename Value="mod_wst.lpr"/> <Filename Value="mod_wst.lpr"/>
<Caret Line="5" Column="1" TopLine="1"/> <Caret Line="39" Column="14" TopLine="23"/>
</Position1> </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> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -153,13 +152,17 @@
<Filename Value="mod_wst.so"/> <Filename Value="mod_wst.so"/>
</Target> </Target>
<SearchPaths> <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"/> <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> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging>
<UseLineInfoUnit Value="False"/>
</Debugging>
<Options> <Options>
<ExecutableType Value="Library"/> <ExecutableType Value="Library"/>
</Options> </Options>

4
wst/trunk/samples/apache_module/mod_wst.lpr
View File

@ -23,7 +23,7 @@ exports
{$endif} {$endif}
function DefaultHandler(r: Prequest_rec): Integer; cdecl; function DefaultHandler(r: Prequest_rec): Integer;cdecl;
begin begin
if not SameText(r^.handler, 'wst-handler') then if not SameText(r^.handler, 'wst-handler') then
begin begin
@ -34,7 +34,7 @@ begin
Result := wst_RequestHandler(r); Result := wst_RequestHandler(r);
end; end;
procedure RegisterHooks(p: Papr_pool_t); cdecl; procedure RegisterHooks(p: Papr_pool_t);cdecl;
begin begin
ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE); ap_hook_handler(@DefaultHandler, nil, nil, APR_HOOK_MIDDLE);
end; end;

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

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

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

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

@ -12,7 +12,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/> <ActiveEditorIndexAtStart Value="5"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
@ -34,40 +34,42 @@
<PackageName Value="indylaz"/> <PackageName Value="indylaz"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="9"> <Units Count="21">
<Unit0> <Unit0>
<Filename Value="http_server.pas"/> <Filename Value="http_server.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="http_server"/> <UnitName Value="http_server"/>
<CursorPos X="12" Y="13"/> <CursorPos X="19" Y="14"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="22"/> <UsageCount Value="30"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="app_object.pas"/> <Filename Value="app_object.pas"/>
<UnitName Value="app_object"/> <UnitName Value="app_object"/>
<CursorPos X="34" Y="65"/> <CursorPos X="17" Y="217"/>
<TopLine Value="51"/> <TopLine Value="196"/>
<EditorIndex Value="1"/> <EditorIndex Value="1"/>
<UsageCount Value="11"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="..\..\base_service_intf.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/> <UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="4149"/> <CursorPos X="64" Y="102"/>
<TopLine Value="4122"/> <TopLine Value="85"/>
<UsageCount Value="10"/> <EditorIndex Value="11"/>
<UsageCount Value="14"/>
<Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="..\..\metadata_wsdl.pas"/> <Filename Value="..\..\metadata_wsdl.pas"/>
<UnitName Value="metadata_wsdl"/> <UnitName Value="metadata_wsdl"/>
<CursorPos X="56" Y="308"/> <CursorPos X="56" Y="308"/>
<TopLine Value="296"/> <TopLine Value="296"/>
<EditorIndex Value="2"/> <EditorIndex Value="12"/>
<UsageCount Value="11"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
@ -75,56 +77,260 @@
<UnitName Value="metadata_service_imp"/> <UnitName Value="metadata_service_imp"/>
<CursorPos X="73" Y="68"/> <CursorPos X="73" Y="68"/>
<TopLine Value="54"/> <TopLine Value="54"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="..\user_service_intf_imp.pas"/> <Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/> <UnitName Value="user_service_intf_imp"/>
<CursorPos X="53" Y="39"/> <CursorPos X="1" Y="178"/>
<TopLine Value="34"/> <TopLine Value="160"/>
<UsageCount Value="10"/> <EditorIndex Value="9"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="..\user_service_intf_binder.pas"/> <Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/> <UnitName Value="user_service_intf_binder"/>
<CursorPos X="69" Y="11"/> <CursorPos X="69" Y="11"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="..\user_service_intf.pas"/> <Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/> <UnitName Value="user_service_intf"/>
<CursorPos X="59" Y="65"/> <CursorPos X="3" Y="87"/>
<TopLine Value="46"/> <TopLine Value="158"/>
<UsageCount Value="10"/> <EditorIndex Value="4"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="..\..\metadata_repository.pas"/> <Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/> <UnitName Value="metadata_repository"/>
<CursorPos X="5" Y="45"/> <CursorPos X="5" Y="45"/>
<TopLine Value="99"/> <TopLine Value="99"/>
<EditorIndex Value="3"/> <EditorIndex Value="13"/>
<UsageCount Value="11"/> <UsageCount Value="15"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit8> </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> </Units>
<JumpHistory Count="4" HistoryIndex="3"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="http_server.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="10" Column="10" TopLine="1"/> <Caret Line="2020" Column="1" TopLine="2004"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="app_object.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="65" Column="34" TopLine="51"/> <Caret Line="1" Column="1" TopLine="1"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="..\..\metadata_wsdl.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="324" Column="51" TopLine="296"/> <Caret Line="1188" Column="13" TopLine="1173"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="http_server.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<Caret Line="10" Column="10" TopLine="1"/> <Caret Line="1272" Column="15" TopLine="1243"/>
</Position4> </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> </JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
@ -137,6 +343,11 @@
<OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\"/> <OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\"/>
<UnitOutputDirectory Value="obj"/> <UnitOutputDirectory Value="obj"/>
</SearchPaths> </SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
@ -145,7 +356,7 @@
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<BreakPoints Count="5"> <BreakPoints Count="4">
<Item1> <Item1>
<Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/> <Line Value="230"/>
@ -162,10 +373,6 @@
<Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/> <Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/> <Line Value="606"/>
</Item4> </Item4>
<Item5>
<Source Value="..\user_service_intf_imp.pas"/>
<Line Value="176"/>
</Item5>
</BreakPoints> </BreakPoints>
<Watches Count="2"> <Watches Count="2">
<Item1> <Item1>

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

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

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

@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="/"/> <PathDelim Value="\"/>
<Version Value="5"/> <Version Value="5"/>
<General> <General>
<Flags> <Flags>
@ -10,15 +10,16 @@
<MainUnitHasTitleStatement Value="False"/> <MainUnitHasTitleStatement Value="False"/>
</Flags> </Flags>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value=".\"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="2"/> <ActiveEditorIndexAtStart Value="10"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/> <IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -26,18 +27,18 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <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> </local>
</RunParams> </RunParams>
<Units Count="37"> <Units Count="47">
<Unit0> <Unit0>
<Filename Value="tcp_server.pas"/> <Filename Value="tcp_server.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tcp_server"/> <UnitName Value="tcp_server"/>
<CursorPos X="51" Y="21"/> <CursorPos X="1" Y="56"/>
<TopLine Value="27"/> <TopLine Value="30"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="68"/> <UsageCount Value="79"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
@ -45,222 +46,226 @@
<UnitName Value="synapse_tcp_server"/> <UnitName Value="synapse_tcp_server"/>
<CursorPos X="42" Y="211"/> <CursorPos X="42" Y="211"/>
<TopLine Value="197"/> <TopLine Value="197"/>
<UsageCount Value="65"/> <UsageCount Value="64"/>
</Unit1> </Unit1>
<Unit2> <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"/> <CursorPos X="26" Y="686"/>
<TopLine Value="672"/> <TopLine Value="672"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit2> </Unit2>
<Unit3> <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"/> <CursorPos X="3" Y="25"/>
<TopLine Value="4"/> <TopLine Value="4"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="../../../../../lazarus23_213/others_package/synapse/blcksock.pas"/> <Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/> <UnitName Value="blcksock"/>
<CursorPos X="1" Y="2407"/> <CursorPos X="1" Y="2407"/>
<TopLine Value="2395"/> <TopLine Value="2395"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="../../binary_streamer.pas"/> <Filename Value="..\..\binary_streamer.pas"/>
<UnitName Value="binary_streamer"/> <UnitName Value="binary_streamer"/>
<CursorPos X="37" Y="13"/> <CursorPos X="37" Y="13"/>
<TopLine Value="178"/> <TopLine Value="178"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="../../server_service_soap.pas"/> <Filename Value="..\..\server_service_soap.pas"/>
<UnitName Value="server_service_soap"/> <UnitName Value="server_service_soap"/>
<CursorPos X="35" Y="29"/> <CursorPos X="53" Y="177"/>
<TopLine Value="8"/> <TopLine Value="157"/>
<UsageCount Value="22"/> <EditorIndex Value="2"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="../../server_binary_formatter.pas"/> <Filename Value="..\..\server_binary_formatter.pas"/>
<UnitName Value="server_binary_formatter"/> <UnitName Value="server_binary_formatter"/>
<CursorPos X="24" Y="22"/> <CursorPos X="24" Y="22"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit7> </Unit7>
<Unit8> <Unit8>
<Filename Value="../../metadata_service.pas"/> <Filename Value="..\..\metadata_service.pas"/>
<UnitName Value="metadata_service"/> <UnitName Value="metadata_service"/>
<CursorPos X="96" Y="118"/> <CursorPos X="11" Y="121"/>
<TopLine Value="103"/> <TopLine Value="99"/>
<UsageCount Value="8"/> <UsageCount Value="12"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
<Filename Value="../../metadata_service_imp.pas"/> <Filename Value="..\..\metadata_service_imp.pas"/>
<UnitName Value="metadata_service_imp"/> <UnitName Value="metadata_service_imp"/>
<CursorPos X="1" Y="39"/> <CursorPos X="58" Y="121"/>
<TopLine Value="28"/> <TopLine Value="1"/>
<UsageCount Value="8"/> <UsageCount Value="14"/>
</Unit9> </Unit9>
<Unit10> <Unit10>
<Filename Value="../../metadata_service_binder.pas"/> <Filename Value="..\..\metadata_service_binder.pas"/>
<UnitName Value="metadata_service_binder"/> <UnitName Value="metadata_service_binder"/>
<CursorPos X="69" Y="11"/> <CursorPos X="47" Y="16"/>
<TopLine Value="9"/> <TopLine Value="1"/>
<UsageCount Value="8"/> <UsageCount Value="12"/>
</Unit10> </Unit10>
<Unit11> <Unit11>
<Filename Value="../user_service_intf.pas"/> <Filename Value="..\user_service_intf.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="user_service_intf"/> <UnitName Value="user_service_intf"/>
<CursorPos X="14" Y="48"/> <CursorPos X="3" Y="27"/>
<TopLine Value="55"/> <TopLine Value="5"/>
<EditorIndex Value="4"/> <EditorIndex Value="9"/>
<UsageCount Value="68"/> <UsageCount Value="79"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit11> </Unit11>
<Unit12> <Unit12>
<Filename Value="../../base_service_intf.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/> <UnitName Value="base_service_intf"/>
<CursorPos X="1" Y="4148"/> <CursorPos X="15" Y="307"/>
<TopLine Value="4118"/> <TopLine Value="293"/>
<EditorIndex Value="1"/> <EditorIndex Value="5"/>
<UsageCount Value="24"/> <UsageCount Value="29"/>
<Bookmarks Count="1"> <Bookmarks Count="1">
<Item0 X="19" Y="545" ID="0"/> <Item0 X="19" Y="545" ID="0"/>
</Bookmarks> </Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="../../wst_rtti_filter/std_cursors.pas"/> <Filename Value="..\..\wst_rtti_filter\std_cursors.pas"/>
<UnitName Value="std_cursors"/> <UnitName Value="std_cursors"/>
<CursorPos X="1" Y="48"/> <CursorPos X="14" Y="21"/>
<TopLine Value="36"/> <TopLine Value="7"/>
<EditorIndex Value="6"/> <EditorIndex Value="12"/>
<UsageCount Value="33"/> <UsageCount Value="34"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="../../wst_rtti_filter/cursor_intf.pas"/> <Filename Value="..\..\wst_rtti_filter\cursor_intf.pas"/>
<UnitName Value="cursor_intf"/> <UnitName Value="cursor_intf"/>
<CursorPos X="3" Y="27"/> <CursorPos X="3" Y="27"/>
<TopLine Value="15"/> <TopLine Value="15"/>
<UsageCount Value="24"/> <UsageCount Value="23"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="../user_service_intf_binder.pas"/> <Filename Value="..\user_service_intf_binder.pas"/>
<UnitName Value="user_service_intf_binder"/> <UnitName Value="user_service_intf_binder"/>
<CursorPos X="30" Y="7"/> <CursorPos X="48" Y="34"/>
<TopLine Value="1"/> <TopLine Value="11"/>
<EditorIndex Value="3"/> <EditorIndex Value="8"/>
<UsageCount Value="34"/> <UsageCount Value="37"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="../user_service_intf.wst"/> <Filename Value="..\user_service_intf.wst"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
<SyntaxHighlighter Value="None"/> <SyntaxHighlighter Value="None"/>
</Unit16> </Unit16>
<Unit17> <Unit17>
<Filename Value="../../metadata_repository.pas"/> <Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/> <UnitName Value="metadata_repository"/>
<CursorPos X="37" Y="571"/> <CursorPos X="37" Y="571"/>
<TopLine Value="562"/> <TopLine Value="562"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
</Unit17> </Unit17>
<Unit18> <Unit18>
<Filename Value="../../wst_resources_imp.pas"/> <Filename Value="..\..\wst_resources_imp.pas"/>
<UnitName Value="wst_resources_imp"/> <UnitName Value="wst_resources_imp"/>
<CursorPos X="15" Y="63"/> <CursorPos X="15" Y="63"/>
<TopLine Value="45"/> <TopLine Value="45"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
</Unit18> </Unit18>
<Unit19> <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"/> <CursorPos X="3" Y="95"/>
<TopLine Value="73"/> <TopLine Value="73"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit19> </Unit19>
<Unit20> <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"/> <CursorPos X="1" Y="36"/>
<TopLine Value="16"/> <TopLine Value="16"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit20> </Unit20>
<Unit21> <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"/> <CursorPos X="1" Y="76"/>
<TopLine Value="64"/> <TopLine Value="64"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit21> </Unit21>
<Unit22> <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"/> <CursorPos X="1" Y="264"/>
<TopLine Value="252"/> <TopLine Value="252"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit22> </Unit22>
<Unit23> <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"/> <CursorPos X="1" Y="381"/>
<TopLine Value="369"/> <TopLine Value="369"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit23> </Unit23>
<Unit24> <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"/> <CursorPos X="1" Y="674"/>
<TopLine Value="662"/> <TopLine Value="662"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit24> </Unit24>
<Unit25> <Unit25>
<Filename Value="../../server_service_intf.pas"/> <Filename Value="..\..\server_service_intf.pas"/>
<UnitName Value="server_service_intf"/> <UnitName Value="server_service_intf"/>
<CursorPos X="16" Y="346"/> <CursorPos X="1" Y="356"/>
<TopLine Value="323"/> <TopLine Value="342"/>
<UsageCount Value="8"/> <EditorIndex Value="7"/>
<UsageCount Value="15"/>
<Loaded Value="True"/>
</Unit25> </Unit25>
<Unit26> <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"/> <CursorPos X="1" Y="1125"/>
<TopLine Value="1113"/> <TopLine Value="1113"/>
<UsageCount Value="6"/> <UsageCount Value="5"/>
</Unit26> </Unit26>
<Unit27> <Unit27>
<Filename Value="../user_service_intf_imp.pas"/> <Filename Value="..\user_service_intf_imp.pas"/>
<UnitName Value="user_service_intf_imp"/> <UnitName Value="user_service_intf_imp"/>
<CursorPos X="25" Y="13"/> <CursorPos X="1" Y="63"/>
<TopLine Value="1"/> <TopLine Value="107"/>
<EditorIndex Value="5"/> <EditorIndex Value="10"/>
<UsageCount Value="34"/> <UsageCount Value="39"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit27> </Unit27>
<Unit28> <Unit28>
<Filename Value="../../service_intf.pas"/> <Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/> <UnitName Value="service_intf"/>
<CursorPos X="15" Y="23"/> <CursorPos X="15" Y="23"/>
<TopLine Value="19"/> <TopLine Value="19"/>
<UsageCount Value="7"/> <UsageCount Value="6"/>
</Unit28> </Unit28>
<Unit29> <Unit29>
<Filename Value="../../base_soap_formatter.pas"/> <Filename Value="..\..\base_soap_formatter.pas"/>
<UnitName Value="base_soap_formatter"/> <UnitName Value="base_soap_formatter"/>
<CursorPos X="65" Y="313"/> <CursorPos X="65" Y="313"/>
<TopLine Value="304"/> <TopLine Value="304"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit29> </Unit29>
<Unit30> <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"/> <UnitName Value="typinfo"/>
<CursorPos X="11" Y="247"/> <CursorPos X="11" Y="247"/>
<TopLine Value="226"/> <TopLine Value="226"/>
<UsageCount Value="8"/> <UsageCount Value="7"/>
</Unit30> </Unit30>
<Unit31> <Unit31>
<Filename Value="../../base_binary_formatter.pas"/> <Filename Value="..\..\base_binary_formatter.pas"/>
<UnitName Value="base_binary_formatter"/> <UnitName Value="base_binary_formatter"/>
<CursorPos X="3" Y="1063"/> <CursorPos X="3" Y="1063"/>
<TopLine Value="1055"/> <TopLine Value="1055"/>
<UsageCount Value="10"/> <UsageCount Value="9"/>
</Unit31> </Unit31>
<Unit32> <Unit32>
<Filename Value="imp_helper.pas"/> <Filename Value="imp_helper.pas"/>
@ -268,49 +273,251 @@
<UnitName Value="imp_helper"/> <UnitName Value="imp_helper"/>
<CursorPos X="1" Y="44"/> <CursorPos X="1" Y="44"/>
<TopLine Value="32"/> <TopLine Value="32"/>
<UsageCount Value="37"/> <UsageCount Value="48"/>
</Unit32> </Unit32>
<Unit33> <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"/> <CursorPos X="3" Y="36"/>
<TopLine Value="32"/> <TopLine Value="32"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit33> </Unit33>
<Unit34> <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"/> <CursorPos X="43" Y="511"/>
<TopLine Value="506"/> <TopLine Value="506"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit34> </Unit34>
<Unit35> <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"/> <UnitName Value="sysutils"/>
<CursorPos X="1" Y="326"/> <CursorPos X="1" Y="326"/>
<TopLine Value="314"/> <TopLine Value="314"/>
<UsageCount Value="9"/> <UsageCount Value="8"/>
</Unit35> </Unit35>
<Unit36> <Unit36>
<Filename Value="../../synapse_tcp_server.pas"/> <Filename Value="..\..\synapse_tcp_server.pas"/>
<UnitName Value="synapse_tcp_server"/> <UnitName Value="synapse_tcp_server"/>
<CursorPos X="34" Y="240"/> <CursorPos X="1" Y="209"/>
<TopLine Value="231"/> <TopLine Value="26"/>
<EditorIndex Value="2"/> <EditorIndex Value="6"/>
<UsageCount Value="12"/> <UsageCount Value="17"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit36> </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> </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> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>
<PathDelim Value="\"/>
<Target> <Target>
<Filename Value="tcp_server.exe"/> <Filename Value="tcp_server.exe"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<IncludeFiles Value="../../"/> <IncludeFiles Value="..\..\;..\"/>
<OtherUnitFiles Value="../;../../;../../wst_rtti_filter/;$(LazarusDir)/others_package/synapse/"/> <OtherUnitFiles Value="..\;..\..\;..\..\wst_rtti_filter\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/> <UnitOutputDirectory Value="obj"/>
</SearchPaths> </SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
<UseAnsiStrings Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
</CodeGeneration> </CodeGeneration>
@ -319,27 +526,39 @@
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<BreakPoints Count="5"> <BreakPoints Count="8">
<Item1> <Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/> <Line Value="230"/>
</Item1> </Item1>
<Item2> <Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/> <Line Value="193"/>
</Item2> </Item2>
<Item3> <Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/> <Line Value="198"/>
</Item3> </Item3>
<Item4> <Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/> <Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/> <Line Value="606"/>
</Item4> </Item4>
<Item5> <Item5>
<Source Value="../user_service_intf_imp.pas"/> <Source Value="..\user_service_intf_imp.pas"/>
<Line Value="176"/> <Line Value="89"/>
</Item5> </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> </BreakPoints>
<Watches Count="2"> <Watches Count="2">
<Item1> <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, metadata_service, metadata_service_imp, metadata_service_binder,
synapse_tcp_server, 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 var
@ -38,12 +39,15 @@ begin
SetLogger(TConsoleLogger.Create()); SetLogger(TConsoleLogger.Create());
Server_service_RegisterBinaryFormat(); Server_service_RegisterBinaryFormat();
Server_service_RegisterSoapFormat(); //Server_service_RegisterSoapFormat();
Server_service_RegisterWSTMetadataServiceService(); Server_service_RegisterXmlRpcFormat();
RegisterWSTMetadataServiceImplementationFactory();
//Server_service_RegisterWSTMetadataServiceService();
RegisterWSTMetadataServiceImplementationFactory(); RegisterWSTMetadataServiceImplementationFactory();
Server_service_RegisterUserServiceService();
RegisterUserServiceImplementationFactory(); RegisterUserServiceImplementationFactory();
Server_service_RegisterUserServiceService();
Logger().Log('WST sample TCP Server listning on "%s"',[sSERVER_PORT]); Logger().Log('WST sample TCP Server listning on "%s"',[sSERVER_PORT]);
Logger().Log('Hit <enter> to stop.'); 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"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="/"/> <PathDelim Value="\"/>
<Version Value="5"/> <Version Value="5"/>
<General> <General>
<Flags> <Flags>
@ -10,15 +10,16 @@
<MainUnitHasTitleStatement Value="False"/> <MainUnitHasTitleStatement Value="False"/>
</Flags> </Flags>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value=".\"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="1"/> <ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/> <IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -26,165 +27,249 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <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> </local>
</RunParams> </RunParams>
<Units Count="19"> <Units Count="30">
<Unit0> <Unit0>
<Filename Value="user_client_console.pas"/> <Filename Value="user_client_console.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="user_client_console"/> <UnitName Value="user_client_console"/>
<CursorPos X="12" Y="14"/> <CursorPos X="40" Y="150"/>
<TopLine Value="16"/> <TopLine Value="133"/>
<EditorIndex Value="0"/> <EditorIndex Value="0"/>
<UsageCount Value="34"/> <UsageCount Value="50"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="../user_service_intf_proxy.pas"/> <Filename Value="..\user_service_intf_proxy.pas"/>
<UnitName Value="user_service_intf_proxy"/> <UnitName Value="user_service_intf_proxy"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="68"/>
<TopLine Value="1"/> <TopLine Value="54"/>
<EditorIndex Value="5"/> <EditorIndex Value="6"/>
<UsageCount Value="17"/> <UsageCount Value="23"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="../../synapse_tcp_protocol.pas"/> <Filename Value="..\..\synapse_tcp_protocol.pas"/>
<UnitName Value="synapse_tcp_protocol"/> <UnitName Value="synapse_tcp_protocol"/>
<CursorPos X="1" Y="1"/> <CursorPos X="29" Y="132"/>
<TopLine Value="1"/> <TopLine Value="101"/>
<EditorIndex Value="8"/> <EditorIndex Value="9"/>
<UsageCount Value="17"/> <UsageCount Value="25"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="../../service_intf.pas"/> <Filename Value="..\..\service_intf.pas"/>
<UnitName Value="service_intf"/> <UnitName Value="service_intf"/>
<CursorPos X="1" Y="1"/> <CursorPos X="3" Y="31"/>
<TopLine Value="1"/> <TopLine Value="9"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<UsageCount Value="17"/> <UsageCount Value="25"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit3>
<Unit4> <Unit4>
<Filename Value="../user_service_intf.pas"/> <Filename Value="..\user_service_intf.pas"/>
<UnitName Value="user_service_intf"/> <UnitName Value="user_service_intf"/>
<CursorPos X="1" Y="1"/> <CursorPos X="3" Y="3"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="7"/> <EditorIndex Value="1"/>
<UsageCount Value="17"/> <UsageCount Value="22"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="../../../../../lazarus23_213/others_package/synapse/blcksock.pas"/> <Filename Value="..\..\..\..\..\lazarus23_213\others_package\synapse\blcksock.pas"/>
<UnitName Value="blcksock"/> <UnitName Value="blcksock"/>
<CursorPos X="60" Y="2413"/> <CursorPos X="60" Y="2413"/>
<TopLine Value="2393"/> <TopLine Value="2393"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit5> </Unit5>
<Unit6> <Unit6>
<Filename Value="../../base_service_intf.pas"/> <Filename Value="..\..\base_service_intf.pas"/>
<UnitName Value="base_service_intf"/> <UnitName Value="base_service_intf"/>
<CursorPos X="52" Y="4135"/> <CursorPos X="1" Y="1"/>
<TopLine Value="4000"/> <TopLine Value="1"/>
<EditorIndex Value="3"/> <EditorIndex Value="3"/>
<UsageCount Value="17"/> <UsageCount Value="25"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="../../library_protocol.pas"/> <Filename Value="..\..\library_protocol.pas"/>
<UnitName Value="library_protocol"/> <UnitName Value="library_protocol"/>
<CursorPos X="18" Y="5"/> <CursorPos X="18" Y="5"/>
<TopLine Value="26"/> <TopLine Value="26"/>
<EditorIndex Value="1"/> <UsageCount Value="15"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit7> </Unit7>
<Unit8> <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"/> <CursorPos X="10" Y="33"/>
<TopLine Value="17"/> <TopLine Value="17"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit8> </Unit8>
<Unit9> <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"/> <CursorPos X="13" Y="112"/>
<TopLine Value="105"/> <TopLine Value="105"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit9> </Unit9>
<Unit10> <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"/> <CursorPos X="33" Y="202"/>
<TopLine Value="188"/> <TopLine Value="188"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit10> </Unit10>
<Unit11> <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"/> <UnitName Value="System"/>
<CursorPos X="20" Y="35"/> <CursorPos X="20" Y="35"/>
<TopLine Value="21"/> <TopLine Value="21"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit11> </Unit11>
<Unit12> <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"/> <CursorPos X="10" Y="86"/>
<TopLine Value="226"/> <TopLine Value="226"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit12> </Unit12>
<Unit13> <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"/> <CursorPos X="54" Y="33"/>
<TopLine Value="19"/> <TopLine Value="19"/>
<UsageCount Value="9"/> <UsageCount Value="7"/>
</Unit13> </Unit13>
<Unit14> <Unit14>
<Filename Value="../../synapse_http_protocol.pas"/> <Filename Value="..\..\synapse_http_protocol.pas"/>
<UnitName Value="synapse_http_protocol"/> <UnitName Value="synapse_http_protocol"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="22"/> <TopLine Value="22"/>
<UsageCount Value="17"/> <UsageCount Value="15"/>
</Unit14> </Unit14>
<Unit15> <Unit15>
<Filename Value="../../metadata_repository.pas"/> <Filename Value="..\..\metadata_repository.pas"/>
<UnitName Value="metadata_repository"/> <UnitName Value="metadata_repository"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="6"/> <UsageCount Value="15"/>
<UsageCount Value="17"/>
<Loaded Value="True"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="../../wst.inc"/> <Filename Value="..\..\wst.inc"/>
<CursorPos X="1" Y="1"/> <CursorPos X="17" Y="15"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<UsageCount Value="12"/> <UsageCount Value="15"/>
</Unit16> </Unit16>
<Unit17> <Unit17>
<Filename Value="../../library_imp_utils.pas"/> <Filename Value="..\..\library_imp_utils.pas"/>
<UnitName Value="library_imp_utils"/> <UnitName Value="library_imp_utils"/>
<CursorPos X="1" Y="1"/> <CursorPos X="1" Y="1"/>
<TopLine Value="1"/> <TopLine Value="1"/>
<EditorIndex Value="2"/> <UsageCount Value="10"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit17> </Unit17>
<Unit18> <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"/> <CursorPos X="17" Y="27"/>
<TopLine Value="13"/> <TopLine Value="13"/>
<UsageCount Value="10"/> <UsageCount Value="8"/>
</Unit18> </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> </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> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>
<PathDelim Value="\"/>
<Target> <Target>
<Filename Value="user_client_console.exe"/> <Filename Value="user_client_console.exe"/>
</Target> </Target>
<SearchPaths> <SearchPaths>
<OtherUnitFiles Value="../;../../;$(LazarusDir)/others_package/synapse/"/> <OtherUnitFiles Value="..\;..\..\;$(LazarusDir)\others_package\synapse\"/>
<UnitOutputDirectory Value="obj"/> <UnitOutputDirectory Value="obj"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
@ -197,19 +282,19 @@
<Debugging> <Debugging>
<BreakPoints Count="4"> <BreakPoints Count="4">
<Item1> <Item1>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="230"/> <Line Value="230"/>
</Item1> </Item1>
<Item2> <Item2>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="193"/> <Line Value="193"/>
</Item2> </Item2>
<Item3> <Item3>
<Source Value="D:/lazarusClean/fpcsrc/rtl/inc/getopts.pp"/> <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
<Line Value="198"/> <Line Value="198"/>
</Item3> </Item3>
<Item4> <Item4>
<Source Value="../../ws_helper/wsdl2pas_imp.pas"/> <Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
<Line Value="606"/> <Line Value="606"/>
</Item4> </Item4>
</BreakPoints> </BreakPoints>

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

@ -7,7 +7,11 @@ uses
user_service_intf_proxy, user_service_intf_proxy,
synapse_tcp_protocol, synapse_http_protocol, library_protocol, synapse_tcp_protocol, synapse_http_protocol, library_protocol,
soap_formatter, binary_formatter, soap_formatter, binary_formatter,
user_service_intf; user_service_intf, xmlrpc_formatter;
type
TUser = TUser_Type;
TUserCategory = TUserCategory_Type;
var var
UserServiceInst : UserService; UserServiceInst : UserService;
@ -56,8 +60,9 @@ begin
end; end;
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 ; function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
begin begin
Result := ''; Result := '';
@ -72,7 +77,7 @@ var
buff : string; buff : string;
begin begin
buff := ''; buff := '';
WriteLn('Adding a user :'); WriteLn(CAPTIONS[AType]);
try try
usr := TUser.Create(); usr := TUser.Create();
try try
@ -84,6 +89,9 @@ begin
usr.Category:= Normal; usr.Category:= Normal;
usr.eMail := ReadItem('Enter user e-mail : ',False); usr.eMail := ReadItem('Enter user e-mail : ',False);
usr.Preferences := ReadItem('Enter user Preferences : ',False); usr.Preferences := ReadItem('Enter user Preferences : ',False);
if ( AType = atUpdate ) then
UserServiceInst.Update(usr)
else
UserServiceInst.Add(usr); UserServiceInst.Add(usr);
finally finally
FreeAndNil(usr); FreeAndNil(usr);
@ -110,28 +118,46 @@ begin
end; end;
end; end;
type TTransportType = ( ttLibrary, ttTCP, ttHTTP ); procedure HandleDeleteUser();
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'
);
var var
buff : string; buff : string;
begin begin
buff := ADDRESS_MAP[ATransportType]; Write('Enter User Name : ');
if ( ATransportType = ttLibrary ) then 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]); buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
UserServiceInst := TUserService_Proxy.Create( UserServiceInst := TUserService_Proxy.Create(
'UserService', 'UserService',
'binary:', FORMAT_MAP[FormatValue] + ':',
buff buff
); );
end; end;
function ReadTransportType():TTransportType; procedure ReadTransportType();
var var
buff : string; buff : string;
begin begin
@ -147,9 +173,34 @@ begin
buff := UpperCase(Trim(buff)); buff := UpperCase(Trim(buff));
if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
case buff[1] of case buff[1] of
'L' : Result := ttLibrary; 'L' : TransportType := ttLibrary;
'T' : Result := ttTCP; 'T' : TransportType := ttTCP;
'H' : Result := ttHTTP; '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; end;
Break; Break;
end; end;
@ -158,18 +209,22 @@ end;
var var
strBuffer : string; strBuffer : string;
tt : TTransportType;
begin begin
SYNAPSE_RegisterTCP_Transport(); SYNAPSE_RegisterTCP_Transport();
SYNAPSE_RegisterHTTP_Transport(); SYNAPSE_RegisterHTTP_Transport();
LIB_Register_Transport(); LIB_Register_Transport();
WriteLn('Sample Application using Web Services Toolkit'); WriteLn('Sample Application using Web Services Toolkit');
CreateProxy(ReadTransportType()); ReadFormatType();
ReadTransportType();
CreateProxy();
WriteLn('Menu :'); WriteLn('Menu :');
WriteLn(' L : Show the user list'); WriteLn(' L : Show the user list');
WriteLn(' A : Add a new user'); WriteLn(' A : Add a new user');
WriteLn(' U : Update a user');
WriteLn(' D : Delete a user');
WriteLn(' F : Find a new'); WriteLn(' F : Find a new');
WriteLn(' C : Change the communication protocol'); WriteLn(' C : Change the communication protocol');
WriteLn(' Z : Change the messaging format');
WriteLn(' X : Exit'); WriteLn(' X : Exit');
WriteLn(); WriteLn();
Write('Choose a item : '); Write('Choose a item : ');
@ -180,9 +235,20 @@ begin
if ( Length(strBuffer) > 0 ) then begin if ( Length(strBuffer) > 0 ) then begin
case strBuffer[1] of case strBuffer[1] of
'L' : HandleShowAll(); 'L' : HandleShowAll();
'A' : HandleAdd(); 'A' : HandleAdd(atAdd);
'U' : HandleAdd(atUpdate);
'D' : HandleDeleteUser();
'F' : HandleFindUser(); 'F' : HandleFindUser();
'C' : CreateProxy(ReadTransportType()); 'C' :
begin
ReadTransportType();
CreateProxy();
end;
'Z' :
begin
ReadFormatType();
CreateProxy();
end;
'X' : Break; 'X' : Break;
end; end;
WriteLn(); WriteLn();

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

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

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

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

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

@ -14,6 +14,7 @@ Uses SysUtils, Classes,
Type Type
TUser = TUser_Type;
{ TUserService_ServiceImp } { 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. This unit has been produced by ws_helper.
Input unit name : "user_service_intf". Input unit name : "user_service_intf".
This unit name : "user_service_intf_proxy". 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; Unit user_service_intf_proxy;
@ -19,16 +19,16 @@ Type
class function GetServiceType() : PTypeInfo;override; class function GetServiceType() : PTypeInfo;override;
function GetList():TUserArray; function GetList():TUserArray;
procedure Add( procedure Add(
Const AUser : TUser const AUser : TUser_Type
); );
procedure Update( procedure Update(
Const AUser : TUser const AUser : TUser_Type
); );
function Find( function Find(
Const AName : string const AName : string
):TUser; ):TUser_Type;
function Delete( function Delete(
Const AName : string const AName : string
):boolean; ):boolean;
End; End;
@ -73,7 +73,7 @@ Begin
End; End;
procedure TUserService_Proxy.Add( procedure TUserService_Proxy.Add(
Const AUser : TUser const AUser : TUser_Type
); );
Var Var
locSerializer : IFormatterClient; locSerializer : IFormatterClient;
@ -82,7 +82,7 @@ Begin
locSerializer := GetSerializer(); locSerializer := GetSerializer();
Try Try
locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext)); locSerializer.BeginCall('Add', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser), AUser); locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall(); locSerializer.EndCall();
MakeCall(); MakeCall();
@ -95,7 +95,7 @@ Begin
End; End;
procedure TUserService_Proxy.Update( procedure TUserService_Proxy.Update(
Const AUser : TUser const AUser : TUser_Type
); );
Var Var
locSerializer : IFormatterClient; locSerializer : IFormatterClient;
@ -104,7 +104,7 @@ Begin
locSerializer := GetSerializer(); locSerializer := GetSerializer();
Try Try
locSerializer.BeginCall('Update', GetTarget(),(Self as ICallContext)); locSerializer.BeginCall('Update', GetTarget(),(Self as ICallContext));
locSerializer.Put('AUser', TypeInfo(TUser), AUser); locSerializer.Put('AUser', TypeInfo(TUser_Type), AUser);
locSerializer.EndCall(); locSerializer.EndCall();
MakeCall(); MakeCall();
@ -117,8 +117,8 @@ Begin
End; End;
function TUserService_Proxy.Find( function TUserService_Proxy.Find(
Const AName : string const AName : string
):TUser; ):TUser_Type;
Var Var
locSerializer : IFormatterClient; locSerializer : IFormatterClient;
strPrmName : string; strPrmName : string;
@ -134,7 +134,7 @@ Begin
locSerializer.BeginCallRead((Self as ICallContext)); locSerializer.BeginCallRead((Self as ICallContext));
TObject(Result) := Nil; TObject(Result) := Nil;
strPrmName := 'result'; strPrmName := 'result';
locSerializer.Get(TypeInfo(TUser), strPrmName, Result); locSerializer.Get(TypeInfo(TUser_Type), strPrmName, Result);
Finally Finally
locSerializer.Clear(); locSerializer.Clear();
@ -142,7 +142,7 @@ Begin
End; End;
function TUserService_Proxy.Delete( function TUserService_Proxy.Delete(
Const AName : string const AName : string
):boolean; ):boolean;
Var Var
locSerializer : IFormatterClient; locSerializer : IFormatterClient;

3
wst/trunk/server_binary_formatter.pas
View File

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

28
wst/trunk/server_service_imputils.pas
View File

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

127
wst/trunk/server_service_intf.pas
View File

@ -45,10 +45,10 @@ Type
['{6BF71D1F-DDC0-4432-83C6-6D50D26762C3}'] ['{6BF71D1F-DDC0-4432-83C6-6D50D26762C3}']
function GetTargetService():string; function GetTargetService():string;
function GetContentType():string; function GetContentType():string;
//function GetLength():Integer;
function GetContent():TStream; function GetContent():TStream;
function GetResponse():TStream; function GetResponse():TStream;
End; function GetFormat() : string;
end;
IServerService = Interface IServerService = Interface
['{EEBF8E24-8B20-462F-AA4A-48A5C8BAE680}'] ['{EEBF8E24-8B20-462F-AA4A-48A5C8BAE680}']
@ -234,12 +234,42 @@ Begin
s.HandleRequest(ARequestBuffer); s.HandleRequest(ARequestBuffer);
End; End;
Type type
TFormatterRegistry = class(TBaseFactoryRegistry,IFormatterRegistry) { TFormatterRegistryItem }
protected
function Find(const AFormatterName : string):IFormatterBase; TFormatterRegistryItem = class(TBaseFactoryRegistryItem)
End; 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 } { TServerServiceRegistry }
@ -248,6 +278,18 @@ Type
function Find(const AServiceName : string):IServerService; function Find(const AServiceName : string):IServerService;
End; End;
{ TBaseFormatterRegistryItem }
constructor TFormatterRegistryItem.Create(
const AName,
AContentType : string;
const AFactory : IItemFactory
);
begin
inherited Create(AName,AFactory);
FContentType := AContentType;
end;
{ TServerServiceRegistry } { TServerServiceRegistry }
function TServerServiceRegistry.Find(const AServiceName: string): IServerService; function TServerServiceRegistry.Find(const AServiceName: string): IServerService;
@ -261,15 +303,73 @@ begin
Result := Nil; Result := Nil;
end; end;
function TFormatterRegistry.Find(const AFormatterName: string): IFormatterBase; function TFormatterRegistry.Find(const AName : string): IFormatterBase;
Var Var
fct : IItemFactory; fct : IItemFactory;
begin begin
fct := FindFactory(AFormatterName); fct := FindFactory(AName);
If Assigned(fct) Then if Assigned(fct) then
Result := fct.CreateInstance() as IFormatterBase Result := fct.CreateInstance() as IFormatterBase
Else else
Result := Nil; 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; end;
Type Type
@ -341,7 +441,10 @@ Var
hdr : THeaderBlock; hdr : THeaderBlock;
typRegItm : TTypeRegistryItem; typRegItm : TTypeRegistryItem;
begin begin
s := Trim(ARequestBuffer.GetFormat());
if ( Length(s) = 0 ) then begin
s := ARequestBuffer.GetContentType(); s := ARequestBuffer.GetContentType();
end;
f := GetFormatterRegistry().Find(s) as IFormatterResponse; f := GetFormatterRegistry().Find(s) as IFormatterResponse;
if not Assigned(f) then if not Assigned(f) then
Error('No formatter for that content type : "%s"',[s]); 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 but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
} }
unit server_service_soap;
{$INCLUDE wst.inc} {$INCLUDE wst.inc}
unit server_service_soap;
interface interface
@ -194,7 +193,7 @@ end;
procedure Server_service_RegisterSoapFormat(); procedure Server_service_RegisterSoapFormat();
begin begin
GetFormatterRegistry().Register(sSOAP_CONTENT_TYPE,TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory); GetFormatterRegistry().Register(sPROTOCOL_NAME,sSOAP_CONTENT_TYPE,TSimpleItemFactory.Create(TSOAPFormatter) as IItemFactory);
RegisterStdTypes(); RegisterStdTypes();
end; 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; unit soap_formatter;
{$mode objfpc}{$H+} {$INCLUDE wst.inc}
{$INCLUDE wst_delphi.inc}
interface interface

10
wst/trunk/synapse_tcp_protocol.pas
View File

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

2
wst/trunk/synapse_tcp_server.pas
View File

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