diff --git a/applications/fpchess/IDelphiChess.wsdl b/applications/fpchess/IDelphiChess.wsdl new file mode 100644 index 000000000..3b2ad99ac --- /dev/null +++ b/applications/fpchess/IDelphiChess.wsdl @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/fpchess/IDelphiChess.wst b/applications/fpchess/IDelphiChess.wst new file mode 100644 index 000000000..b85ef0c30 --- /dev/null +++ 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'' + ); \ No newline at end of file diff --git a/applications/fpchess/IDelphiChessWSDL.pas b/applications/fpchess/IDelphiChessWSDL.pas new file mode 100644 index 000000000..c456c5d0f --- /dev/null +++ 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. diff --git a/applications/fpchess/IDelphiChess_Intf.pas b/applications/fpchess/IDelphiChess_Intf.pas new file mode 100644 index 000000000..601538ec5 --- /dev/null +++ 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. + diff --git a/applications/fpchess/IDelphiChess_proxy.pas b/applications/fpchess/IDelphiChess_proxy.pas new file mode 100644 index 000000000..6967c0b3c --- /dev/null +++ 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. diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index 710219b0d..93d255c2b 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -30,15 +30,18 @@ - + - + - + + + + - + @@ -71,6 +74,29 @@ + + + + + + + + + + + + + + + + + + + + + + + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index 3c0d5b90c..bb6e9c140 100644 --- 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} diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 9492557a9..2174b419c 100644 --- 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 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index d17ab1fad..81b965b37 100644 --- 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; diff --git a/applications/fpchess/tcpcomm.pas b/applications/fpchess/tcpcomm.pas new file mode 100644 index 000000000..0319b8d06 --- /dev/null +++ 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. +