Delphi server side support ( binary, soap, xmlrpc ):

- the Indy http_server compile and works
 - for xml, the Delphi xmldom unit as used ( tested with msxml )

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@213 8e941d3f-bd1b-0410-a28a-d453659cc2b4

wst/trunk/samples/user_client_readbuffer/readbuffer_sample.lpi

@@ -0,0 +1,200 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="5">
+      <Unit0>
+        <Filename Value="readbuffer_sample.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="readbuffer_sample"/>
+        <CursorPos X="1" Y="27"/>
+        <TopLine Value="6"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="25"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="user_service_intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="user_service_intf"/>
+        <CursorPos X="1" Y="27"/>
+        <TopLine Value="23"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="25"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="user_service_intf_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="user_service_intf_proxy"/>
+        <CursorPos X="71" Y="12"/>
+        <TopLine Value="10"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="25"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\..\synapse_tcp_protocol.pas"/>
+        <UnitName Value="synapse_tcp_protocol"/>
+        <CursorPos X="12" Y="29"/>
+        <TopLine Value="16"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit4>
+    </Units>
+    <JumpHistory Count="16" HistoryIndex="15">
+      <Position1>
+        <Filename Value="user_service_intf_proxy.pas"/>
+        <Caret Line="12" Column="71" TopLine="10"/>
+      </Position1>
+      <Position2>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="27" Column="25" TopLine="17"/>
+      </Position2>
+      <Position3>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="29" Column="21" TopLine="14"/>
+      </Position3>
+      <Position4>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="299" Column="8" TopLine="270"/>
+      </Position4>
+      <Position5>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="50" Column="38" TopLine="35"/>
+      </Position5>
+      <Position6>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <Caret Line="317" Column="40" TopLine="301"/>
+      </Position6>
+      <Position7>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <Caret Line="304" Column="40" TopLine="288"/>
+      </Position7>
+      <Position8>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="52" Column="3" TopLine="50"/>
+      </Position8>
+      <Position9>
+        <Filename Value="..\..\synapse_tcp_protocol.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position9>
+      <Position10>
+        <Filename Value="..\..\synapse_tcp_protocol.pas"/>
+        <Caret Line="29" Column="12" TopLine="13"/>
+      </Position10>
+      <Position11>
+        <Filename Value="readbuffer_sample.pas"/>
+        <Caret Line="269" Column="1" TopLine="237"/>
+      </Position11>
+      <Position12>
+        <Filename Value="readbuffer_sample.pas"/>
+        <Caret Line="27" Column="44" TopLine="14"/>
+      </Position12>
+      <Position13>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <Caret Line="4431" Column="1" TopLine="4386"/>
+      </Position13>
+      <Position14>
+        <Filename Value="user_service_intf.pas"/>
+        <Caret Line="273" Column="1" TopLine="267"/>
+      </Position14>
+      <Position15>
+        <Filename Value="readbuffer_sample.pas"/>
+        <Caret Line="58" Column="18" TopLine="46"/>
+      </Position15>
+      <Position16>
+        <Filename Value="readbuffer_sample.pas"/>
+        <Caret Line="46" Column="11" TopLine="22"/>
+      </Position16>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="..\;..\..\;$(LazarusDir)\others_package\synapse\"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="4">
+      <Item1>
+        <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
+        <Line Value="230"/>
+      </Item1>
+      <Item2>
+        <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
+        <Line Value="193"/>
+      </Item2>
+      <Item3>
+        <Source Value="D:\lazarusClean\fpcsrc\rtl\inc\getopts.pp"/>
+        <Line Value="198"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\ws_helper\wsdl2pas_imp.pas"/>
+        <Line Value="606"/>
+      </Item4>
+    </BreakPoints>
+    <Watches Count="2">
+      <Item1>
+        <Expression Value="locStrFilter"/>
+      </Item1>
+      <Item2>
+        <Expression Value="i"/>
+      </Item2>
+    </Watches>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

wst/trunk/samples/user_client_readbuffer/readbuffer_sample.pas

