fpchess: Starts adding AI play via a web service

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1551 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2011-04-07 06:26:28 +00:00
parent 15dc8cfd55
commit f8067222d3
10 changed files with 910 additions and 20 deletions
--- a/applications/fpchess/IDelphiChess.wsdl
+++ b/applications/fpchess/IDelphiChess.wsdl
@ -0,0 +1,33 @@
+<definitions xmlns="http://schemas.xmlsoap.org/wsdl/" xmlns:xs="http://www.w3.org/2001/XMLSchema" name="IDelphiChessservice" targetNamespace="http://eBob42.org/" xmlns:tns="http://eBob42.org/" xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:mime="http://schemas.xmlsoap.org/wsdl/mime/">
+<message name="XML_GetNextMove0Request">
+<part name="Position" type="xs:string"/>
+<part name="WhiteMovesNext" type="xs:boolean"/>
+<part name="SearchDepth" type="xs:int"/>
+</message>
+<message name="XML_GetNextMove0Response">
+<part name="return" type="xs:string"/>
+</message>
+<portType name="IDelphiChess">
+<operation name="XML_GetNextMove">
+<input message="tns:XML_GetNextMove0Request"/>
+<output message="tns:XML_GetNextMove0Response"/>
+</operation>
+</portType>
+<binding name="IDelphiChessbinding" type="tns:IDelphiChess">
+<soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
+<operation name="XML_GetNextMove">
+<soap:operation soapAction="urn:DelphiChess-IDelphiChess#XML_GetNextMove" style="rpc"/>
+<input>
+<soap:body use="encoded" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:DelphiChess-IDelphiChess"/>
+</input>
+<output>
+<soap:body use="encoded" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" namespace="urn:DelphiChess-IDelphiChess"/>
+</output>
+</operation>
+</binding>
+<service name="IDelphiChessservice">
+<port name="IDelphiChessPort" binding="tns:IDelphiChessbinding">
+<soap:address location="http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/soap/IDelphiChess"/>
+</port>
+</service>
+</definitions>
--- a/applications/fpchess/IDelphiChess.wst
+++ b/applications/fpchess/IDelphiChess.wst
@ -0,0 +1,7 @@
+  GetWSTResourceManager().AddResource('IDELPHICHESS',
+    #0#0#0#16'WST_METADATA_0.6'#0#0#0#12'IDelphiChess'#0#1#0#0#0#12'IDelphiChess'
+    +#0#1#0#0#0#15'XML_GetNextMove'#4#0#0#0#8'Position'#0#0#0#6'string'#0#0#0#0#0
+    +#0#0#1#0#0#0#14'WhiteMovesNext'#0#0#0#7'boolean'#0#0#0#0#0#0#0#1#0#0#0#11'Se'
+    +'archDepth'#0#0#0#7'integer'#0#0#0#0#0#0#0#1#0#0#0#6'Result'#0#0#0#6'string'#0
+    +#0#0#0#0#0#0#3''
+  );
--- a/applications/fpchess/IDelphiChessWSDL.pas
+++ b/applications/fpchess/IDelphiChessWSDL.pas
@ -0,0 +1,97 @@
+{
+This unit has been produced by ws_helper.
+  Input unit name : "IDelphiChess".
+  This unit name  : "IDelphiChess".
+  Date            : "10/17/10 08:24:54 AM".
+}
+unit IDelphiChessWSDL;
+{$IFDEF FPC}
+  {$mode objfpc} {$H+}
+{$ENDIF}
+{$IFNDEF FPC}
+  {$DEFINE WST_RECORD_RTTI}
+{$ENDIF}
+interface
+
+uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
+
+const
+  sNAME_SPACE = 'http://eBob42.org/';
+  sUNIT_NAME = 'IDelphiChess';
+
+type
+  IDelphiChess = interface(IInvokable)
+    ['{ECE02B6C-B051-2815-AE82-B2969FFEDC2A}']
+    function XML_GetNextMove(
+      const  Position : string; 
+      const  WhiteMovesNext : boolean; 
+      const  SearchDepth : integer
+    ):string;
+  end;
+
+procedure Register_IDelphiChess_ServiceMetadata();
+
+Implementation
+
+uses metadata_repository, record_rtti, wst_types;
+
+procedure Register_IDelphiChess_ServiceMetadata();
+var
+  mm : IModuleMetadataMngr;
+begin
+  mm := GetModuleMetadataMngr();
+  mm.SetRepositoryNameSpace(sUNIT_NAME, sNAME_SPACE);
+  mm.SetServiceCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'TRANSPORT_Address',
+    'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/soap/IDelphiChess'
+  );
+  mm.SetServiceCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'FORMAT_Style',
+    'rpc'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'XML_GetNextMove',
+    '_E_N_',
+    'XML_GetNextMove'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'XML_GetNextMove',
+    'style',
+    'rpc'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'XML_GetNextMove',
+    'TRANSPORT_soapAction',
+    'urn:DelphiChess-IDelphiChess#XML_GetNextMove'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'XML_GetNextMove',
+    'FORMAT_Input_EncodingStyle',
+    'encoded'
+  );
+  mm.SetOperationCustomData(
+    sUNIT_NAME,
+    'IDelphiChess',
+    'XML_GetNextMove',
+    'FORMAT_OutputEncodingStyle',
+    'encoded'
+  );
+end;
+
+var
+  typeRegistryInstance : TTypeRegistry = nil;
+initialization
+  typeRegistryInstance := GetTypeRegistry();
+end.
--- a/applications/fpchess/IDelphiChess_Intf.pas
+++ b/applications/fpchess/IDelphiChess_Intf.pas
@ -0,0 +1,42 @@
+unit IDelphiChess_Intf;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  IDelphiChessWSDL, IDelphiChess_proxy, chessgame, httpsend;
+
+procedure GetNextMoveFromBorlandWS();
+
+implementation
+
+function ReadEntry(const APromp : string):string ;
+begin
+  Result := '';
+  Write(APromp);
+  while True do begin
+    ReadLn(Result);
+    Result := Trim(Result);
+    if ( Length(Result) > 0 ) then
+      Break;
+  end;
+end;
+
+procedure GetNextMoveFromBorlandWS();
+var
+  locService : IDelphiChess;
+  rsps : string;
+begin
+  Register_IDelphiChess_ServiceMetadata();
+  //  SYNAPSE_RegisterHTTP_Transport();
+
+  locService := wst_CreateInstance_IDelphiChess();
+
+  rsps := locService.XML_GetNextMove(
+    '', True, 5);
+end;
+
+end.
+
--- a/applications/fpchess/IDelphiChess_proxy.pas
+++ b/applications/fpchess/IDelphiChess_proxy.pas
@ -0,0 +1,85 @@
+{
+This unit has been produced by ws_helper.
+  Input unit name : "IDelphiChess".
+  This unit name  : "IDelphiChess_proxy".
+  Date            : "10/17/10 08:24:54 AM".
+}
+
+Unit IDelphiChess_proxy;
+{$IFDEF FPC} {$mode objfpc}{$H+} {$ENDIF}
+Interface
+
+uses SysUtils, Classes, TypInfo, base_service_intf, service_intf, IDelphiChessWSDL;
+
+type
+  TDelphiChess_Proxy=class(TBaseProxy,IDelphiChess)
+  Protected
+    class function GetServiceType() : PTypeInfo;override;
+    function XML_GetNextMove(
+      const  Position : string; 
+      const  WhiteMovesNext : boolean; 
+      const  SearchDepth : integer
+    ):string;
+  end;
+
+  Function wst_CreateInstance_IDelphiChess(const AFormat : string = 'SOAP:'; const ATransport : string = 'HTTP:'; const AAddress : string = ''):IDelphiChess;
+
+Implementation
+
+uses wst_resources_imp, metadata_repository;
+
+Function wst_CreateInstance_IDelphiChess(const AFormat : string; const ATransport : string; const AAddress : string):IDelphiChess;
+Var
+  locAdr : string;
+Begin
+  locAdr := AAddress;
+  if ( locAdr = '' ) then
+    locAdr := GetServiceDefaultAddress(TypeInfo(IDelphiChess));
+  Result := TDelphiChess_Proxy.Create('IDelphiChess',AFormat+GetServiceDefaultFormatProperties(TypeInfo(IDelphiChess)),ATransport + 'address=' + locAdr);
+End;
+
+{ TDelphiChess_Proxy implementation }
+
+class function TDelphiChess_Proxy.GetServiceType() : PTypeInfo;
+begin
+  result := TypeInfo(IDelphiChess);
+end;
+
+function TDelphiChess_Proxy.XML_GetNextMove(
+  const  Position : string; 
+  const  WhiteMovesNext : boolean; 
+  const  SearchDepth : integer
+):string;
+Var
+  locSerializer : IFormatterClient;
+  locCallContext : ICallContext;
+  locStrPrmName : string;
+Begin
+  locCallContext := Self as ICallContext;
+  locSerializer := GetSerializer();
+  Try
+    locSerializer.BeginCall('XML_GetNextMove', GetTarget(),locCallContext);
+      locSerializer.Put('Position', TypeInfo(string), Position);
+      locSerializer.Put('WhiteMovesNext', TypeInfo(boolean), WhiteMovesNext);
+      locSerializer.Put('SearchDepth', TypeInfo(integer), SearchDepth);
+    locSerializer.EndCall();
+
+    MakeCall();
+
+    locSerializer.BeginCallRead(locCallContext);
+      locStrPrmName := 'return';
+      locSerializer.Get(TypeInfo(string), locStrPrmName, Result);
+
+  Finally
+    locSerializer.Clear();
+  End;
+End;
+
+
+initialization
+  {$i IDelphiChess.wst}
+
+  {$IF DECLARED(Register_IDelphiChess_ServiceMetadata)}
+  Register_IDelphiChess_ServiceMetadata();
+  {$IFEND}
+End.
--- a/applications/fpchess/fpchess.lpi
+++ b/applications/fpchess/fpchess.lpi
@ -30,15 +30,18 @@
        <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
      </local>
    </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="3">
      <Item1>
