Skip to content

Commit 74a7aad

Browse files
VahidVahid
authored andcommitted
Initial Commit
1 parent fb3084e commit 74a7aad

File tree

6 files changed

+2871
-0
lines changed

6 files changed

+2871
-0
lines changed

.gitignore

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
# Lazarus compiler-generated binaries (safe to delete)
2+
*.exe
3+
*.dll
4+
*.so
5+
*.dylib
6+
*.lrs
7+
*.res
8+
*.compiled
9+
*.obj
10+
*.dbg
11+
*.ppu
12+
*.o
13+
*.or
14+
*.a
15+
16+
# Lazarus autogenerated files (duplicated info)
17+
*.rst
18+
*.rsj
19+
*.lrt
20+
21+
# Lazarus local files (user-specific info)
22+
*.lps
23+
24+
# Lazarus backups and unit output folders.
25+
# These can be changed by user in Lazarus/project options.
26+
backup/
27+
*.bak
28+
lib/
29+
30+
# Application bundle for Mac OS
31+
*.app/

Example/WebSocketTest.lpi

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,74 @@
1+
<?xml version="1.0" encoding="UTF-8"?>
2+
<CONFIG>
3+
<ProjectOptions>
4+
<Version Value="12"/>
5+
<General>
6+
<Flags>
7+
<MainUnitHasCreateFormStatements Value="False"/>
8+
<MainUnitHasTitleStatement Value="False"/>
9+
<MainUnitHasScaledStatement Value="False"/>
10+
</Flags>
11+
<SessionStorage Value="InProjectDir"/>
12+
<Title Value="WebSocketTest"/>
13+
<UseAppBundle Value="False"/>
14+
<ResourceType Value="res"/>
15+
</General>
16+
<BuildModes>
17+
<Item Name="Default" Default="True"/>
18+
</BuildModes>
19+
<PublishOptions>
20+
<Version Value="2"/>
21+
<UseFileFilters Value="True"/>
22+
</PublishOptions>
23+
<RunParams>
24+
<FormatVersion Value="2"/>
25+
</RunParams>
26+
<Units>
27+
<Unit>
28+
<Filename Value="WebSocketTest.lpr"/>
29+
<IsPartOfProject Value="True"/>
30+
</Unit>
31+
<Unit>
32+
<Filename Value="../../../Core/Synapse/blcksock.pas"/>
33+
<IsPartOfProject Value="True"/>
34+
</Unit>
35+
<Unit>
36+
<Filename Value="../WebSocket.Core.pas"/>
37+
<IsPartOfProject Value="True"/>
38+
</Unit>
39+
<Unit>
40+
<Filename Value="../WebSocket.Helper.pas"/>
41+
<IsPartOfProject Value="True"/>
42+
</Unit>
43+
</Units>
44+
</ProjectOptions>
45+
<CompilerOptions>
46+
<Version Value="11"/>
47+
<Target>
48+
<Filename Value="WebSocketTest"/>
49+
</Target>
50+
<SearchPaths>
51+
<IncludeFiles Value="$(ProjOutDir)"/>
52+
<OtherUnitFiles Value="../../../Core/Synapse;.."/>
53+
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
54+
</SearchPaths>
55+
<Linking>
56+
<Debugging>
57+
<DebugInfoType Value="dsDwarf2Set"/>
58+
</Debugging>
59+
</Linking>
60+
</CompilerOptions>
61+
<Debugging>
62+
<Exceptions>
63+
<Item>
64+
<Name Value="EAbort"/>
65+
</Item>
66+
<Item>
67+
<Name Value="ECodetoolError"/>
68+
</Item>
69+
<Item>
70+
<Name Value="EFOpenError"/>
71+
</Item>
72+
</Exceptions>
73+
</Debugging>
74+
</CONFIG>

Example/WebSocketTest.lpr