@@ -0,0 +1,269 @@
+program readbuffer_sample;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, SysUtils, TypInfo,
+  user_service_intf_proxy,
+  synapse_tcp_protocol, synapse_http_protocol, library_protocol,
+  soap_formatter, binary_formatter,
+  user_service_intf, xmlrpc_formatter;
+
+type
+  TUser = TUser_Type;
+  TUserCategory = TUserCategory_Type;
+
+var
+  UserServiceInst : UserService;
+
+procedure ShowUser(AUser : TUser);
+begin
+  if ( AUser <> nil ) then begin
+    WriteLn('  Name = ',AUser.UserName);
+    WriteLn('  Category = ',GetEnumName(TypeInfo(TUserCategory),Ord(AUser.Category)));
+    WriteLn('  e-Mail = ',AUser.eMail);
+    WriteLn('  Preferences = ',AUser.Preferences);
+    WriteLn('  Note = ',AUser.Note.Data);
+    {WriteLn('    Author = ',AUser.Note.Author);
+    WriteLn('    Date = ',AUser.Note.Date);}
+  end else begin
+    WriteLn('<Empty User>');
+  end;
+end;
+
+procedure ShowUserArray(AArray : TUserArray);
+var
+  i, c : Integer;
+  usr : TUser;
+begin
+  if ( AArray <> nil ) then begin
+    c := AArray.Length;
+    for i := 0 to Pred(c) do begin
+      usr := AArray[i];
+      WriteLn();
+      WriteLn(Format('User[%d] : ',[(i+1)]));
+      ShowUser(usr);
+    end;
+  end;
+end;
+
+procedure HandleShowAll();
+var
+  userArray : TUserArray;
+begin
+  userArray := UserServiceInst.GetList();
+  try
+    if ( userArray <> nil ) and ( userArray.Length > 0 ) then begin
+      ShowUserArray(userArray);
+    end else begin
+      WriteLn('Empty Array.');
+    end;
+  finally
+    FreeAndNil(userArray);
+  end;
+end;
+
+type TAddType = ( atAdd, atUpdate );
+procedure HandleAdd(const AType :TAddType);
+const CAPTIONS : array[TAddType] of string = ( 'Adding a user :', 'Updating a user :' );
+  function ReadItem(const APrompt : string; const ANonNull : Boolean):string ;
+  begin
+    Result := '';
+    Write(APrompt);
+    ReadLn(Result);
+    Result := Trim(Result);
+    if ANonNull and ( Length(Result) = 0 ) then
+      Raise Exception.Create('Invalid User Name!');
+  end;
+var
+  usr : TUser;
+  buff : string;
+begin
+  buff := '';
+  WriteLn(CAPTIONS[AType]);
+  try
+    usr := TUser.Create();
+    try
+      usr.UserName := ReadItem('Enter user name : ',True);
+      buff := UpperCase(ReadItem('Enter user Category( A : Admin; N : normal ) : ',True));
+      if ( buff[1] = 'A' ) then
+        usr.Category:= Admin
+      else
+        usr.Category:= Normal;
+      usr.eMail := ReadItem('Enter user e-mail : ',False);
+      usr.Preferences := ReadItem('Enter user Preferences : ',False);
+      buff := UpperCase(ReadItem('Do you want to add some notes : ',True));
+      if ( buff[1] = 'O' ) then begin
+        usr.Note.Data := ReadItem('Enter user Note : ',False);
+        {usr.Note.Author := ReadItem('Enter user Note.Author : ',False);
+        usr.Note.Date := ReadItem('Enter user Note.Date : ',False);}
+      end;
+      if ( AType = atUpdate ) then
+        UserServiceInst.Update(usr)
+      else
+        UserServiceInst.Add(usr);
+    finally
+      FreeAndNil(usr);
+    end;
+  except
+    on e : Exception do begin
+      WriteLn(e.Message);
+    end;
+  end;
+end;
+
+procedure HandleFindUser();
+var
+  user : TUser;
+  buff : string;
+begin
+  Write('Enter User Name : ');
+  ReadLn(buff);
+  user := UserServiceInst.Find(buff);
+  try
+    ShowUser(user);
+  finally
+    FreeAndNil(user);
+  end;
+end;
+
+procedure HandleDeleteUser();
+var
+  buff : string;
+begin
+  Write('Enter User Name : ');
+  ReadLn(buff);
+  UserServiceInst.Delete(buff);
+end;
+
+type
+  TTransportType = ( ttLibrary, ttTCP, ttHTTP );
+  TFormatType = ( ftBinary, ftSoap, ftXmlRPC );
+var
+  TransportType : TTransportType;
+  FormatValue : TFormatType;
+procedure CreateProxy();
+const ADDRESS_MAP : array[TTransportType] of string = (
+        'LIB:FileName=..\library_server\lib_server.dll;target=UserService',
+        'TCP:Address=127.0.0.1;Port=1234;target=UserService',
+        //'http:Address=http://127.0.0.1:8080/wst/services/UserService/?format=soap'
+        'http:Address=http://127.0.0.1:8000/services/UserService'
+      );
+      FORMAT_MAP : array[TFormatType] of string =( 'binary', 'soap', 'xmlrpc' );
+var
+  buff : string;
+begin
+  if ( TransportType = ttHTTP ) then
+    buff := Format('%s/?format=%s',[ADDRESS_MAP[TransportType],FORMAT_MAP[FormatValue]])
+  else
+    buff := ADDRESS_MAP[TransportType];
+  if ( TransportType = ttLibrary ) then
+    buff := StringReplace(buff,'\',DirectorySeparator,[rfReplaceAll, rfIgnoreCase]);
+  UserServiceInst := TUserService_Proxy.Create(
+                       'UserService',
+                       FORMAT_MAP[FormatValue] + ':',
+                       buff
+                     );
+end;
+
+procedure ReadTransportType();
+var
+  buff : string;
+begin
+  WriteLn();
+  WriteLn('Select a transport protocol : ');
+  WriteLn('  L : Library, the lib_server project must have been built');
+  WriteLn('  T : TCP, the tcp_server must have been built');
+  WriteLn('  H : HTTP, the http_server must have been built');
+  WriteLn();
+  Write('Your selection : ');
+  while True do begin
+    ReadLn(buff);
+    buff := UpperCase(Trim(buff));
+    if ( Length(buff) > 0 ) and ( buff[1] in ['L','T', 'H'] ) then begin
+      case buff[1] of
+        'L' : TransportType := ttLibrary;
+        'T' : TransportType := ttTCP;
+        'H' : TransportType := ttHTTP;
+      end;
+      Break;
+    end;
+  end;
+end;
+
+procedure ReadFormatType();
+var
+  buff : string;
+begin
+  WriteLn();
+  WriteLn('Select a messaging format : ');
+  WriteLn('  B : binary ( binary_formatter.pas )');
+  WriteLn('  S : soap   ( soap_formatter.pas )');
+  WriteLn('  X : XmlRpc ( xmlrpc_formatter.pas )');
+  WriteLn();
+  Write('Your selection : ');
+  while True do begin
+    ReadLn(buff);
+    buff := UpperCase(Trim(buff));
+    if ( Length(buff) > 0 ) and ( buff[1] in ['B','S', 'X'] ) then begin
+      case buff[1] of
+        'B' : FormatValue := ftBinary;
+        'S' : FormatValue := ftSoap;
+        'X' : FormatValue := ftXmlRPC;
+      end;
+      Break;
+    end;
+  end;
+end;
+
+var
+  strBuffer : string;
+begin
+  SYNAPSE_RegisterTCP_Transport();
+  SYNAPSE_RegisterHTTP_Transport();
+  LIB_Register_Transport();
+  WriteLn('Sample Application using Web Services Toolkit');
+  ReadFormatType();
+  ReadTransportType();
+  CreateProxy();
+  WriteLn('Menu :');
+  WriteLn(' L : Show the user list');
+  WriteLn(' A : Add a new user');
+  WriteLn(' U : Update a user');
+  WriteLn(' D : Delete a user');
+  WriteLn(' F : Find a new');
+  WriteLn(' C : Change the communication protocol');
+  WriteLn(' Z : Change the messaging format');
+  WriteLn(' X : Exit');
+  WriteLn();
+  Write('Choose a item : ');
+  while True do begin
+    strBuffer := '';
+    ReadLn(strBuffer);
+    strBuffer := UpperCase(Trim(strBuffer));
+    if ( Length(strBuffer) > 0 ) then begin
+      case strBuffer[1] of
+        'L' : HandleShowAll();
+        'A' : HandleAdd(atAdd);
+        'U' : HandleAdd(atUpdate);
+        'D' : HandleDeleteUser();
+        'F' : HandleFindUser();
+        'C' :
+          begin
+            ReadTransportType();
+            CreateProxy();
+          end;
+        'Z' :
+          begin
+            ReadFormatType();
+            CreateProxy();
+          end;
+        'X' : Break;
+      end;
+      WriteLn();
+      Write('Choose a item : ');
+    end;
+  end;
+end.
+
+

wst/trunk/samples/user_client_readbuffer/user_service_intf.pas

@@ -0,0 +1,271 @@
+{
+This unit has been produced by ws_helper.
+  Input unit name : "user_service_intf".
+  This unit name  : "user_service_intf".
+  Date            : "12/07/2007 11:50:48".
+}
+unit user_service_intf;
+{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
+interface
+
+uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
+
+const
+  sNAME_SPACE = 'urn:UserService';
+  sUNIT_NAME = 'user_service_intf';
+
+type
+
+  TUserArray = class;
+  TUser_Type = class;
+
+  TUserCategory_Type = ( 
+    Normal
+    ,Admin
+  );
+
+  { TUser_Type }
+
+  TUser_Type = class(TBaseComplexRemotable)
+  private
+    FCategory : TUserCategory_Type;
+    FUserName : string;
+    FeMail : string;
+    FPreferences : string;
+    FNote : TStringBufferRemotable;
+  public
+    constructor Create();override;
+    destructor Destroy();override;
+  published
+    property Category : TUserCategory_Type read FCategory write FCategory;
+    property UserName : string read FUserName write FUserName;
+    property eMail : string read FeMail write FeMail;
+    property Preferences : string read FPreferences write FPreferences;
+    property Note : TStringBufferRemotable read FNote write FNote;
+  end;
+
+  TUserArray = class(TBaseObjectArrayRemotable)
+  private
+    function GetItem(AIndex: Integer): TUser_Type;
+  public
+    class function GetItemClass():TBaseRemotableClass;override;
+    property Item[AIndex:Integer] : TUser_Type Read GetItem;Default;
+  end;
+
+  UserService = interface(IInvokable)
+    ['{F49D8FA4-9BBC-4321-9869-5BA745070ABC}']
+    function GetList():TUserArray;
+    procedure Add(
+      const  AUser : TUser_Type
+    );
+    procedure Update(
+      const  AUser : TUser_Type
+    );
+    function Find(
+      const  AName : string
+    ):TUser_Type;
+    function Delete(
+      const  AName : string
+    ):boolean;
+  end;
+
+  procedure Register_user_service_intf_ServiceMetadata();
+
+Implementation
+uses metadata_repository;
+
+{ TUserArray }
+
+function TUserArray.GetItem(AIndex: Integer): TUser_Type;
+begin
+  Result := Inherited GetItem(AIndex) As TUser_Type;
+end;
+
+class function TUserArray.GetItemClass(): TBaseRemotableClass;
+begin
+  Result:= TUser_Type;
+end;
+
+
+procedure Register_user_service_intf_ServiceMetadata();
+var
+  mm : IModuleMetadataMngr;
+begin
+  mm := GetModuleMetadataMngr();
+  mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
+  mm.SetServiceCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'TRANSPORT_Address',
+    'http://127.0.0.1:8000/services/UserService'
+  );
+  mm.SetServiceCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'FORMAT_Style',
+    'rpc'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'GetList',
+    '_E_N_',
+    'GetList'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'GetList',
+    'TRANSPORT_soapAction',
+    'urn:UserService/UserServiceGetList'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'GetList',
+    'FORMAT_Input_EncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'GetList',
+    'FORMAT_OutputEncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Add',
+    '_E_N_',
+    'Add'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Add',
+    'TRANSPORT_soapAction',
+    'urn:UserService/UserServiceAdd'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Add',
+    'FORMAT_Input_EncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Add',
+    'FORMAT_OutputEncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Update',
+    '_E_N_',
+    'Update'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Update',
+    'TRANSPORT_soapAction',
+    'urn:UserService/UserServiceUpdate'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Update',
+    'FORMAT_Input_EncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Update',
+    'FORMAT_OutputEncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Find',
+    '_E_N_',
+    'Find'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Find',
+    'TRANSPORT_soapAction',
+    'urn:UserService/UserServiceFind'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Find',
+    'FORMAT_Input_EncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Find',
+    'FORMAT_OutputEncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Delete',
+    '_E_N_',
+    'Delete'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Delete',
+    'TRANSPORT_soapAction',
+    'urn:UserService/UserServiceDelete'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Delete',
+    'FORMAT_Input_EncodingStyle',
+    'literal'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'UserService',
+    'Delete',
+    'FORMAT_OutputEncodingStyle',
+    'literal'
+  );
+end;
+
+{ TUser_Type }
+
+constructor TUser_Type.Create( );
+begin
+  inherited Create( );
+  FNote := TStringBufferRemotable.Create();
+end;
+
+destructor TUser_Type.Destroy( );
+begin
+  FreeAndNil(FNote);
+  inherited Destroy( );
+end;
+
+initialization
+  GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserCategory_Type),'TUserCategory');
+  GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUser_Type),'TUser');
+  GetTypeRegistry().Register(sNAME_SPACE,TypeInfo(TUserArray),'TUserArray');
+  GetTypeRegistry().ItemByTypeInfo[TypeInfo(TUserArray)].RegisterExternalPropertyName(sARRAY_ITEM,'item');
+
+
+End.