-        <PackageName Value="lnetvisual"/>
+        <PackageName Value="laz_synapse"/>
      </Item1>
      <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="wst_synapse"/>
      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
    </RequiredPackages>
-    <Units Count="6">
+    <Units Count="11">
      <Unit0>
        <Filename Value="fpchess.lpr"/>
        <IsPartOfProject Value="True"/>
@ -71,6 +74,29 @@
        <IsPartOfProject Value="True"/>
        <UnitName Value="chesstcputils"/>
      </Unit5>
+      <Unit6>
+        <Filename Value="IDelphiChess.wsdl"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="IDelphiChessWSDL.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="IDelphiChessWSDL"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="IDelphiChess_proxy.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="IDelphiChess_proxy"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="IDelphiChess.wst"/>
+        <IsPartOfProject Value="True"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="IDelphiChess_Intf.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="IDelphiChess_Intf"/>
+      </Unit10>
    </Units>
  </ProjectOptions>
  <CompilerOptions>
--- a/applications/fpchess/fpchess.lpr
+++ b/applications/fpchess/fpchess.lpr
@ -7,8 +7,8 @@ uses
  cthreads,
  {$ENDIF}{$ENDIF}
  Interfaces, // this includes the LCL widgetset
-  Forms, lnetvisual, mainform, chessdrawer, chessgame, chessconfig,
-  chesstcputils;
+  Forms, laz_synapse, mainform, chessdrawer, chessgame, chessconfig,
+  chesstcputils, IDelphiChess_Intf, wst_synapse;

 //{$R *.res}

--- a/applications/fpchess/mainform.lfm
+++ b/applications/fpchess/mainform.lfm
@ -147,12 +147,12 @@ object formChess: TformChess
        OnClick = HandleMainScreenButton
        TabOrder = 7
      end
-      object btnWebservice: TBitBtn
+      object btnAI: TBitBtn
        Left = 24
        Height = 30
        Top = 320
        Width = 304
-        Caption = 'Play with a friend through the chess Webservice'
+        Caption = 'Play against the Computer'
        OnClick = HandleMainScreenButton
        TabOrder = 8
      end
@ -303,13 +303,43 @@ object formChess: TformChess
        TabOrder = 0
        Text = 'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/wsdl/IDelphiChess'
      end
-      object Button1: TButton
-        Left = 35
+      object btnPlayAgainstAI: TButton
+        Left = 64
        Height = 25
-        Top = 140
-        Width = 75
-        Caption = 'Button1'
+        Top = 160
+        Width = 224
+        Caption = 'Start game'
+        OnClick = btnPlayAgainstAIClick
+        TabOrder = 0
+      end
+      object Label9: TLabel
+        Left = 8
+        Height = 30
+        Top = 40
+        Width = 352
+        AutoSize = False
+        Caption = 'The artificial intelligence is obtained from the Borland Chess WebService.'
+        ParentColor = False
+        WordWrap = True
+      end
+      object editWebServiceAI: TLabeledEdit
+        Left = 8
+        Height = 22
+        Top = 96
+        Width = 344
+        EditLabel.AnchorSideLeft.Control = editWebServiceAI
+        EditLabel.AnchorSideTop.Control = editWebServiceAI
+        EditLabel.AnchorSideTop.Side = asrCenter
+        EditLabel.AnchorSideRight.Control = editWebServiceAI
+        EditLabel.AnchorSideBottom.Control = editWebServiceAI
+        EditLabel.Left = 8
+        EditLabel.Height = 17
+        EditLabel.Top = 76
+        EditLabel.Width = 104
+        EditLabel.Caption = 'Web Service URL'
+        EditLabel.ParentColor = False
        TabOrder = 1
