Skip to content

Commit

Permalink
Project31WinHTTPEchoServer FPC project merged from pull/73 + add a se…
Browse files Browse the repository at this point in the history 
…ndall command
  • Loading branch information
@pavelmash
pavelmash committed Apr 22, 2018
1 parent d8566e8 commit a0bf0d0
Show file tree
Hide file tree
Showing 2 changed files with 124 additions and 20 deletions.
70 changes: 50 additions & 20 deletions SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.dpr
View file
@@ -1,15 +1,18 @@
program Project31WinHTTPEchoServer;

{$IFDEF FPC}
{$MODE Delphi}

This comment has been minimized.

Sign in to view

Copy link
@synopse

synopse Apr 23, 2018

Owner

Use {$I Synopse.inc} here instead.

This comment has been minimized.

Sign in to view

Copy link
@pavelmash

pavelmash Apr 23, 2018

Author Collaborator

Yes, I will
{$ENDIF}

{$APPTYPE CONSOLE}

uses
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
SysUtils,
Windows,
SynZip,
SynCrtSock,
SynCommons;

{$APPTYPE CONSOLE}

type
TSimpleWebsocketServer = class
private
Expand All @@ -18,8 +21,8 @@ type
function onHttpRequest(Ctxt: THttpServerRequest): cardinal;
function onAccept(Ctxt: THttpServerRequest; var Conn: THttpApiWebSocketConnection): Boolean;
procedure onConnect(const Conn: THttpApiWebSocketConnection );
procedure onMessage(const Conn: THttpApiWebSocketConnection; aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: ULONG);
procedure onDisconnect(const Conn: THttpApiWebSocketConnection ; aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: ULONG);
procedure onMessage(const Conn: THttpApiWebSocketConnection; aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: Cardinal);
procedure onDisconnect(const Conn: THttpApiWebSocketConnection ; aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
public
constructor Create;
destructor Destroy; override;
Expand Down Expand Up @@ -53,11 +56,11 @@ end;

procedure TSimpleWebsocketServer.onConnect(const Conn: THttpApiWebSocketConnection);
begin
Writeln('Connected ', Conn.index);
Writeln('New connection. Assigned connectionID=', Conn.index);
end;

procedure TSimpleWebsocketServer.onDisconnect(const Conn: THttpApiWebSocketConnection;
aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: ULONG);
aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
var
str: RawUTF8;
begin
Expand All @@ -78,28 +81,29 @@ begin
end;

procedure TSimpleWebsocketServer.onMessage(const Conn: THttpApiWebSocketConnection;
aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: ULONG);
aBufferType: WEB_SOCKET_BUFFER_TYPE; aBuffer: Pointer; aBufferSize: Cardinal);
var
str: RawUTF8;
begin
Conn.Send(aBufferType, aBuffer, aBufferSize);
// Conn.Protocol.Send(Conn.index, aBufferType, aBuffer, aBufferSize); //also work
SetString(str, pUtf8Char(aBuffer), aBufferSize);
if aBufferType = WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE then
Writeln('UTF8 message from ', Conn.index, ' ',str)
Writeln('UTF8 message from ', Conn.index, ': ',str)
else if aBufferType = WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE then
Writeln('UTF8 fragment from ', Conn.index, ' ',str)
Writeln('UTF8 fragment from ', Conn.index, ': ',str)
else if (aBufferType = WEB_SOCKET_BINARY_MESSAGE_BUFFER_TYPE)
or (aBufferType = WEB_SOCKET_BINARY_FRAGMENT_BUFFER_TYPE) then
Writeln(aBufferType, ' from ', Conn.index, ' of length ', aBufferSize)
else begin
Writeln(aBufferType, ' from ', Conn.index, ' ',str);
Writeln(aBufferType, ' from ', Conn.index, ': ',str);
end;
end;

var
_Server: TSimpleWebsocketServer;
s: string;
idx: integer;
MsgBuffer: RawUTF8;
CloseReasonBuffer: RawUTF8;
begin
Expand All @@ -110,21 +114,47 @@ begin
try
Writeln('WebSocket server is now listen on ws://localhost:8888/whatever');
Writeln('HTTP server is now listen on http://localhost:8888/');
Writeln(' - point your browser to http://localhost:8888/ for initial page');
Writeln(' - type "close connectionID" to close existing webSocket connection');
Writeln(' - type "send connectionID" to send text to specified WebCocket');
Writeln(' Point your browser to http://localhost:8888/ for initial page');
WriteLn('Type one of a commnad:');
Writeln(' - "close connectionID" to close existing webSocket connection');
Writeln(' - "sendto connectionID" to send text to specified WebCocket');
Writeln(' - "sendall" to send text to specified WebCocket');
Writeln(' - press [Enter] to quit');
Writeln('Waiting for command:');
repeat
Readln(s);
if Pos('close ', s) = 1 then begin
s := SysUtils.Trim(Copy(s, 7, Length(s)));
_Server.fServer.Protocols[0].Close(StrToIntDef(s, -1), WEB_SOCKET_SUCCESS_CLOSE_STATUS,
Pointer(CloseReasonBuffer), length(CloseReasonBuffer));
end else if Pos('send ', s) = 1 then begin
s := SysUtils.Trim(Copy(s, 6, Length(s)));
_Server.fServer.Protocols[0].Send(StrToIntDef(s, -1), WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,
Pointer(MsgBuffer), length(MsgBuffer));
end;
end else if Pos('sendto ', s) = 1 then begin
s := SysUtils.Trim(Copy(s, 8, Length(s)));
idx := StrToIntDef(s, -1);
if (idx = -1 ) then
Writeln('Invalid connection ID. Usage: send connectionID (Example: send 0)')
else begin
Write('Type text to send: ');
Readln(MsgBuffer);
if _Server.fServer.Protocols[0].Send(
StrToIntDef(s, -1), WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,
Pointer(MsgBuffer), length(MsgBuffer)
) then
WriteLn('Sent successfully. The message should appear in the client. Waiting for command:')
else
WriteLn('Error')
end;
end else if (s = 'sendall') then begin
Write('Type text to send: ');
Readln(MsgBuffer);
if _Server.fServer.Protocols[0].Broadcast(
WEB_SOCKET_UTF8_MESSAGE_BUFFER_TYPE,
Pointer(MsgBuffer), length(MsgBuffer)
) then
WriteLn('Broadcast successfully. All clients should got a message. Waiting for command:')
else
WriteLn('Error')
end else if (s <> '') then
WriteLn('Invalid comand; Valid command are: close, sendto, sendall');
until s = '';
finally
_Server.Free;
Expand All @@ -133,4 +163,4 @@ begin
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
end.
74 changes: 74 additions & 0 deletions SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.lpi
View file
@@ -0,0 +1,74 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="Project31WinHTTPEchoServer"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="Project31WinHTTPEchoServer.dpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="..\..\.."/>
<OtherUnitFiles Value="..\..\.."/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="delphi"/>
</SyntaxOptions>
</Parsing>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>

This comment has been minimized.

Sign in to view

Copy link
@synopse

synopse Apr 23, 2018

Owner

what are those bulky conditionals?

This comment has been minimized.

Sign in to view

Copy link
@pavelmash

pavelmash Apr 23, 2018

Author Collaborator

May be it added by automatically. I will remove it
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

0 comments on commit a0bf0d0

Please sign in to comment.