Websocket Client implementation and Example

examples/chatClient.lpi

@@ -0,0 +1,97 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="chatClient"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <Units Count="5">
+      <Unit0>
+        <Filename Value="chatClient.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="..\src\websocketsclient.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="WebsocketsClient"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="..\src\wsmessages.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="..\src\wsstream.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="..\src\wsutils.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit4>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="chatClient"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="..\src"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <CodeGeneration>
+      <Checks>
+        <IOChecks Value="True"/>
+        <RangeChecks Value="True"/>
+        <OverflowChecks Value="True"/>
+        <StackChecks Value="True"/>
+      </Checks>
+      <VerifyObjMethodCallValidity Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

examples/chatClient.pas

@@ -0,0 +1,150 @@
+program chatClient;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,{$ENDIF}
+  Classes,
+  sysutils,
+  wsutils,
+  wsmessages,
+  wsstream,
+  ssockets,
+  WebsocketsClient;
+
+type
+
+  { TRecieverThread }
+
+  TRecieverThread = class(TThread)
+  private
+    FCommunicator: TWebsocketCommunincator;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(ACommunicator: TWebsocketCommunincator);
+  end;
+
+  { TSimpleChat }
+
+  TSimpleChat = class
+  private      
+    FReciever: TRecieverThread;
+    FCommunicator: TWebsocketCommunincator;
+    procedure RecieveMessage(Sender: TObject);
+    procedure StreamClosed(Sender: TObject);
+  public            
+    procedure Execute;
+    constructor Create(ACommunicator: TWebsocketCommunincator);
+    destructor Destroy; override;
+  end;
+
+{ TSimpleChat }
+
+procedure TSimpleChat.StreamClosed(Sender: TObject);
+begin
+  WriteLn('Connection to ', FCommunicator.SocketStream.RemoteAddress.Address, ' closed');
+end;
+
+procedure TSimpleChat.RecieveMessage(Sender: TObject);
+var
+  MsgList: TWebsocketMessageOwnerList;
+  m: TWebsocketMessage;
+begin
+  MsgList := TWebsocketMessageOwnerList.Create(True);
+  try
+    FCommunicator.GetUnprocessedMessages(MsgList);
+    for m in MsgList do
+      if m is TWebsocketStringMessage then
+        WriteLn('Message from ', FCommunicator.SocketStream.RemoteAddress.Address, ': ', TWebsocketStringMessage(m).Data)
+      else if m is TWebsocketPongMessage then
+        WriteLn('Pong from ', FCommunicator.SocketStream.RemoteAddress.Address, ': ', TWebsocketPongMessage(m).Data);
+  finally
+    MsgList.Free;
+  end;
+end;
+
+procedure TSimpleChat.Execute;
+var
+  str: String;
+begin
+  while FCommunicator.Open do
+  begin
+    ReadLn(str);
+    if not FCommunicator.Open then
+      Exit;
+    if str = 'exit' then
+    begin
+      FCommunicator.WriteMessage(wmtClose).Free;
+      while FCommunicator.Open do
+        Sleep(100);
+    end
+    else if str.StartsWith('ping') then
+      with FCommunicator.WriteMessage(wmtPing) do
+      try
+        WriteRaw(str.Substring(5));
+      finally
+        Free;
+      end
+    else
+      with FCommunicator.WriteMessage do
+      try
+        WriteRaw(str);
+      finally
+        Free;
+      end;
+  end;
+end;
+
+constructor TSimpleChat.Create(ACommunicator: TWebsocketCommunincator);
+begin
+  FCommunicator := ACommunicator;
+  FCommunicator.OnClose:=@StreamClosed;
+  FCommunicator.OnRecieveMessage:=@RecieveMessage;
+  FReciever := TRecieverThread.Create(ACommunicator);
+end;
+
+destructor TSimpleChat.Destroy;
+begin
+  while not FReciever.Finished do
+    Sleep(10);
+  FReciever.Free;
+  FCommunicator.Free;
+  inherited Destroy;
+end;
+
+{ TRecieverThread }
+
+procedure TRecieverThread.Execute;
+begin
+  while not Terminated and FCommunicator.Open do
+  begin
+    FCommunicator.RecieveMessage;
+    Sleep(100);
+  end;
+end;
+
+constructor TRecieverThread.Create(ACommunicator: TWebsocketCommunincator);
+begin
+  FCommunicator := ACommunicator;
+  inherited Create(False);
+end;
+
+var
+  client: TWebsocketClient;
+  chat: TSimpleChat;
+begin
+  client := TWebsocketClient.Create('127.0.0.1', 8080);
+  try
+    chat := TSimpleChat.Create(client.Connect(TSocketHandler.Create));
+    try
+      chat.Execute;
+    finally
+      chat.Free;
+    end;
+  finally
+    client.Free;
+  end;
+end.
+

examples/makefile

@@ -1,4 +1,4 @@
-all: bin bin/chatServer
+all: bin bin/chatServer bin/chatClient
 
 FPC_OPT=-g -gh -Ci -Cr -Co -Ct -CR -Sa