+        Text = 'http://www.bobswart.nl/cgi-bin/ChessISAPIServer.dll/wsdl/IDelphiChess'
      end
    end
  end
--- a/applications/fpchess/mainform.pas
+++ b/applications/fpchess/mainform.pas
@ -8,6 +8,8 @@ uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin,
  //
+  IDelphiChess_Intf,
+  //
  chessdrawer, chessgame, chessconfig, chesstcputils;

 type
@ -27,15 +29,14 @@ type

  TformChess = class(TForm)
    btnConnect: TBitBtn;
-    btnWebservice: TBitBtn;
+    btnAI: TBitBtn;
    btnSinglePlayer: TBitBtn;
    btnDirectComm: TBitBtn;
    BitBtn3: TBitBtn;
    btnHotSeat: TBitBtn;
-    Button1: TButton;
+    btnPlayAgainstAI: TButton;
    checkTimer: TCheckBox;
    comboStartColor: TComboBox;
-    editWebserviceURL: TLabeledEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
@ -44,6 +45,8 @@ type
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
+    Label9: TLabel;
+    editWebServiceAI: TLabeledEdit;
    labelPos: TLabel;
    editRemoteID: TLabeledEdit;
    editLocalIP: TLabeledEdit;
@ -58,6 +61,7 @@ type
    timerChessTimer: TTimer;
    pageWebservice: TPage;
    procedure btnConnectClick(Sender: TObject);
+    procedure btnPlayAgainstAIClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HandleMainScreenButton(Sender: TObject);
    procedure pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer);
@ -67,7 +71,8 @@ type
  public
    { public declarations }
    procedure UpdateCaptions;
-  end; 
+    procedure InitializeGameModel;
+  end;

 var
  formChess: TformChess;
@ -82,6 +87,7 @@ const
  INT_PAGE_CONFIGCONNECTION = 1;
  INT_PAGE_CONNECTING = 2;
  INT_PAGE_GAME = 3;
+  INT_PAGE_AI = 4;

 { TformChess }

@ -90,14 +96,15 @@ begin
  if Sender = btnSinglePlayer then
  begin
    notebookMain.PageIndex := INT_PAGE_GAME;
-    vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value);
+    InitializeGameModel();
  end
  else if Sender = btnHotSeat then
  begin
    notebookMain.PageIndex := INT_PAGE_GAME;
-    vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value);
+    InitializeGameModel();
  end
-  else if Sender = btnDirectComm then notebookMain.PageIndex := INT_PAGE_CONFIGCONNECTION;
+  else if Sender = btnDirectComm then notebookMain.PageIndex := INT_PAGE_CONFIGCONNECTION
+  else if Sender = btnAI then notebookMain.PageIndex := INT_PAGE_AI;
 end;

 procedure TformChess.pageBeforeShow(Sender: TObject; ANewPage: TPage; ANewIndex: Integer);
@ -130,6 +137,11 @@ begin
  formChess.labelPos.Caption := lStr;
 end;

+procedure TformChess.InitializeGameModel;
+begin
+  vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value);
+end;
+
 procedure TformChess.FormCreate(Sender: TObject);
 begin
  // Creation of internal components
@ -151,6 +163,16 @@ begin

 end;