Lines changed: 78 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,78 @@
1+
program WebSocketTest;
2+
3+
{$Mode Delphi}
4+
5+
uses
6+
cthreads,
7+
Classes,
8+
SysUtils,
9+
WebSocket.Helper,
10+
WebSocket.Core;
11+
12+
type
13+
TMyClass = class
14+
public
15+
procedure OnRead(Sender: TWebSocketCustomConnection; {%H-}Flags: TWSFlags; OpCode: Byte; Data: TMemoryStream);
16+
procedure OnReadFull(Sender: TWebSocketCustomConnection; OpCode: Byte; Data: TMemoryStream);
17+
procedure OnPing(Sender: TWebSocketCustomConnection; Data: AnsiString);
18+
procedure OnPong(Sender: TWebSocketCustomConnection; Data: AnsiString);
19+
end;
20+
21+
{ TMyClass }
22+
23+
procedure TMyClass.OnRead(Sender: TWebSocketCustomConnection; Flags: TWSFlags; OpCode: Byte; Data: TMemoryStream);
24+
var
25+
s: AnsiString;
26+
begin
27+
SetLength(s{%H-}, Data.Size);
28+
Move(Data.Memory^, s[1], Data.Size);
29+
WriteLn(OpCode, ':', Data.Size, '-', s);
30+
end;
31+
32+
procedure TMyClass.OnReadFull(Sender: TWebSocketCustomConnection; OpCode: Byte; Data: TMemoryStream);
33+
begin
34+
WriteLn(OpCode, ':', Data.Size, '-', PAnsiChar(Data.Memory));
35+
end;
36+
37+
procedure TMyClass.OnPing(Sender: TWebSocketCustomConnection; Data: AnsiString);
38+
begin
39+
WriteLn('PING:', Length(Data), '-', Data);
40+
end;
41+
42+
procedure TMyClass.OnPong(Sender: TWebSocketCustomConnection; Data: AnsiString);
43+
begin
44+
WriteLn('PONG:', Length(Data), '-', Data);
45+
end;
46+
47+
var
48+
Client: TWebSocketClient;
49+
MyClass: TMyClass;
50+
i: Integer;
51+
52+
begin
53+
MyClass := TMyClass.Create;
54+
Client := TWebSocketClient.CreateFromURL('wss://127.0.0.1/websocket/test');
55+
Client.OnRead := MyClass.OnRead;
56+
Client.OnReadFull := MyClass.OnReadFull;
57+
Client.OnPing := MyClass.OnPing;
58+
Client.OnPong := MyClass.OnPong;
59+
Client.Start;
60+
Client.WaitForConnect(10000);
61+
Client.SendText('HeloHeloHeloHelo');
62+
Client.SendText('Hello', []);
63+
Client.SendTextContinuation('Hello', []);
64+
Client.SendTextContinuation('Hello', []);
65+
Client.SendTextContinuation('Hello', [FIN]);
66+
Client.Ping('PingPingPing');
67+
for i := 1 to 10 do begin
68+
Client.SendText('Hello ' + IntToStr(i));
69+
Client.Ping('Ping ' + IntToStr(i));
70+
Sleep(1000);
71+
end;
72+
Readln;
73+
Client.Ping('PingPingPing');
74+
Client.Free;
75+
MyClass.Free;
76+
Writeln('FINISHED!');
77+
end.
78+

README.md

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
# libWebSocket.pas
2+
3+
### WebSocket server/client implementation in Object Pascal
4+
5+
This project is based directly on pure Pascal source code.
6+
7+
Project contains implementation of clients and servers using WebSocket protocol RFC (http://tools.ietf.org/html/rfc6455)
8+
9+
This library is a remastered, rewritten and customized version of
10+
https://github.com/MFernstrom/Bauglir-WebSocket-2
11+
and
12+
https://github.com/Robert-112/Bauglir-WebSocket-2
13+
which originally are based on Bronislav Klucka source code as
14+
http://code.google.com/p/bauglir-websocket
15+
This library requirements Ararat Synapse (http://www.ararat.cz/synapse/) socket library to compile.
16+

0 commit comments

Comments
 (0)