-
Notifications
You must be signed in to change notification settings - Fork 0
/
PipeServerInstance.pas
164 lines (137 loc) · 3.61 KB
/
PipeServerInstance.pas
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
152
153
154
155
156
157
158
159
160
161
162
163
164
unit PipeServerInstance;
interface
uses
Classes, Windows;
const
SHUT_DOWN_MSG = 'shutdown pipe ';
PIPE_FORMAT = '\\%s\pipe\%s'; // \\ServerName\pipe\PipeName
PIPE_TIMEOUT = 5000;
BUFF_SIZE = 8095;
type
TInstanceState = (isRun, isTerminate);
RPIPEMessage = record
Size: DWORD;
Kind: Byte;
Count: DWORD;
Data: array[0..BUFF_SIZE+5] of Byte;
end;
// Named pipe server (instance)
TPipeServerInstance = class(TThread)
private
fID: Byte;
fHandle: THandle;
fPipeName: String;
procedure SendMessage();
procedure ReadMessage();
procedure Log(aLog: String);
protected
procedure Execute(); override;
public
InstanceState: TInstanceState;
constructor Create(aID: Byte; aPipeHandle: THandle; aPipeName: String);
destructor Destroy; override;
procedure ShutDownServer();
end;
implementation
uses
SysUtils;
{ TPipeServerInstance }
constructor TPipeServerInstance.Create(aID: Byte; aPipeHandle: THandle; aPipeName: String);
begin
inherited Create();
FreeOnTerminate := False;
Priority := tpLower;
fID := aID;
fHandle := aPipeHandle;
fPipeName := aPipeName;
InstanceState := isRun;
Log('Constructor - Pipe name: ' + fPipeName);
end;
destructor TPipeServerInstance.Destroy;
begin
if (fHandle <> INVALID_HANDLE_VALUE) then
ShutDownServer;
Log('Destructor');
inherited Destroy;
end;
procedure TPipeServerInstance.Log(aLog: String);
begin
Writeln(' TPipeServerInstance[' + IntToStr(fID) + ']: ' + aLog);
end;
procedure TPipeServerInstance.Execute();
var
NewMessage: Boolean;
Written: Cardinal;
InMsg, OutMsg: RPIPEMessage;
begin
Log('Execute - start');
while (InstanceState <> isTerminate) AND (fHandle <> INVALID_HANDLE_VALUE) do
begin
ReadMessage();
if (InstanceState = isTerminate) then // Client send request to terminate connection (for now)
break;
SendMessage();
end;
InstanceState := isTerminate;
Log('Execute - end');
end;
procedure TPipeServerInstance.SendMessage();
var
SendMessage: Boolean;
Bytes: Cardinal;
Msg: RPIPEMessage;
begin
// Prepare outgoing message
Msg.Kind := 1;
Msg.Count := 2;
Msg.Data[0] := 3;
Msg.Data[1] := 4;
Msg.Size := SizeOf(Msg.Size) + SizeOf(Msg.Kind) + SizeOf(Msg.Count) + Msg.Count + 3;
// Send message
Log('Sent message');
SendMessage := WriteFile(
fHandle, // pipe handle
Msg, // message
Msg.Size, // message length
Bytes, // bytes written
nil
);
if not SendMessage then
Log('Message cound not be send');
end;
procedure TPipeServerInstance.ReadMessage();
var
MessageReceived: Boolean;
Msg: RPIPEMessage;
begin
MessageReceived := ReadFile(
fHandle, // pipe handle
Msg, // buffer to receive reply
BUFF_SIZE, // size of buffer
Msg.Size, // number of bytes read
nil); // not overlapped
if MessageReceived then
begin
Log('Received message: size = ' + IntToStr(Msg.Size) + '; data[0] = ' + IntToStr(Msg.Data[0]));
if (Msg.Kind = 10) then
InstanceState := isTerminate;
end;
end;
procedure TPipeServerInstance.ShutDownServer();
var
BytesRead: Cardinal;
OutMsg, InMsg: RPIPEMessage;
ShutDownMsg: String;
begin
if (fHandle <> INVALID_HANDLE_VALUE) then
begin
// Server still has pipe opened
DisconnectNamedPipe(fHandle);
// Close pipe on server
CloseHandle(fHandle);
// Clear handle
fHandle := INVALID_HANDLE_VALUE;
Log('Shut down server: ' + fPipeName);
end;
end;
end.