+procedure TformChess.btnPlayAgainstAIClick(Sender: TObject);
+begin
+  InitializeGameModel();
+
+  notebookMain.PageIndex := INT_PAGE_GAME;
+
+  if comboStartColor.ItemIndex = 0 then
+    GetNextMoveFromBorlandWS();
+end;
+
 { TFormDrawerDelegate }

 procedure TFormDrawerDelegate.HandleMouseMove(Sender: TObject;
--- a/applications/fpchess/tcpcomm.pas
+++ b/applications/fpchess/tcpcomm.pas
@ -0,0 +1,548 @@
+{
+ fpChess - TCP communication module
+
+ License: GPL version 2 or superior
+
+ Copyright: Felipe Monteiro de Carvalho in 2010
+}
+unit tcpcomm;
+
+{$mode objfpc}{$H+}{$packsets 1}
+
+interface
+
+uses
+  // RTL, FLC, LCL
+  Classes, SysUtils, Forms,
+  //  TPacket declaration
+  chessgame,
+  // LNet
+  lnet, lnetcomponents
+  ;
+
+type
+  TProgressEvent = procedure (AStr: string; APorcent: Integer) of object;
+
+  { TSimpleTcpConnection }
+
+  TSimpleTcpConnection = class
+  private
+    FConnectionFinished: Boolean;
+    FEvent: THandle;
+    FIP: string;
+    FPort: Word;
+    FConnected: Boolean;
+    FSocket: TLTcpComponent;
+    ReceivedPacketsStart: TPacket;
+    ReceivedPacketsEnd: TPacket;
+    FOnProgress: TProgressEvent;
+    // Variables to read fragmented packets
+    UnfinishedPacket: TPacket;
+    UnfinishedPacketPos: Word;
+    procedure SendPacket(Packet: TPacket);
+    function ReceivePacket(ATimeOut: Word = 10000): TPacket;
+    function HashInList(APacket: TPacket; AHashes: array of Cardinal): Boolean;
+  protected
+    function Handshake: Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddPacketToList(Packet: TPacket);
+    procedure RemovePacketFromList(Packet: TPacket);
+    function GetConnected: Boolean;
+    function PacketPending: Boolean;
+    function GetNextMessage(AID: Cardinal): TPacket;
+    function Reconnect: Integer;
+    function Connect(AIP: string; APort: Integer; ATimeOut: Word = 10000): Boolean;
+    procedure Disconnect(ATimeOut: Word = 1000);
+    procedure Shutdown;
+    procedure DebugOutputMessageList();
+    // Events for LNet
+    procedure OnConnect(aSocket: TLSocket);
+    procedure OnErrorEvent(const msg: string; aSocket: TLSocket);
+    procedure OnReceive(aSocket: TLSocket);
+    procedure OnDisconnect(aSocket: TLSocket);
+    // Properties
+    property Connected: Boolean read GetConnected;
+    {@@
+      Indicates that the connection procedure, which is event-based, was finished.
+      See Connected to check if the connection was successful.
+
+      @see Connected
+    }
+    property ConnectionFinished: Boolean read FConnectionFinished write FConnectionFinished;
+  end;
+
+  ETcpTransportException = class(Exception);
+  EHandshakeException = class(ETcpTransportException);
+  ECryptoException = class(ETcpTransportException);
+
+function GetConnection(): TSimpleTcpConnection;
+
+implementation
+
+resourcestring
+  SInvalidDataPacket = 'Invalid data packet format';
+
+var
+  ClientConnection: TSimpleTcpConnection = nil;
+
+procedure OPDebugLn(AStr: string);
+begin
+  {$ifndef Win32}
+  WriteLn(AStr);
+  {$endif}
+end;
+
+function GetConnection(): TSimpleTcpConnection;
+begin
+  if ClientConnection = nil then
+    ClientConnection := TSimpleTcpConnection.Create();
+  Result := ClientConnection;
+end;
+
+{ TOPCTcpConnection }
+
+constructor TSimpleTcpConnection.Create;
+begin
+  {$ifdef Synapse}
+  FSocket := TTCPBlockSocket.Create;
+  {$else}
+  FSocket := TLTcpComponent.Create(nil);
+  FSocket.OnConnect := @OnConnect;
+  FSocket.OnError := @OnErrorEvent;
+  FSocket.OnReceive := @OnReceive;
+  FSocket.OnDisconnect := @OnDisconnect;
+  FSocket.Timeout:= 1000;
+  {$endif}
+end;
+
+function TSimpleTcpConnection.PacketPending: Boolean;
+begin
+//  Result := FSocket.PacketPending(SizeOf(TPacketHeader));
+end;
+
+{@@
+  Connects to a given server. This function is synchronous.
+
+  @param API      Server name or IP
+  @param APort    Server port
+  @param ATimeOut The maximum time to wait for an answer of the server,
+                  in miliseconds.
+}
+function TSimpleTcpConnection.Connect(AIP: string; APort: Integer;
+  ATimeOut: Word = 10000): Boolean;
+var
+  Packet: TPacket;
+  i: Integer;
+begin
+  OPDebugLn('[TSimpleTcpConnection.Connect] START');
+  Result := False;
+  FIP := AIP;
+  FPort := APort;
+  FConnectionFinished := False;
+
+  if Assigned(FOnProgress) then FOnProgress('', 30); // Values between 20 and 60
+  FSocket.Connect(FIP, FPort);
+
+  // Wait for either OnConnect or OnErrorEvent
+  for i := 0 to ATimeOut div 10 do
+  begin
+    if FConnectionFinished then
+    begin
+      if Assigned(FOnProgress) then
+        FOnProgress('Conection Response arrived', 40); // Values between 20 and 60
+      Break;
+    end;
+    Sleep(10);
+    Application.ProcessMessages;
+  end;
+
+  if not Connected then
+    raise Exception.Create('[TSimpleTcpConnection.Connect] Connection Timeout');
+
+  if Assigned(FOnProgress) then FOnProgress('Executing Handshake', 60);
+  Handshake;
+
+  Result := True;
+
+  OPDebugLn('[TSimpleTcpConnection.Connect] END');
+end;
+
+function TSimpleTcpConnection.Reconnect: Integer;
+var
+  Packet: TPacket;
+begin
+//  Result := RC_NOT_RESTORED;
+{  if FSocket <> nil then FSocket.Free;
+  FSocket := TWinSocket.Create;
+  try
+    FSocket.Connect(FHostName, FHostIP, FServiceName, FServicePort);
+    Assert(FConnectionCookie <> nil);
+    FConnectionCookie.ResetPosition;
+    SendPacket(FConnectionCookie);
+    Packet := ReceivePacket;
+    case Packet.Action of
+
+      asCookie:
+      // positive response on reconnect - connection found by cookie
+        begin
+          FConnectionCookie := Packet;
+          Result := RC_RESTORED
+        end;
+
+      asRestart:
+      // No corresponding connection found on server. Client should be restarted
+        begin
+          FConnectionCookie := Packet;
+          FConnectionCookie.Action := asCookie;
+          Result := RC_FAIL
+        end;
+
+      else
+        Assert(False);
+    end;
+  except
+    FSocket.Free;
+    FSocket := nil;
+    Result := RC_NOT_RESTORED;
+  end;}
+end;
+
+destructor TSimpleTcpConnection.Destroy;
+begin
+  if Connected then Disconnect;
+  FSocket.Free;
+  inherited;
+end;
+
+procedure TSimpleTcpConnection.Disconnect(ATimeOut: Word = 1000);
+var
+  i: Integer;
+begin
+  {$ifdef Synapse}
+  FSocket.CloseSocket;
+  {$else}
+  FSocket.Disconnect();
+  {$endif}
+
+  for i := 0 to ATimeOut div 10 do
+  begin
+    if not FConnected then Break;
+    Sleep(10);
+    Application.ProcessMessages;
+  end;
+
+  if FConnected then
+    OPDebugLn('[TSimpleTcpConnection.Disconnect] Disconection failed');
+end;
+
+function TSimpleTcpConnection.GetConnected: Boolean;
+begin
+  Result := (FSocket <> nil) and FConnected;
+end;
+
+function TSimpleTcpConnection.GetNextMessage(AID: Cardinal): TPacket;
+var
+  CurrentPacket: TPacket;
+  PacketFound: Boolean = False;
+begin
+  Result := nil;
+
+  // Search the packets in the linked list
+  CurrentPacket := ReceivedPacketsStart;
+  while CurrentPacket <> nil do
+  begin
+    if (CurrentPacket.ID = AID) then
+    begin
+      PacketFound := True;
+      Break;
+    end;
+
+    CurrentPacket := CurrentPacket.Next;
+  end;
+
+  if not PacketFound then Exit;
+
+  // Convert the Packet to a DataBlock
+  Result := CurrentPacket;
+
+  // Remove the packet from the list
+  RemovePacketFromList(CurrentPacket);
+end;
+
+{@@
+  First step when disconnecting from the server
+
+  @see Disconnect
+}
+procedure TSimpleTcpConnection.Shutdown;
+var
+  Packet: TPacket;
+begin
+{  try
+    Packet := TPacket.Create(asShutdown, nil^, 0);
+    SendPacket(Packet);
+    Packet.Free;
+  except
+    // eat exception for user pleasure
+  end;}
+end;
+
+procedure TSimpleTcpConnection.DebugOutputMessageList();
+var
+  CurPacket: TPacket;
+  lHash: LongWord;
+begin
+  OPDebugLn('[TSimpleTcpConnection.DebugOutputMessageList]');
+  CurPacket := ReceivedPacketsStart;
+  while CurPacket <> nil do
+  begin
+    lHash := CurPacket.ID;
+    OPDebugLn(Format('[Packege] Hash %d', [lHash]));
+
+    CurPacket := CurPacket.Next;
+  end;
+  // Variables to read fragmented packets
+  if UnfinishedPacket <> nil then
+    OPDebugLn('[There is an unfinished packege]');
+end;
+
+{@@
+  Event called by LNet indicating that the connection was finished successfully
+}
+procedure TSimpleTcpConnection.OnConnect(aSocket: TLSocket);
+begin
+  FConnectionFinished := True;
+  FConnected := True;
+end;
+
+{@@
+  Event called by LNet when an error occured in the Connection
+}
+procedure TSimpleTcpConnection.OnErrorEvent(const msg: string; aSocket: TLSocket);
+begin
+  FConnectionFinished := True;
+  FConnected := False;
+end;
+
+{@@
+  Event called by LNet when data is available to be read
+}
+procedure TSimpleTcpConnection.OnReceive(aSocket: TLSocket);
+var
+  lPacket: TPacket;
+  lFreePacket: Boolean;
+  i, lPos, lRemaining, lSizeRead: Integer;
+begin
+  OPDebugLn('[TSimpleTcpConnection.OnReceive] BEGIN');
+  repeat
+    // Finishes reading a fragmented packet
+    if UnfinishedPacket <> nil then
+    begin
+      OPDebugLn('[TSimpleTcpConnection.OnReceive] Another part of a fragmented packet');
+{      lPacket := UnfinishedPacket;
+
+      // Gets the data
+      lRemaining := lPacket.DataSize - UnfinishedPacketPos;
+      lSizeRead := ASocket.Get(lPacket.Data[UnfinishedPacketPos], lRemaining);
+      if lSizeRead = lRemaining then
+      begin
+        OPDebugLn('[TSimpleTcpConnection.OnReceive] Read fragmented packet to the end');
+        UnfinishedPacket := nil;
+        AddPacketToList(lPacket);
+      end
+      else
+      begin
+        OPDebugLn('[TSimpleTcpConnection.OnReceive] Fragmented packet not yet finished, read: '
+          + IntToStr(lSizeRead));
+        UnfinishedPacketPos := UnfinishedPacketPos + lSizeRead;
+        OPDebugLn('[TSimpleTcpConnection.OnReceive] END');
+        Break;
+      end;}
+    end
+    else
+    // Reads a new packet
+    begin
+      lPacket := TPacket.Create;
+      lFreePacket := True;
+
+      try
+        // Gets the header
+        lSizeRead := ASocket.Get(lPacket.ID, 4);
+        if lSizeRead < 4 then // Expected if there are no more packets
+        begin
+          OPDebugLn('[TSimpleTcpConnection.OnReceive] END');
+          Exit;
+        end;
+        OPDebugLn('[TSimpleTcpConnection.OnReceive] ID: ' + IntToHex(Integer(lPacket.ID), 2));
+
+        lSizeRead := ASocket.Get(lPacket.Kind, 1);
+        if lSizeRead < 1 then
+        begin
+          OPDebugLn('[TSimpleTcpConnection.OnReceive] Packet ended in lPacket.Kind');
+          Exit;
+        end;
+        OPDebugLn('[TSimpleTcpConnection.OnReceive] Kind: ' + IntToHex(
+          {$ifdef VER2_4}Cardinal{$else}Byte{$endif}(lPacket.Kind), 2)); // Byte for FPC 2.5+
+
+        if lPacket.Kind = pkMove then
+        begin
+          lSizeRead := ASocket.Get(lPacket.MoveStartX, 1);
+{          if lSizeRead < 1 then
+          begin
+            OPDebugLn('[TSimpleTcpConnection.OnReceive] Packet ended in MoveStartX');
+            Exit;
+          end;
+          OPDebugLn('[TSimpleTcpConnection.OnReceive] MoveStartX: ' + IntToStr(lPacket.MoveStartX));}
+
+          lSizeRead := ASocket.Get(lPacket.MoveStartY, 1);
+          lSizeRead := ASocket.Get(lPacket.MoveEndX, 1);
+          lSizeRead := ASocket.Get(lPacket.MoveEndY, 1);
+        end;
+
+        // Because most packets are crypted, the raw data isn't very useful
+  //      OPDebugData('[TSimpleTcpConnection.OnReceive]', lPacket.Data, lPacket.DataSize);
+
+        // Updates the linked list
+        lFreePacket := False;
+        AddPacketToList(lPacket);
+      finally
+        if lFreePacket then lPacket.Free;
+      end;
+    end;
+  until (lSizeRead = 0);
+  OPDebugLn('[TSimpleTcpConnection.OnReceive] END');
+end;
+
+{@@
+  Event of the LNet server. Happens when the disconnection procedure is
+  finished or when a disconnection occurs for another reason.
+}
+procedure TSimpleTcpConnection.OnDisconnect(aSocket: TLSocket);
+begin
+  FConnectionFinished := True;
+  FConnected := False;
+  OPDebugLn('[TSimpleTcpConnection.OnDisconnect] Disconnected from server');
+end;
+
+function TSimpleTcpConnection.Handshake: Boolean;
+begin
+  OPDebugLn('[TSimpleTcpConnection.Handshake] START');
+
+  Result := True;
+
+  OPDebugLn('[TSimpleTcpConnection.Handshake] END');
+end;
+
+procedure CheckCryptoResult(Result: Integer);
+begin
+//  if Result <> 1 then
+//    raise ECryptoException.Create(ERR_error_string(ERR_get_error, nil));
+end;
+
+{@@
+  Returns the next received packet in the line or waits until one
+  arrives to a maximum of ATimeOut miliseconds. Returns nil in case
+  of a timeout of the packet otherwise.
+}
+function TSimpleTcpConnection.ReceivePacket(ATimeOut: Word = 10000): TPacket;
+var
+  i: Integer;
+begin
+  OPDebugLn('[TSimpleTcpConnection.ReceivePacket]');
+
+  Result := nil;
+
+  for i := 0 to ATimeOut div 10 do
+  begin
+    // Takes one Packet from the linked list
+    if ReceivedPacketsStart <> nil then
+    begin
+      Result := ReceivedPacketsStart;
+
+      if ReceivedPacketsStart = ReceivedPacketsEnd then
+      begin
+        ReceivedPacketsStart := nil;
+        ReceivedPacketsEnd := nil;
+      end
+      else
+        ReceivedPacketsStart := ReceivedPacketsStart.Next;
+
+      Break;
+    end;
+    Application.ProcessMessages;
+    Sleep(10);
+  end;
+end;
+
+function TSimpleTcpConnection.HashInList(APacket: TPacket;
+  AHashes: array of Cardinal): Boolean;
+var
+  lHash: Cardinal;
+  i: Integer;
+begin
+  Result := False;
+  lHash := APacket.ID;
+  for i := 0 to Length(AHashes) - 1 do
+    if lHash = AHashes[i] then Exit(True);
+end;
+
+procedure TSimpleTcpConnection.AddPacketToList(Packet: TPacket);
+begin
+  if ReceivedPacketsStart = nil then
+    ReceivedPacketsStart := Packet
+  else
+    ReceivedPacketsEnd.Next := Packet;
+  ReceivedPacketsEnd := Packet;
+end;
+
+procedure TSimpleTcpConnection.RemovePacketFromList(Packet: TPacket);
+var
+  CurPacket, PreviousPacket: TPacket;
+begin
+  // First find the previous packet
+  PreviousPacket := nil;
+  CurPacket := ReceivedPacketsStart;
+  while CurPacket <> nil do
+  begin
+    if CurPacket.Next = Packet then
+    begin
+      PreviousPacket := CurPacket;
+      Break;
+    end;
+
+    CurPacket := CurPacket.Next;
+  end;
+
+  // Now fix the packets array
+  if Packet = ReceivedPacketsStart then
+    ReceivedPacketsStart := Packet.Next;
+
+  if Packet = ReceivedPacketsEnd then
+    ReceivedPacketsEnd := PreviousPacket;
+
+  if PreviousPacket <> nil then
+    PreviousPacket.Next := Packet.Next;
+
+  // And finally free it
+//  Packet.Free;
+end;
+
+procedure TSimpleTcpConnection.SendPacket(Packet: TPacket);
+var
+  lSize: Integer;
+begin
+  FSocket.Send(Packet.ID, 4);
+  FSocket.Send(Packet.Kind, 1);
+  if Packet.Kind = pkMove then
+  begin
+    FSocket.Send(Packet.MoveStartX, 1);
+    FSocket.Send(Packet.MoveStartY, 1);
+    FSocket.Send(Packet.MoveEndX, 1);
+    FSocket.Send(Packet.MoveEndY, 1);
+  end;
+end;
+
+end.
+