Codebot.Cross/source/codebot/codebot.unique.pas at master · sysrpl/Codebot.Cross · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
(********************************************************)
(**)
(* Codebot Pascal Library *)
(* http://cross.codebot.org *)
(* Modified October 2015 *)
(**)
(********************************************************)

{ <include docs/codebot.unique.txt> }
unit Codebot.Unique;

{$i codebot.inc}

interface

uses
 SysUtils, Classes,
 Codebot.System,
 Codebot.Networking;

{ TMessageEvent }

type
 TMessageEvent = procedure(const Message: string) ofobject;

{ TUniqueInstance }

 TUniqueInstance = class
private
 FPort: Word;
 FOriginal: Boolean;
 FSocket: TSocket;
 FThread: TSimpleThread;
 FMessage: string;
 FOnMessage: TMessageEvent;
procedureReceiveMessage;
procedureExecute(Thread: TSimpleThread);
public
constructor Create(Key: Word);
destructor Destroy; override;
procedureSendMessage(const Message: string);
property Original: Boolean read FOriginal;
property OnMessage: TMessageEvent read FOnMessage write FOnMessage;
end;

{ UniqueInstance should be called with a valid key at program startup }
functionUniqueInstance(Key: Word = 0): TUniqueInstance; overload;
{ UniqueInstance overloaded to generate a Key by hashing a string }
functionUniqueInstance(const Key: string): TUniqueInstance; overload;

implementation

functionHashOf(const S: string): LongWord;
var
 I: Integer;
begin
 Result := 0;
for I := 1to Length(S) do
 Result := ((Result shl2) or (Result shr (SizeOf(Result) * 8 - 2))) xor Ord(S[I]);
end;

{ TUniqueInstance }

constructor TUniqueInstance.Create(Key: Word);
begin
inherited Create;
 FPort := Key;
 FSocket := TSocket.Create;
 FSocket.Blocking := True;
 FOriginal := FSocket.Listen(FPort);
if FOriginal then
 FThread := TSimpleThread.Create(Execute);
end;

destructor TUniqueInstance.Destroy;
begin
if FThread <> nilthen
begin
 FThread.Terminate;
 Sleep(1);
end;
 FSocket.Free;
inherited Destroy;
end;

procedureTUniqueInstance.ReceiveMessage;
begin
if Assigned(FOnMessage) then
 FOnMessage(FMessage);
end;

procedureTUniqueInstance.Execute(Thread: TSimpleThread);
var
 Client: TSocket;
 S: string;
begin
 Client := TSocket.Create;
try
 Client.Blocking := True;
whilenot Thread.Terminated do
begin
if FSocket.Accept(Client) and (Client.Read(S) > 0) and (not Thread.Terminated) then
begin
 FMessage := S;
 Thread.Synchronize(ReceiveMessage);
end;
 Client.Close;
end;
finally
 Client.Free;
end;
end;

procedureTUniqueInstance.SendMessage(const Message: string);
var
 S: TSocket;
begin
 S := TSocket.Create;
try
 S.Blocking := True;
if S.Connect('localhost', FPort) then
 S.Write(Message);
finally
 S.Free;
end;
end;

var
 InternalUniqueInstance: TObject;

functionUniqueInstance(Key: Word = 0): TUniqueInstance;
begin
if InternalUniqueInstance = nilthen
 InternalUniqueInstance := TUniqueInstance.Create(Key);
 Result := TUniqueInstance(InternalUniqueInstance);
end;

functionUniqueInstance(const Key: string): TUniqueInstance;
var
 L: LongWord;
begin
 L := HashOf(Key);
 L := L mod (High(Word) div2 + High(Word) div4) + High(Word) div4;
 Result := UniqueInstance(L);
end;

initialization
 InternalUniqueInstance := nil;
finalization
 InternalUniqueInstance.Free;
end.