wst/trunk/samples/user_client_readbuffer/user_service_intf.wsdl

@@ -0,0 +1,89 @@
+<?xml version="1.0"?>
+<definitions name="urn:UserService" xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:tns="urn:UserService" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" targetNamespace="urn:UserService">
+  <types>
+    <xsd:schema xmlns="http://www.w3.org/2001/XMLSchema" targetNamespace="urn:UserService">
+      <xsd:complexType name="TUserArray">
+        <xsd:sequence><xsd:element name="item" type="tns:TUser" maxOccurs="unbounded" minOccurs="0"/></xsd:sequence>
+      </xsd:complexType>
+      <xsd:complexType name="TUser">
+        <xsd:sequence>
+          <xsd:element name="Category" type="tns:TUserCategory" maxOccurs="1" minOccurs="1"/>
+          <xsd:element name="UserName" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+          <xsd:element name="eMail" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+          <xsd:element name="Preferences" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+          <xsd:element name="Note" type="xsd:string" maxOccurs="1" minOccurs="1"/>
+        </xsd:sequence>
+      </xsd:complexType>
+      <xsd:simpleType name="TUserCategory">
+        <xsd:restriction base="xsd:string">
+          <xsd:enumeration value="Normal"/>
+          <xsd:enumeration value="Admin"/>
+        </xsd:restriction>
+      </xsd:simpleType>
+    </xsd:schema>
+  </types>
+  <message name="GetList"/>
+  <message name="GetListResponse"><part name="result" type="tns:TUserArray"/></message>
+  <message name="Add"><part name="AUser" type="tns:TUser"/></message>
+  <message name="AddResponse"/>
+  <message name="Update"><part name="AUser" type="tns:TUser"/></message>
+  <message name="UpdateResponse"/>
+  <message name="Find"><part name="AName" type="xsd:string"/></message>
+  <message name="FindResponse"><part name="result" type="tns:TUser"/></message>
+  <message name="Delete"><part name="AName" type="xsd:string"/></message>
+  <message name="DeleteResponse"><part name="result" type="xsd:boolean"/></message>
+  <portType name="UserService">
+    <document><GUID value="{F49D8FA4-9BBC-4321-9869-5BA745070ABC}"/></document>
+    <operation name="GetList">
+      <input message="tns:GetList"/>
+      <output message="tns:GetListResponse"/>
+    </operation>
+    <operation name="Add">
+      <input message="tns:Add"/>
+      <output message="tns:AddResponse"/>
+    </operation>
+    <operation name="Update">
+      <input message="tns:Update"/>
+      <output message="tns:UpdateResponse"/>
+    </operation>
+    <operation name="Find">
+      <input message="tns:Find"/>
+      <output message="tns:FindResponse"/>
+    </operation>
+    <operation name="Delete">
+      <input message="tns:Delete"/>
+      <output message="tns:DeleteResponse"/>
+    </operation>
+  </portType>
+  <binding name="UserServiceBinding" type="tns:UserService">
+    <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
+    <operation name="GetList">
+      <soap:operation soapAction="urn:UserService/UserServiceGetList"/>
+      <input><soap:body use="literal" namespace="urn:UserService"/></input>
+      <output><soap:body use="literal" namespace="urn:UserService"/></output>
+    </operation>
+    <operation name="Add">
+      <soap:operation soapAction="urn:UserService/UserServiceAdd"/>
+      <input><soap:body use="literal" namespace="urn:UserService"/></input>
+      <output><soap:body use="literal" namespace="urn:UserService"/></output>
+    </operation>
+    <operation name="Update">
+      <soap:operation soapAction="urn:UserService/UserServiceUpdate"/>
+      <input><soap:body use="literal" namespace="urn:UserService"/></input>
+      <output><soap:body use="literal" namespace="urn:UserService"/></output>
+    </operation>
+    <operation name="Find">
+      <soap:operation soapAction="urn:UserService/UserServiceFind"/>
+      <input><soap:body use="literal" namespace="urn:UserService"/></input>
+      <output><soap:body use="literal" namespace="urn:UserService"/></output>
+    </operation>
+    <operation name="Delete">
+      <soap:operation soapAction="urn:UserService/UserServiceDelete"/>
+      <input><soap:body use="literal" namespace="urn:UserService"/></input>
+      <output><soap:body use="literal" namespace="urn:UserService"/></output>
+    </operation>
+  </binding>
+  <service name="UserService">
+    <port name="UserServicePort" binding="tns:UserServiceBinding"><soap:address location="http://127.0.0.1:8000/services/UserService"/></port>
+  </service>
+</definitions>

wst/trunk/samples/user_client_readbuffer/user_service_intf.wst

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

wst/trunk/samples/user_client_readbuffer/user_service_intf_proxy.pas

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