first import

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

wst/trunk/tests/tcp_server/server_unit.pas

@@ -0,0 +1,270 @@
+unit server_unit;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Windows, Dialogs,
+  WSocket, WSocketS;
+
+  
+Type
+
+  { TTcpSrvClient }
+
+  TTcpSrvClient = class(TWSocketClient)
+  Private
+    FConnectTime: TDateTime;
+    FDataLentgh: LongInt;
+    FRequestStream : TStream;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy();override;
+    function TryRead():Boolean;
+    property ConnectTime : TDateTime Read FConnectTime Write FConnectTime;
+    property RequestStream : TStream Read FRequestStream;
+    property DataLentgh : LongInt Read FDataLentgh;
+  end;
+
+  { TTcpSrvApp }
+
+  TTcpSrvApp = class
+  Private
+    procedure HandleClientConnect(Sender: TObject;Client: TWSocketClient; Error: Word);
+    procedure HandleClientDisconnect(Sender: TObject;
+      Client: TWSocketClient; Error: Word);
+    procedure HandleBgException(Sender: TObject; E: Exception;
+      var CanClose: Boolean);
+  private
+    FWSocketServer: TWSocketServer;
+    procedure ClientDataAvailable(Sender: TObject; Error: Word);
+    procedure ProcessData(Client : TTcpSrvClient);
+    procedure ClientBgException(Sender       : TObject;
+                                E            : Exception;
+                                var CanClose : Boolean);
+    procedure ClientLineLimitExceeded(Sender        : TObject;
+                                      Cnt           : LongInt;
+                                      var ClearData : Boolean);
+  Public
+    constructor Create();
+    destructor Destroy();override;
+    procedure Display(Msg : String);
+    procedure Start();
+    procedure Stop();
+    function IsActive():Boolean;
+  End;
+  
+Implementation
+uses umain, server_service_intf, server_service_imputils, binary_streamer;
+
+procedure LogMsg(const Msg : String);
+Begin
+  fMain.LogMessage(Msg);
+End;
+
+procedure TTcpSrvApp.Display(Msg : String);
+begin
+  LogMsg(Msg);
+end;
+
+procedure TTcpSrvApp.Start();
+begin
+  Display('Starting...');
+  FWSocketServer.Proto       := 'tcp';         { Use TCP protocol  }
+  FWSocketServer.Port        := '1234';
+  FWSocketServer.Addr        := '0.0.0.0';     { Use any interface }
+  FWSocketServer.ClientClass := TTcpSrvClient;
+  FWSocketServer.Listen;                       { Start litening    }
+  Display('Waiting for clients...');
+end;
+
+procedure TTcpSrvApp.Stop();
+begin
+  FWSocketServer.CloseDelayed();
+end;
+
+function TTcpSrvApp.IsActive(): Boolean;
+begin
+  Result := ( FWSocketServer.State < wsClosed );
+end;
+
+procedure TTcpSrvApp.HandleClientConnect(
+    Sender : TObject;
+    Client : TWSocketClient;
+    Error  : Word);
+begin
+    with Client as TTcpSrvClient do begin
+        Display('Client connected.' +
+                ' Remote: ' + PeerAddr + '/' + PeerPort +
+                ' Local: '  + GetXAddr + '/' + GetXPort);
+        Display('There is now ' +
+                IntToStr(TWSocketServer(Sender).ClientCount) +
+                ' clients connected.');
+        LineMode            := False;
+        LineEdit            := False;
+        OnDataAvailable     := @ClientDataAvailable;
+        OnLineLimitExceeded := @ClientLineLimitExceeded;
+        OnBgException       := @ClientBgException;
+        ConnectTime         := Now;
+    end;
+end;
+
+procedure TTcpSrvApp.HandleClientDisconnect(
+    Sender : TObject;
+    Client : TWSocketClient;
+    Error  : Word);
+begin
+    with Client as TTcpSrvClient do begin
+        Display('Client disconnecting : ' + PeerAddr + '   ' +
+                'Duration: ' + FormatDateTime('hh:nn:ss',
+                Now - ConnectTime));
+        Display('There is now ' +
+                IntToStr(TWSocketServer(Sender).ClientCount - 1) +
+                ' clients connected.');
+    end;
+end;
+
+procedure TTcpSrvApp.ClientLineLimitExceeded(
+    Sender        : TObject;
+    Cnt           : LongInt;
+    var ClearData : Boolean);
+begin
+    with Sender as TTcpSrvClient do begin
+        Display('Line limit exceeded from ' + GetPeerAddr + '. Closing.');
+        ClearData := TRUE;
+        Close;
+    end;
+end;
+
+constructor TTcpSrvApp.Create();
+begin
+  FWSocketServer := TWSocketServer.Create(Nil);
+  FWSocketServer.Banner := '';
+  FWSocketServer.OnClientConnect := @HandleClientConnect;
+  FWSocketServer.OnBgException := @HandleBgException;
+  FWSocketServer.OnClientDisconnect := @HandleClientDisconnect;
+end;
+
+destructor TTcpSrvApp.Destroy();
+begin
+  FWSocketServer.Free();
+end;
+
+procedure TTcpSrvApp.ClientDataAvailable(Sender : TObject;Error  : Word);
+Var
+  cliTCP : TTcpSrvClient;
+begin
+  cliTCP := Sender as TTcpSrvClient;
+  //Display('ClientDataAvailable()');
+  If cliTCP.TryRead() And ( cliTCP.DataLentgh > 0 ) Then
+    ProcessData(cliTCP)
+end;
+
+procedure TTcpSrvApp.ProcessData(Client : TTcpSrvClient);
+Var
+  buff, trgt,ctntyp : string;
+  rqst : IRequestBuffer;
+  wrtr : IDataStore;
+  rdr : IDataStoreReader;
+  inStream, outStream, bufStream : TMemoryStream;
+  i : Integer;
+begin
+  inStream := Nil;
+  outStream := Nil;
+  bufStream := Nil;
+  Try
+    Client.RequestStream.Position := 0;
+    Try
+      inStream := TMemoryStream.Create();
+      outStream := TMemoryStream.Create();
+      bufStream := TMemoryStream.Create();
+      rdr := CreateBinaryReader(Client.RequestStream);
+      trgt := rdr.ReadStr();
+      ctntyp := rdr.ReadStr();
+      buff := rdr.ReadStr();
+      inStream.Write(buff[1],Length(buff));
+      inStream.Position := 0;
+      rqst := TRequestBuffer.Create(trgt,ctntyp,inStream,bufStream);
+      HandleServiceRequest(rqst);
+      i := bufStream.Size;
+      SetLength(buff,i);
+      bufStream.Position := 0;
+      bufStream.Read(buff[1],i);
+      wrtr := CreateBinaryWriter(outStream);
+      wrtr.WriteStr(buff);
+      //Display('ProcessData() resp Ln =' + IntToStr(i) + '; resp = ' + buff);
+      Client.Send(outStream.Memory,outStream.Size);
+    Finally
+      //Display('ProcessData()>> END');
+      bufStream.Free();
+      outStream.Free();
+      inStream.Free();
+      Client.FDataLentgh := -1;
+      Client.RequestStream.Size := 0;
+    End;
+  Except
+    On e : Exception Do
+      Display('ProcessData()>> Exception = '+e.Message);
+  End;
+end;
+
+procedure TTcpSrvApp.HandleBgException(
+    Sender       : TObject;
+    E            : Exception;
+    var CanClose : Boolean);
+begin
+    Display('Server exception occured: ' + E.ClassName + ': ' + E.Message);
+    CanClose := FALSE;  { Hoping that server will still work ! }
+end;
+
+procedure TTcpSrvApp.ClientBgException(
+    Sender       : TObject;
+    E            : Exception;
+    var CanClose : Boolean);
+begin
+    Display('Client exception occured: ' + E.ClassName + ': ' + E.Message);
+    CanClose := TRUE;   { Goodbye client ! }
+end;
+
+{ TTcpSrvClient }
+
+constructor TTcpSrvClient.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDataLentgh := -1;
+  FRequestStream := TMemoryStream.Create();
+end;
+
+destructor TTcpSrvClient.Destroy();
+begin
+  FRequestStream.Free();
+  inherited Destroy();
+end;
+
+function TTcpSrvClient.TryRead(): Boolean;
+Var
+  i,j : PtrInt;
+  buff : string;
+begin
+  If ( FDataLentgh < 0 ) Then Begin
+    i := 4;
+    If ( Receive(@FDataLentgh,i) < 4 ) Then Begin
+      FDataLentgh := -1;
+      Result := False;
+      Exit;
+    End;
+    FDataLentgh := Reverse_32(FDataLentgh);
+  End;
+  If ( FDataLentgh > FRequestStream.Size ) Then Begin
+    i := Min((FDataLentgh-FRequestStream.Size),1024);
+    SetLength(buff,i);
+    j := Receive(@(buff[1]),i);
+    FRequestStream.Write(buff[1],j);
+    //LogMsg(Format('Read %d bytes;  buff=%s',[j,buff]));
+  End;
+  Result := ( FDataLentgh <= FRequestStream.Size );
+  //LogMsg(Format('TryRead() >> FDataLentgh=%d;  Size=%d',[FDataLentgh,FRequestStream.Size]));
+end;
+
+end.

wst/trunk/tests/tcp_server/tcp_gui_server.lpi

@@ -0,0 +1,381 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="5"/>
+    </General>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="38">
+      <Unit0>
+        <Filename Value="tcp_gui_server.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="tcp_gui_server"/>
+        <CursorPos X="25" Y="3"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="umain.pas"/>
+        <ComponentName Value="fMain"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="umain.lrs"/>
+        <UnitName Value="umain"/>
+        <CursorPos X="41" Y="88"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="server_unit.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="server_unit"/>
+        <CursorPos X="4" Y="245"/>
+        <TopLine Value="144"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="127"/>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocket.pas"/>
+        <UnitName Value="WSocket"/>
+        <CursorPos X="27" Y="982"/>
+        <TopLine Value="968"/>
+        <UsageCount Value="9"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSocketS.pas"/>
+        <UnitName Value="WSocketS"/>
+        <CursorPos X="32" Y="140"/>
+        <TopLine Value="136"/>
+        <UsageCount Value="9"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="50"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\..\..\server_service_intf.pas"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="17" Y="203"/>
+        <TopLine Value="70"/>
+        <UsageCount Value="41"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\..\..\server_service_imputils.pas"/>
+        <UnitName Value="server_service_imputils"/>
+        <CursorPos X="29" Y="1"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="41"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\WSockBuf.pas"/>
+        <UnitName Value="WSockBuf"/>
+        <CursorPos X="3" Y="163"/>
+        <TopLine Value="157"/>
+        <UsageCount Value="10"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\basic_stub.pas"/>
+        <UnitName Value="basic_stub"/>
+        <CursorPos X="39" Y="16"/>
+        <TopLine Value="8"/>
+        <UsageCount Value="32"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\basic.pas"/>
+        <UnitName Value="basic"/>
+        <CursorPos X="5" Y="3"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="38"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\basic_intfimpunit.pas"/>
+        <UnitName Value="basic_intfimpunit"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="7"/>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\basic_service_implementation.pas"/>
+        <UnitName Value="basic_service_implementation"/>
+        <CursorPos X="56" Y="33"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="32"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\..\..\server_service_soap.pas"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="45" Y="811"/>
+        <TopLine Value="807"/>
+        <UsageCount Value="30"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="..\..\..\..\server_binary_formatter.pas"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="37" Y="23"/>
+        <TopLine Value="1"/>
+        <UsageCount Value="30"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\..\..\binary_util_imp.inc"/>
+        <CursorPos X="3" Y="426"/>
+        <TopLine Value="424"/>
+        <UsageCount Value="5"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\..\..\binary_util_h.inc"/>
+        <CursorPos X="6" Y="180"/>
+        <TopLine Value="166"/>
+        <UsageCount Value="3"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\basic_imp.pas"/>
+        <UnitName Value="basic_imp"/>
+        <CursorPos X="3" Y="39"/>
+        <TopLine Value="9"/>
+        <UsageCount Value="4"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\basic_binder.pas"/>
+        <UnitName Value="basic_binder"/>
+        <CursorPos X="13" Y="67"/>
+        <TopLine Value="44"/>
+        <UsageCount Value="4"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\classesh.inc"/>
+        <CursorPos X="15" Y="190"/>
+        <TopLine Value="178"/>
+        <UsageCount Value="3"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\classes\lists.inc"/>
+        <CursorPos X="26" Y="419"/>
+        <TopLine Value="412"/>
+        <UsageCount Value="3"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="D:\lazarusClean\fpcsrc\fcl\inc\contnrs.pp"/>
+        <UnitName Value="contnrs"/>
+        <CursorPos X="3" Y="745"/>
+        <TopLine Value="743"/>
+        <UsageCount Value="4"/>
+      </Unit21>
+      <Unit22>
+        <Filename Value="..\..\..\..\service_intf.pas"/>
+        <UnitName Value="service_intf"/>
+        <CursorPos X="3" Y="814"/>
+        <TopLine Value="796"/>
+        <UsageCount Value="3"/>
+      </Unit22>
+      <Unit23>
+        <Filename Value="calculator\calculator.pas"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="47" Y="58"/>
+        <TopLine Value="28"/>
+        <UsageCount Value="87"/>
+      </Unit23>
+      <Unit24>
+        <Filename Value="calculator\srv\calculator_imp.pas"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="55" Y="95"/>
+        <TopLine Value="77"/>
+        <UsageCount Value="87"/>
+      </Unit24>
+      <Unit25>
+        <Filename Value="calculator\srv\calculator_binder.pas"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="40" Y="126"/>
+        <TopLine Value="101"/>
+        <UsageCount Value="87"/>
+      </Unit25>
+      <Unit26>
+        <Filename Value="..\..\server_service_soap.pas"/>
+        <UnitName Value="server_service_soap"/>
+        <CursorPos X="15" Y="43"/>
+        <TopLine Value="29"/>
+        <UsageCount Value="26"/>
+      </Unit26>
+      <Unit27>
+        <Filename Value="..\..\server_binary_formatter.pas"/>
+        <UnitName Value="server_binary_formatter"/>
+        <CursorPos X="13" Y="83"/>
+        <TopLine Value="73"/>
+        <UsageCount Value="28"/>
+      </Unit27>
+      <Unit28>
+        <Filename Value="..\..\server_service_intf.pas"/>
+        <UnitName Value="server_service_intf"/>
+        <CursorPos X="9" Y="429"/>
+        <TopLine Value="417"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="44"/>
+        <Loaded Value="True"/>
+      </Unit28>
+      <Unit29>
+        <Filename Value="..\..\base_service_intf.pas"/>
+        <UnitName Value="base_service_intf"/>
+        <CursorPos X="1" Y="22"/>
+        <TopLine Value="17"/>
+        <UsageCount Value="38"/>
+      </Unit29>
+      <Unit30>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\objpas\typinfo.pp"/>
+        <UnitName Value="typinfo"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="31"/>
+        <UsageCount Value="9"/>
+      </Unit30>
+      <Unit31>
+        <Filename Value="..\..\base_soap_formatter.pas"/>
+        <UnitName Value="base_soap_formatter"/>
+        <CursorPos X="3" Y="328"/>
+        <TopLine Value="317"/>
+        <UsageCount Value="26"/>
+        <Bookmarks Count="1">
+          <Item0 X="24" Y="642" ID="1"/>
+        </Bookmarks>
+      </Unit31>
+      <Unit32>
+        <Filename Value="..\..\base_binary_formatter.pas"/>
+        <UnitName Value="base_binary_formatter"/>
+        <CursorPos X="3" Y="872"/>
+        <TopLine Value="874"/>
+        <UsageCount Value="20"/>
+        <Bookmarks Count="1">
+          <Item0 X="16" Y="387" ID="2"/>
+        </Bookmarks>
+      </Unit32>
+      <Unit33>
+        <Filename Value="..\..\binary_streamer.pas"/>
+        <UnitName Value="binary_streamer"/>
+        <CursorPos X="67" Y="167"/>
+        <TopLine Value="149"/>
+        <UsageCount Value="12"/>
+      </Unit33>
+      <Unit34>
+        <Filename Value="D:\lazarusClean\fpcsrc\rtl\win\sysutils.pp"/>
+        <UnitName Value="sysutils"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="78"/>
+        <UsageCount Value="8"/>
+      </Unit34>
+      <Unit35>
+        <Filename Value="..\calculator\calculator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit35>
+      <Unit36>
+        <Filename Value="..\calculator\srv\calculator_imp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_imp"/>
+        <CursorPos X="48" Y="117"/>
+        <TopLine Value="110"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit36>
+      <Unit37>
+        <Filename Value="..\calculator\srv\calculator_binder.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="calculator_binder"/>
+        <CursorPos X="80" Y="174"/>
+        <TopLine Value="170"/>
+        <UsageCount Value="20"/>
+      </Unit37>
+    </Units>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="D:\Lazarus\others_package\ics\latest_distr\Delphi\Vc32\;..\calculator\;..\calculator\srv\;..\..\"/>
+      <UnitOutputDirectory Value="obj"/>
+      <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CustomOptions Value="-Xi"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <BreakPoints Count="5">
+      <Item1>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="15"/>
+      </Item1>
+      <Item2>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="16"/>
+      </Item2>
+      <Item3>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\test_soap.pas"/>
+        <Line Value="18"/>
+      </Item3>
+      <Item4>
+        <Source Value="..\..\home\inoussa\Projets\Laz\tests\soap\googleintfimpunit.pas"/>
+        <Line Value="63"/>
+      </Item4>
+      <Item5>
+        <Source Value="..\..\basic_binder.pas"/>
+        <Line Value="62"/>
+      </Item5>
+    </BreakPoints>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="ASource.Memory^"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>

