Skip to content

Commit 193bde7

Browse files
author
Stas Piter
committed
Quick start demo added.
1 parent b459f9b commit 193bde7

10 files changed

Lines changed: 203 additions & 113 deletions

.gitignore

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
*.identcache
2+
log.txt
3+
*.dcu
4+
*.exe
5+
*.ddp
6+
*.ppu
7+
*.o
8+
*.~*
9+
*.log
10+
*.dsk
11+
*.dof
12+
*.bk?
13+
*.mps
14+
*.rst
15+
*.dres
16+
*.s
17+
*.a
18+
*.map
19+
*.rsm
20+
*.drc
21+
*.2007
22+
*.local
23+
__history
24+
*.stat
25+
Android
26+
Win32
27+
__recovery
28+
*.db-journal
29+
*.$manifest
30+
*.vrc
31+
*.res
32+
*.rc

1-QuickStart/WebSocketDemo.dpr

Lines changed: 89 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,89 @@
1+
program WebSocketDemo;
2+
3+
{$APPTYPE CONSOLE}
4+
5+
{$R *.res}
6+
7+
uses
8+
System.SysUtils,
9+
10+
IdContext,
11+
12+
WebSocketServer in 'WebSocketServer.pas';
13+
14+
type
15+
16+
TWebSocketDemo = class
17+
private
18+
FServer: TWebSocketServer;
19+
20+
procedure Connect(AContext: TIdContext);
21+
procedure Disconnect(AContext: TIdContext);
22+
procedure Execute(AContext: TIdContext);
23+
public
24+
constructor Create;
25+
destructor Destroy; override;
26+
end;
27+
28+
var
29+
srv: TWebSocketServer;
30+
31+
{ TWebSocketDemo }
32+
33+
constructor TWebSocketDemo.Create;
34+
begin
35+
FServer := TWebSocketServer.Create;
36+
FServer.DefaultPort := 8080;
37+
FServer.OnExecute := Execute;
38+
FServer.OnConnect := Connect;
39+
FServer.OnDisconnect := Disconnect;
40+
FServer.Active := true;
41+
end;
42+
43+
destructor TWebSocketDemo.Destroy;
44+
begin
45+
FServer.Active := false;
46+
FServer.DisposeOf;
47+
48+
inherited;
49+
end;
50+
51+
procedure TWebSocketDemo.Connect(AContext: TIdContext);
52+
begin
53+
Writeln('Client connected');
54+
end;
55+
56+
procedure TWebSocketDemo.Disconnect(AContext: TIdContext);
57+
begin
58+
Writeln('Client disconnected');
59+
end;
60+
61+
procedure TWebSocketDemo.Execute(AContext: TIdContext);
62+
var
63+
io: TWebSocketIOHandlerHelper;
64+
msg: string;
65+
begin
66+
io := TWebSocketIOHandlerHelper(AContext.Connection.IOHandler);
67+
io.CheckForDataOnSource(10);
68+
msg := io.ReadString;
69+
if msg = '' then
70+
exit;
71+
72+
writeln(msg);
73+
74+
io.WriteString(msg);
75+
end;
76+
77+
var
78+
Demo: TWebSocketDemo;
79+
80+
begin
81+
try
82+
Demo := TWebSocketDemo.Create;
83+
readln;
84+
Demo.DisposeOf;
85+
except
86+
on E: Exception do
87+
Writeln(E.ClassName, ': ', E.Message);
88+
end;
89+
end.
Lines changed: 11 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -13,16 +13,6 @@
1313
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
1414
<Base>true</Base>
1515
</PropertyGroup>
16-
<PropertyGroup Condition="('$(Platform)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
17-
<Base_Android>true</Base_Android>
18-
<CfgParent>Base</CfgParent>
19-
<Base>true</Base>
20-
</PropertyGroup>
21-
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
22-
<Base_Android64>true</Base_Android64>
23-
<CfgParent>Base</CfgParent>
24-
<Base>true</Base>
25-
</PropertyGroup>
2616
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
2717
<Base_Win32>true</Base_Win32>
2818
<CfgParent>Base</CfgParent>
@@ -59,38 +49,9 @@
5949
<DCC_K>false</DCC_K>
6050
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
6151
<SanitizedProjectName>WebSocketDemo</SanitizedProjectName>
62-
</PropertyGroup>
63-
<PropertyGroup Condition="'$(Base_Android)'!=''">
64-
<Android_LauncherIcon36>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png</Android_LauncherIcon36>
65-
<Android_LauncherIcon48>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png</Android_LauncherIcon48>
66-
<Android_LauncherIcon72>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png</Android_LauncherIcon72>
67-
<Android_LauncherIcon96>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png</Android_LauncherIcon96>
68-
<Android_LauncherIcon144>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png</Android_LauncherIcon144>
69-
<Android_SplashImage426>$(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png</Android_SplashImage426>
70-
<Android_SplashImage470>$(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png</Android_SplashImage470>
71-
<Android_SplashImage640>$(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png</Android_SplashImage640>
72-
<Android_SplashImage960>$(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png</Android_SplashImage960>
73-
<Android_NotificationIcon24>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png</Android_NotificationIcon24>
74-
<Android_NotificationIcon36>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png</Android_NotificationIcon36>
75-
<Android_NotificationIcon48>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png</Android_NotificationIcon48>
76-
<Android_NotificationIcon72>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png</Android_NotificationIcon72>
77-
<Android_NotificationIcon96>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png</Android_NotificationIcon96>
78-
</PropertyGroup>
79-
<PropertyGroup Condition="'$(Base_Android64)'!=''">
80-
<Android_LauncherIcon36>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png</Android_LauncherIcon36>
81-
<Android_LauncherIcon48>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png</Android_LauncherIcon48>
82-
<Android_LauncherIcon72>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png</Android_LauncherIcon72>
83-
<Android_LauncherIcon96>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png</Android_LauncherIcon96>
84-
<Android_LauncherIcon144>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png</Android_LauncherIcon144>
85-
<Android_SplashImage426>$(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png</Android_SplashImage426>
86-
<Android_SplashImage470>$(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png</Android_SplashImage470>
87-
<Android_SplashImage640>$(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png</Android_SplashImage640>
88-
<Android_SplashImage960>$(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png</Android_SplashImage960>
89-
<Android_NotificationIcon24>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png</Android_NotificationIcon24>
90-
<Android_NotificationIcon36>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png</Android_NotificationIcon36>
91-
<Android_NotificationIcon48>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png</Android_NotificationIcon48>
92-
<Android_NotificationIcon72>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png</Android_NotificationIcon72>
93-
<Android_NotificationIcon96>$(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png</Android_NotificationIcon96>
52+
<DCC_UnitSearchPath>.\lib\ArrayHelper;.\lib\JsonDataObjects\Source;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
53+
<VerInfo_Locale>1033</VerInfo_Locale>
54+
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
9455
</PropertyGroup>
9556
<PropertyGroup Condition="'$(Base_Win32)'!=''">
9657
<DCC_UsePackage>DBXSqliteDriver;RESTComponents;fmxase;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;emsclientfiredac;tethering;svnui;DataSnapFireDAC;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;DBXOracleDriver;inetdb;emsedge;fmx;FireDACIBDriver;fmxdae;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;emsclient;DataSnapCommon;FireDACCommon;RESTBackendComponents;DataSnapConnectors;VCLRESTComponents;soapserver;vclie;bindengine;DBXMySQLDriver;CloudService;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;FireDACCommonDriver;DataSnapClient;inet;IndyIPCommon;bindcompdbx;vcl;IndyIPServer;DBXSybaseASEDriver;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;FireDAC;emshosting;FireDACSqliteDriver;FireDACPgDriver;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;soaprtl;DbxCommonDriver;DataSnapServer;xmlrtl;soapmidas;DataSnapNativeClient;fmxobj;vclwinx;FireDACDSDriver;rtl;emsserverresource;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;inetdbxpress;FireDACMongoDBDriver;DataSnapServerMidas;$(DCC_UsePackage)</DCC_UsePackage>
@@ -118,6 +79,8 @@
11879
</PropertyGroup>
11980
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
12081
<DCC_RemoteDebug>false</DCC_RemoteDebug>
82+
<VerInfo_Locale>1033</VerInfo_Locale>
83+
<Manifest_File>(None)</Manifest_File>
12184
</PropertyGroup>
12285
<PropertyGroup Condition="'$(Cfg_2)'!=''">
12386
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
@@ -150,6 +113,12 @@
150113
<Source>
151114
<Source Name="MainSource">WebSocketDemo.dpr</Source>
152115
</Source>
116+
<Excluded_Packages>
117+
<Excluded_Packages Name="$(BDSBIN)\bcboffice2k260.bpl">Embarcadero C++Builder Office 2000 Servers Package</Excluded_Packages>
118+
<Excluded_Packages Name="$(BDSBIN)\bcbofficexp260.bpl">Embarcadero C++Builder Office XP Servers Package</Excluded_Packages>
119+
<Excluded_Packages Name="$(BDSBIN)\dcloffice2k260.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
120+
<Excluded_Packages Name="$(BDSBIN)\dclofficexp260.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
121+
</Excluded_Packages>
153122
</Delphi.Personality>
154123
<Deployment Version="3">
155124
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
@@ -1001,8 +970,6 @@
1001970
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
1002971
</Deployment>
1003972
<Platforms>
1004-
<Platform value="Android">False</Platform>
1005-
<Platform value="Android64">False</Platform>
1006973
<Platform value="Win32">True</Platform>
1007974
<Platform value="Win64">False</Platform>
1008975
</Platforms>
Lines changed: 46 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,22 @@ TWebSocketIOHandlerHelper = class(TIdIOHandler)
3939

4040
implementation
4141

42+
function HeadersParse(const msg: string): TDictionary<string, string>;
43+
var
44+
lines: TArray<string>;
45+
line: string;
46+
SplittedLine: TArray<string>;
47+
begin
48+
result := TDictionary<string, string>.Create;
49+
lines := msg.Split([#13#10]);
50+
for line in lines do
51+
begin
52+
SplittedLine := line.Split([': ']);
53+
if Length(SplittedLine) > 1 then
54+
result.AddOrSetValue(Trim(SplittedLine[0]), Trim(SplittedLine[1]));
55+
end;
56+
end;
57+
4258
{ TWebSocketServer }
4359

4460
constructor TWebSocketServer.Create;
@@ -76,68 +92,59 @@ procedure TWebSocketServer.DoConnect(AContext: TIdContext);
7692
if AContext.Connection.IOHandler is TIdSSLIOHandlerSocketBase then
7793
TIdSSLIOHandlerSocketBase(AContext.Connection.IOHandler).PassThrough := false;
7894

79-
// Mark connection as invalid during it's not handshaked
95+
// Mark connection as "not handshaked"
8096
AContext.Connection.IOHandler.Tag := -1;
8197

8298
inherited;
8399
end;
84100

85101
function TWebSocketServer.DoExecute(AContext: TIdContext): Boolean;
86102
var
87-
h: TIdIOHandler;
103+
c: TIdIOHandler;
88104
Bytes: TArray<byte>;
89-
s: string;
90-
arr: TArray<string>;
91-
SecWebSocketKeyLine: integer;
92-
Hash: string;
93-
94-
// under ARC, convert a weak reference to a strong reference before working with it
105+
msg, SecWebSocketKey, Hash: string;
106+
ParsedHeaders: TDictionary<string, string>;
95107
LConn: TIdTCPConnection;
96108
begin
97-
h := AContext.Connection.IOHandler;
109+
c := AContext.Connection.IOHandler;
98110

99-
// Handshake reading
111+
// Handshake
100112

101-
if h.Tag = -1 then
113+
if c.Tag = -1 then
102114
begin
103-
Bytes := nil;
115+
c.CheckForDataOnSource(10);
104116

105-
h.CheckForDataOnSource(10);
106-
if not h.InputBufferIsEmpty then
117+
if not c.InputBufferIsEmpty then
107118
begin
108-
h.InputBuffer.ExtractToBytes(TIdBytes(Bytes));
109-
s := IndyTextEncoding_UTF8.GetString(TIdBytes(Bytes));
110-
arr := s.Split([#13#10]);
119+
c.InputBuffer.ExtractToBytes(TIdBytes(Bytes));
120+
msg := IndyTextEncoding_UTF8.GetString(TIdBytes(Bytes));
121+
ParsedHeaders := HeadersParse(msg);
111122

112-
if TArrayHelper.Contains<string>(arr, 'Upgrade: websocket') then
123+
if ParsedHeaders.ContainsKey('Upgrade') and (ParsedHeaders['Upgrade'] = 'websocket') and
124+
ParsedHeaders.ContainsKey('Sec-WebSocket-Key') then
113125
begin
114126
// Handle handshake request
115127
// https://developer.mozilla.org/en-US/docs/Web/API/WebSockets_API/Writing_WebSocket_servers
116128

117-
SecWebSocketKeyLine := TArrayHelper.Find<string>(arr,
118-
function(s: string): boolean
119-
begin
120-
result := s.StartsWith('Sec-WebSocket-Key:');
121-
end);
129+
SecWebSocketKey := ParsedHeaders['Sec-WebSocket-Key'];
122130

123-
if SecWebSocketKeyLine > -1 then
124-
begin
125-
// Send handshake response
126-
Hash := TIdEncoderMIME.EncodeBytes(HashSHA1.HashString(Trim(arr[SecWebSocketKeyLine].Split([': '])[1]) +
127-
'258EAFA5-E914-47DA-95CA-C5AB0DC85B11'));
128-
h.Write('HTTP/1.1 101 Switching Protocols'#13#10
129-
+ 'Upgrade: websocket'#13#10
130-
+ 'Connection: Upgrade'#13#10
131-
+ 'Sec-WebSocket-Accept: '+ Hash
132-
+ #13#10#13#10, IndyTextEncoding_UTF8);
133-
134-
// Mark connection as handshaked WebSocket connection
135-
h.Tag := 1;
136-
end;
131+
// Send handshake response
132+
Hash := TIdEncoderMIME.EncodeBytes(
133+
HashSHA1.HashString(SecWebSocketKey + '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'));
134+
135+
c.Write('HTTP/1.1 101 Switching Protocols'#13#10
136+
+ 'Upgrade: websocket'#13#10
137+
+ 'Connection: Upgrade'#13#10
138+
+ 'Sec-WebSocket-Accept: ' + Hash
139+
+ #13#10#13#10, IndyTextEncoding_UTF8);
140+
141+
// Mark IOHandler as handshaked
142+
c.Tag := 1;
137143
end;
144+
145+
ParsedHeaders.DisposeOf;
138146
end;
139147

140-
// Handle some things, that parent DoExecute have to
141148
result := false;
142149
if AContext <> nil then
143150
begin
@@ -148,7 +155,7 @@ function TWebSocketServer.DoExecute(AContext: TIdContext): Boolean;
148155

149156
end
150157
else
151-
// After handshaking we can work in default way
158+
// After the handshake we can work with the context in common way
152159
result := inherited;
153160
end;
154161

@@ -184,7 +191,6 @@ function TWebSocketIOHandlerHelper.ReadBytes: TArray<byte>;
184191
end;
185192
Mask[0] := ReadByte; Mask[1] := ReadByte; Mask[2] := ReadByte; Mask[3] := ReadByte;
186193

187-
// TODO: Bad fix
188194
if DecodedSize < 1 then
189195
begin
190196
result := [];

1-QuickStart/client.html

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
<title>WebSocket demo client</title>
5+
</head>
6+
7+
<body>
8+
9+
<script>
10+
const socket = new WebSocket('ws://localhost:8080');
11+
12+
// Connection opened
13+
socket.addEventListener('open', function (event) {
14+
socket.send('Hello Server!');
15+
});
16+
17+
// Listen for messages
18+
socket.addEventListener('message', function (event) {
19+
console.log('Message from server "' + event.data + '"');
20+
});
21+
</script>
22+
23+
</body>
24+
25+
</html>

WebSocketDemo.dpr

Lines changed: 0 additions & 18 deletions
This file was deleted.

0 commit comments

Comments
 (0)