标签：fServer Writeln begin end mormot websocket Conn TSimpleWebsocketServer
mormot websocket
THttpApiWebSocketServer基于http.sys通讯的websocket server，同时它又能作为普通的http server使用，支持高并发。
下面是它的演示代码：
program Project31WinHTTPEchoServer;
{$I Synopse.inc}
{$APPTYPE CONSOLE}
uses
{$I SynDprUses.inc} // use FastMM4 on older Delphi, or set FPC threads
SysUtils,
SynZip,
SynCrtSock,
SynCommons,
SynTable;
type
TSimpleWebsocketServer = class
private
fServer: THttpApiWebSocketServer;
// fProtocols: THttpApiWebSocketServerProtocolDynArray;
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: Cardinal);
procedure onDisconnect(const Conn: THttpApiWebSocketConnection ; aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
public
constructor Create;
destructor Destroy; override;
end;
{ TSimpleWebsocketServer }
constructor TSimpleWebsocketServer.Create;
begin
fServer := THttpApiWebSocketServer.Create(false, 8, 10000);
fServer.AddUrl('','8888', False, 'localhost');
fServer.AddUrlWebSocket('whatever', '8888', False, 'localhost');
// ManualFragmentManagement = false - so Server will join all packet fragments
// automatically and call onMessage with full message content
fServer.RegisterProtocol('meow', False, onAccept, onMessage, onConnect, onDisconnect);
fServer.RegisterCompress(CompressDeflate);
fServer.OnRequest := onHttpRequest;
fServer.Clone(8);
end;
destructor TSimpleWebsocketServer.Destroy;
begin
fServer.Free;
inherited;
end;
function TSimpleWebsocketServer.onAccept(Ctxt: THttpServerRequest; var Conn: THttpApiWebSocketConnection): Boolean;
begin
// You can check some Ctxt parameters here
Result := true;
end;
procedure TSimpleWebsocketServer.onConnect(const Conn: THttpApiWebSocketConnection);
begin
Writeln('New connection. Assigned connectionID=', Conn.index);
end;
procedure TSimpleWebsocketServer.onDisconnect(const Conn: THttpApiWebSocketConnection;
aStatus: WEB_SOCKET_CLOSE_STATUS; aBuffer: Pointer; aBufferSize: Cardinal);
var
str: RawUTF8;
begin
SetString(str, pUtf8Char(aBuffer), aBufferSize);
Writeln('Disconnected ', Conn.index,' ',aStatus,' ',str);
end;
function TSimpleWebsocketServer.onHttpRequest(Ctxt: THttpServerRequest): cardinal;
begin
Writeln('HTTP request to ', Ctxt.URL);
if Ctxt.URL = '/' then
Ctxt.OutContent := 'Project31SimpleEchoServer.html'
else if Ctxt.URL = '/favicon.ico' then
Ctxt.OutContent := 'favicon.ico';
Ctxt.OutContentType := HTTP_RESP_STATICFILE;
Result := 200;
end;
procedure TSimpleWebsocketServer.onMessage(const Conn: THttpApiWebSocketConnection;
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)
else if aBufferType = WEB_SOCKET_UTF8_FRAGMENT_BUFFER_TYPE then
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);
end;
end;
var
_Server: TSimpleWebsocketServer;
s: string;
idx: integer;
MsgBuffer: RawUTF8;
CloseReasonBuffer: RawUTF8;
begin
MsgBuffer := '';
CloseReasonBuffer := 'Connection closed by server';
try
_Server := TSimpleWebsocketServer.Create;
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 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('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;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
标签：fServer,Writeln,begin,end,mormot,websocket,Conn,TSimpleWebsocketServer 来源： https://www.cnblogs.com/hnxxcxg/p/12597182.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。