wst/trunk/tests/tcp_server/tcp_gui_server.lpr

@@ -0,0 +1,17 @@
+program tcp_gui_server;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, umain, server_unit, calculator, calculator_imp, calculator_binder;
+
+begin
+  Application.Initialize;
+  Application.CreateForm(TfMain, fMain);
+  Application.Run;
+end.
+

wst/trunk/tests/tcp_server/umain.lfm

@@ -0,0 +1,77 @@
+object fMain: TfMain
+  Left = 290
+  Height = 300
+  Top = 180
+  Width = 400
+  HorzScrollBar.Page = 399
+  VertScrollBar.Page = 299
+  ActiveControl = Button1
+  Caption = 'Simple TCP App Server'
+  ClientHeight = 300
+  ClientWidth = 400
+  OnCreate = FormCreate
+  PixelsPerInch = 96
+  object Label1: TLabel
+    Left = 16
+    Height = 14
+    Top = 72
+    Width = 18
+    Caption = 'Log'
+    Color = clNone
+    ParentColor = False
+  end
+  object Button1: TButton
+    Left = 16
+    Height = 25
+    Top = 8
+    Width = 104
+    Action = actStart
+    BorderSpacing.InnerBorder = 2
+    TabOrder = 0
+  end
+  object mmoLog: TMemo
+    Left = 8
+    Height = 192
+    Top = 96
+    Width = 384
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    ReadOnly = True
+    ScrollBars = ssAutoBoth
+    TabOrder = 1
+  end
+  object Button2: TButton
+    Left = 16
+    Height = 25
+    Top = 40
+    Width = 104
+    Action = actStop
+    BorderSpacing.InnerBorder = 2
+    TabOrder = 2
+  end
+  object edtPort: TEdit
+    Left = 128
+    Height = 23
+    Top = 10
+    Width = 80
+    TabOrder = 3
+    Text = '1234'
+  end
+  object AL: TActionList
+    left = 152
+    top = 32
+    object actStart: TAction
+      Caption = 'Start( Port=)'
+      OnExecute = actStartExecute
+      OnUpdate = actStartUpdate
+    end
+    object actStop: TAction
+      Caption = 'Stop'
+      OnExecute = actStopExecute
+      OnUpdate = actStopUpdate
+    end
+    object actClearLog: TAction
+      Caption = 'Clear Log'
+      OnExecute = actClearLogExecute
+    end
+  end
+end

wst/trunk/tests/tcp_server/umain.lrs

@@ -0,0 +1,24 @@
+{ Ceci est un fichier ressource g�n�r� automatiquement par Lazarus }
+
+LazarusResources.Add('TfMain','FORMDATA',[
+  'TPF0'#6'TfMain'#5'fMain'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#180#0#5'Wi'
+  +'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#13
+  +'ActiveControl'#7#7'Button1'#7'Caption'#6#21'Simple TCP App Server'#12'Clien'
+  +'tHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#13'Pix'
+  +'elsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2#16#6'Height'#2#14#3'Top'#2
+  +'H'#5'Width'#2#18#7'Caption'#6#3'Log'#5'Color'#7#6'clNone'#11'ParentColor'#8
+  +#0#0#7'TButton'#7'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2#8#5'Width'#2
+  +'h'#6'Action'#7#8'actStart'#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#0
+  +#0#0#5'TMemo'#6'mmoLog'#4'Left'#2#8#6'Height'#3#192#0#3'Top'#2'`'#5'Width'#3
+  +#128#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#8'ReadOnly'
+  +#9#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#1#0#0#7'TButton'#7'Button2'
+  +#4'Left'#2#16#6'Height'#2#25#3'Top'#2'('#5'Width'#2'h'#6'Action'#7#7'actStop'
+  +#25'BorderSpacing.InnerBorder'#2#2#8'TabOrder'#2#2#0#0#5'TEdit'#7'edtPort'#4
+  +'Left'#3#128#0#6'Height'#2#23#3'Top'#2#10#5'Width'#2'P'#8'TabOrder'#2#3#4'Te'
+  +'xt'#6#4'1234'#0#0#11'TActionList'#2'AL'#4'left'#3#152#0#3'top'#2' '#0#7'TAc'
+  +'tion'#8'actStart'#7'Caption'#6#13'Start( Port=)'#9'OnExecute'#7#15'actStart'
+  +'Execute'#8'OnUpdate'#7#14'actStartUpdate'#0#0#7'TAction'#7'actStop'#7'Capti'
+  +'on'#6#4'Stop'#9'OnExecute'#7#14'actStopExecute'#8'OnUpdate'#7#13'actStopUpd'
+  +'ate'#0#0#7'TAction'#11'actClearLog'#7'Caption'#6#9'Clear Log'#9'OnExecute'#7
+  +#18'actClearLogExecute'#0#0#0#0
+]);

wst/trunk/tests/tcp_server/umain.pas

@@ -0,0 +1,98 @@
+unit umain;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
+  StdCtrls, ActnList, ExtCtrls;
+
+type
+
+  { TfMain }
+
+  TfMain = class(TForm)
+    actClearLog: TAction;
+    actStop: TAction;
+    actStart: TAction;
+    AL: TActionList;
+    Button1: TButton;
+    Button2: TButton;
+    edtPort: TEdit;
+    Label1: TLabel;
+    mmoLog: TMemo;
+    procedure actClearLogExecute(Sender: TObject);
+    procedure actStartExecute(Sender: TObject);
+    procedure actStartUpdate(Sender: TObject);
+    procedure actStopExecute(Sender: TObject);
+    procedure actStopUpdate(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+  private
+  public
+    procedure LogMessage(const AMsg : string);
+  end;
+
+var
+  fMain: TfMain;
+
+implementation
+uses server_unit,
+     server_service_soap, server_binary_formatter,
+     calculator, calculator_imp, calculator_binder;
+
+Var
+  scktServer : TTcpSrvApp;
+
+{ TfMain }
+
+procedure TfMain.actStartUpdate(Sender: TObject);
+begin
+  TAction(Sender).Enabled := Not ( Assigned(scktServer) And scktServer.IsActive() );
+end;
+
+procedure TfMain.actStopExecute(Sender: TObject);
+begin
+  If Assigned(scktServer) Then Begin
+    scktServer.Stop();
+  End;
+end;
+
+procedure TfMain.actStopUpdate(Sender: TObject);
+begin
+  TAction(Sender).Enabled := Assigned(scktServer) And scktServer.IsActive();
+end;
+
+procedure TfMain.actStartExecute(Sender: TObject);
+begin
+  mmoLog.Clear();
+  If Not Assigned(scktServer) Then
+    scktServer := TTcpSrvApp.Create();
+  If Not scktServer.IsActive() Then
+    scktServer.Start();
+end;
+
+procedure TfMain.actClearLogExecute(Sender: TObject);
+begin
+  mmoLog.Clear();
+end;
+
+procedure TfMain.FormCreate(Sender: TObject);
+begin
+  Server_service_RegisterCalculatorService();
+  Server_service_RegisterCalculatorService();
+  RegisterCalculatorImplementationFactory();
+  Server_service_RegisterSoapFormat();
+  Server_service_RegisterBinaryFormat();
+end;
+
+procedure TfMain.LogMessage(const AMsg: string);
+begin
+  mmoLog.Lines.Add(AMsg);
+end;
+
+initialization
+  {$I umain.lrs}
+
+end.
+