diff --git a/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.dpr b/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.dpr index 92b5c1b23..17ede3cb4 100644 --- a/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.dpr +++ b/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.dpr @@ -1,15 +1,18 @@ program Project31WinHTTPEchoServer; +{$IFDEF FPC} + {$MODE Delphi} +{$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 @@ -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; @@ -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 @@ -78,7 +81,7 @@ 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 @@ -86,20 +89,21 @@ begin // 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 @@ -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; @@ -133,4 +163,4 @@ begin on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; -end. \ No newline at end of file +end. diff --git a/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.lpi b/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.lpi new file mode 100644 index 000000000..40d1e8d7d --- /dev/null +++ b/SQLite3/Samples/31 - WebSockets/Project31WinHTTPEchoServer.lpi @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + <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"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG>