ViewVC Help

View File | Revision Log | Show Annotations | Download File | View Changeset | Root Listing

root/public/ibx/trunk/runtime/winipc.inc

Comparing ibx/trunk/runtime/winipc.inc (file contents):
Revision 17 by tony, Sat Dec 28 19:22:24 2013 UTC vs.
Revision 37 by tony, Mon Feb 15 14:44:25 2016 UTC

#	Line 1 | Line 1
1	<	const
2	<	MonitorHookNames: array[0..5] of String = (
3	<	'FB.SQL.MONITOR.Mutex1_0',
4	<	'FB.SQL.MONITOR.SharedMem1_0',
5	<	'FB.SQL.MONITOR.WriteEvent1_0',
6	<	'FB.SQL.MONITOR.WriteFinishedEvent1_0',
7	<	'FB.SQL.MONITOR.ReadEvent1_0',
8	<	'FB.SQL.MONITOR.ReadFinishedEvent1_0'
9	<	);
10	<	cDefaultTimeout = 1000; { 1 seconds }
11	<
12	<	type
13	<	TGlobalInterface = class;
14	<
15	<	{Interprocess Communication Objects. All platform dependent IPC is abstracted
16	<	into this set of objects }
17	<
18	<	{ TIpcCommon }
19	<
20	<	TIpcCommon = class
21	<	private
22	<	function GetSa: PSecurityAttributes;
23	<	protected
24	<	FInitialiser: boolean;  static;
25	<	FSa : TSecurityAttributes;
26	<	private
27	<	Sd : TSecurityDescriptor;
28	<	public
29	<	constructor Create;
30	<	property Sa : PSecurityAttributes read GetSa;
31	<	end;
32	<
33	<	{ TSharedMemory }
34	<
35	<	{
36	<	The shared memory segment is used for interprocess communication and
37	<	holds both a message buffer and a number of shared variables. Shared
38	<	memory is allocated to each shared variable using the Allocate function.
39	<	An underlying assumption is that each process using the shared memory
40	<	calls "Allocate" in the same order and for the same memory sizes.
41	<
42	<	Windows:
43	<
44	<	The Windows implementation uses Windows shared memory. This is identified
45	<	by a global name known to every process. There is no security with
46	<	the windows implementation and the shared memory can be read by
47	<	any active process.
48	<
49	<	}
50	<
51	<	TSharedMemory = class(TIpcCommon)
52	<	private
53	<	FBuffer: PChar;
54	<	FLastAllocationSize: integer;
55	<	FUnused: integer;
56	<	FBufptr: PChar;
57	<	FSharedBuffer: THandle;
58	<	procedure GetSharedMemory(MemSize: integer);
59	<	public
60	<	constructor Create(MemSize: integer);
61	<	destructor Destroy; override;
62	<	function Allocate(Size: integer): PChar;
63	<	property LastAllocationSize: integer read FLastAllocationSize;
64	<	end;
65	<
66	<	{TMutex}
67	<
68	<	TMutex = class(TIpcCommon)
69	<	private
70	<	FMutex: THandle;
71	<	public
72	<	constructor Create(MutexName: string);
73	<	destructor Destroy; override;
74	<	procedure Lock;
75	<	procedure Unlock;
76	<	end;
77	<
78	<	{ TSingleLockGate }
79	<
80	<	{
81	<	A single lock gate is either open or closed. When open, any thread can pass
82	<	through it while, when closed, all threads are blocked as they try to pass
83	<	through the gate. When the gate is opened, all blocked threads are resumed.
84	<
85	<	There is an implementation assumption that only one writer thread at
86	<	a time (i.e. the thread which locks or unlocks the gate) can have access to
87	<	it at any one time. I.e. an external Mutex prevents race conditions.
88	<
89	<	Windows:
90	<
91	<	In the Windows implementation, a Windows Event is used to implement
92	<	the "gate". No additional functionality is required as the behaviour
93	<	of a Windows event meets the requirement.
94	<
95	<
96	<	Always initialised to the Unlocked state
97	<	}
98	<
99	<	TSingleLockGate = class(TIpcCommon)
100	<	private
101	<	FOwner: TGlobalInterface;
102	<	FEvent: THandle;
103	<	public
104	<	constructor Create(EventName: string; AOwner: TGlobalInterface);
105	<	destructor Destroy; override;
106	<	procedure PassthroughGate;
107	<	procedure Unlock;
108	<	procedure Lock;
109	<	end;
110	<
111	<	{ TMultilockGate }
112	<
113	<	{ This type of Gate is used where several reader threads must pass
114	<	through the gate before it can be opened for a writer thread.
115	<
116	<	The reader threads register their interest by each locking the gate.
117	<	The writer thread then waits on the locked gate until all the reader
118	<	threads have separately unlocked the gate.
119	<
120	<	There is an underlying assumption of a single writer. A Mutex must
121	<	be used to control access to the gate from the writer side if this
122	<	assumption is invalid.
123	<
124	<	Windows:
125	<
126	<	The Windows implementation uses an IPC Event and shared memory to hold
127	<	an integer - the reader count.
128	<
129	<	The readers lock the gate by resetting the event and incrementing the
130	<	reader count. They unlock the gate by decrementing the reader count
131	<	and calling set event when the reader count reaches zero.
132	<
133	<	The writer waits on the event for the gate to open. This is a timed wait
134	<	to avoid the writer being left in an indefinite wait state should a reader
135	<	terminate abnormally.
136	<
137	<	Always initialised to the Unlocked state
138	<	}
139	<
140	<	TMultilockGate = class(TIpcCommon)
141	<	private
142	<	FOnGateTimeout: TNotifyEvent;
143	<	FOwner: TGlobalInterface;
144	<	FEvent: THandle;
145	<	FLockCount: PInteger;
146	<	function GetLockCount: integer;
147	<	public
148	<	constructor Create(EventName: string; AOwner: TGlobalInterface);
149	<	destructor Destroy; override;
150	<	procedure Lock;
151	<	procedure Unlock;
152	<	procedure PassthroughGate;
153	<	property LockCount: integer read GetLockCount;
154	<	property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
155	<	end;
156	<
157	<	{ TGlobalInterface }
158	<
159	<	TGlobalInterface = class(TIpcCommon)
160	<	private
161	<	FMaxBufferSize: integer;
162	<	FSharedMemory: TSharedMemory;
163	<	FWriteLock: TMutex;
164	<	FBuffer: PChar;
165	<	FTraceDataType,
166	<	FBufferSize: PInteger;
167	<	FTimeStamp: PDateTime;
168	<	FReadReadyEvent: TMultiLockGate;
169	<	FReadFinishedEvent: TMultiLockGate;
170	<	FDataAvailableEvent: TSingleLockGate;
171	<	FWriterBusyEvent: TSingleLockGate;
172	<	FMonitorCount: PInteger;
173	<	procedure HandleGateTimeout(Sender: TObject);
174	<	function GetMonitorCount: integer;
175	<	public
176	<	constructor Create;
177	<	destructor Destroy; override;
178	<	procedure IncMonitorCount;
179	<	procedure DecMonitorCount;
180	<	procedure SendTrace(TraceObject: TTraceObject);
181	<	procedure ReceiveTrace(TraceObject: TTraceObject);
182	<	property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
183	<	property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
184	<	property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
185	<	property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
186	<	property WriteLock: TMutex read FWriteLock;
187	<	property MonitorCount: integer read GetMonitorCount;
188	<	property SharedMemory: TSharedMemory read FSharedMemory;
189	<	property MaxBufferSize: integer read FMaxBufferSize;
190	<	end;
191	<
192	<	{ TSharedMemory }
193	<
194	<	procedure TSharedMemory.GetSharedMemory(MemSize: integer);
195	<	begin
196	<	FSharedBuffer := CreateFileMapping(INVALID_HANDLE_VALUE, sa, PAGE_READWRITE,
197	<	0, MemSize, PChar(MonitorHookNames[1]));
198	<
199	<	if GetLastError = ERROR_ALREADY_EXISTS then
200	<	FSharedBuffer := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, PChar(MonitorHookNames[1]))
201	<	else
202	<	FInitialiser := true;
203	<	if (FSharedBuffer = 0) then
204	<	IBError(ibxeCannotCreateSharedResource, [GetLastError]);
205	<	end;
206	<
207	<	constructor TSharedMemory.Create(MemSize: integer);
208	<	begin
209	<	inherited Create;
210	<	FInitialiser := false;
211	<	GetSharedMemory(MemSize);
212	<	FBuffer := MapViewOfFile(FSharedBuffer, FILE_MAP_ALL_ACCESS, 0, 0, 0);
213	<
214	<	if FBuffer = nil then
215	<	IBError(ibxeCannotCreateSharedResource, [GetLastError]);
216	<	FBufPtr := FBuffer;
217	<	FUnused := MemSize
218	<	end;
219	<
220	<	destructor TSharedMemory.Destroy;
221	<	begin
222	<	UnmapViewOfFile(FBuffer);
223	<	CloseHandle(FSharedBuffer);
224	<	inherited Destroy;
225	<	end;
226	<
227	<	function TSharedMemory.Allocate(Size: integer): PChar;
228	<	begin
229	<	if Size > FUnused then
230	<	IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
231	<	Result := FBufPtr;
232	<
233	<	if Size = 0 then
234	<	begin
235	<	FLastAllocationSize := FUnused;
236	<	FUnused := 0
237	<	end
238	<	else
239	<	begin
240	<	FLastAllocationSize := Size;
241	<	Dec(FUnused,Size);
242	<	end;
243	<	Inc(FBufPtr,Size)
244	<	end;
245	<
246	<	{ TIpcCommon }
247	<
248	<	function TIpcCommon.GetSa: PSecurityAttributes;
249	<	begin
250	<	Result := @FSa
251	<	end;
252	<
253	<	constructor TIpcCommon.Create;
254	<	begin
255	<	{ Setup Security so anyone can connect to the MMF/Mutex/Event.  This is
256	<	needed when IBX is used in a Service. }
257	<
258	<	InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
259	<	SetSecurityDescriptorDacl(@Sd,true,nil,false);
260	<	FSa.nLength := SizeOf(FSa);
261	<	FSa.lpSecurityDescriptor := @Sd;
262	<	FSa.bInheritHandle := true;
263	<	end;
264	<
265	<
266	<	{ TMutex }
267	<
268	<	constructor TMutex.Create(MutexName: string);
269	<	begin
270	<	inherited Create;
271	<	if FInitialiser then
272	<	FMutex := CreateMutex(sa, False, PChar(MutexName))
273	<	else
274	<	FMutex := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName));
275	<
276	<	if FMutex = 0 then
277	<	IBError(ibxeCannotCreateSharedResource, [GetLastError])
278	<	end;
279	<
280	<	destructor TMutex.Destroy;
281	<	begin
282	<	CloseHandle(FMutex);
283	<	inherited Destroy;
284	<	end;
285	<
286	<	{ Obtain ownership of the Mutex and prevent other threads from accessing protected resource }
287	<
288	<	procedure TMutex.Lock;
289	<	begin
290	<	WaitForSingleObject(FMutex, INFINITE);
291	<	end;
292	<
293	<	{Give up ownership of the Mutex and allow other threads access }
294	<
295	<	procedure TMutex.Unlock;
296	<	begin
297	<	ReleaseMutex(FMutex);
298	<	end;
299	<
300	<	{ TSingleLockGate }
301	<	constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
302	<	begin
303	<	inherited Create;
304	<	FOwner := AOwner;
305	<	if FInitialiser then
306	<	FEvent := CreateEvent(sa, true, true, PChar(EventName))
307	<	else
308	<	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
309	<
310	<	if FEvent = 0 then
311	<	IBError(ibxeCannotCreateSharedResource, [GetLastError])
312	<	end;
313	<
314	<	destructor TSingleLockGate.Destroy;
315	<	begin
316	<	CloseHandle(FEvent);
317	<	inherited Destroy;
318	<	end;
319	<
320	<
321	<	procedure TSingleLockGate.PassthroughGate;
322	<	begin
323	<	WaitForSingleObject(FEvent,INFINITE)
324	<	end;
325	<
326	<	procedure TSingleLockGate.Unlock;
327	<	begin
328	<	SetEvent(FEvent) //Event State set to "signaled"
329	<	end;
330	<
331	<	procedure TSingleLockGate.Lock;
332	<	begin
333	<	ResetEvent(FEvent) //Event State set to "unsignaled"
334	<	end;
335	<
336	<	{ TMultilockGate }
337	<
338	<	constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
339	<	begin
340	<	inherited Create;
341	<	FOwner := AOwner;
342	<	FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
343	<	if FInitialiser then
344	<	begin
345	<	FEvent := CreateEvent(sa, true, true, PChar(EventName));
346	<	FLockCount^ := 0;
347	<	end
348	<	else
349	<	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
350	<
351	<	if FEvent = 0 then
352	<	IBError(ibxeCannotCreateSharedResource, [GetLastError])
353	<	end;
354	<
355	<	destructor TMultilockGate.Destroy;
356	<	begin
357	<	CloseHandle(FEvent);
358	<	inherited Destroy;
359	<	end;
360	<
361	<	function TMultilockGate.GetLockCount: integer;
362	<	begin
363	<	Result := FLockCount^
364	<	end;
365	<
366	<	procedure TMultilockGate.Lock;
367	<	begin
368	<	InterlockedIncrement(FLockCount^);
369	<	ResetEvent(FEvent);
370	<	//writeln('Lock '+IntToStr(FLockCount^));
371	<	end;
372	<
373	<	procedure TMultilockGate.Unlock;
374	<	begin
375	<	//writeln('Start UnLock '+IntToStr(FLockCount^));
376	<	InterlockedDecrement(FLockCount^);
377	<	if FLockCount^ <= 0 then
378	<	begin
379	<	SetEvent(FEvent);
380	<	FLockCount^ := 0
381	<	end;
382	<	//writeln('UnLock '+IntToStr(FLockCount^));
383	<	end;
384	<
385	<	procedure TMultilockGate.PassthroughGate;
386	<	begin
387	<	if FLockCount^ = 0 then
388	<	Exit;
389	<	while WaitForSingleObject(FEvent,cDefaultTimeout)= WAIT_TIMEOUT do
390	<	{ If we have timed out then we have lost a reader }
391	<	begin
392	<	if FLockCount^ > 0 then
393	<	begin
394	<	UnLock;
395	<	if assigned(FOnGateTimeout) then
396	<	OnGateTimeout(self)
397	<	end
398	<	end;
399	<	end;
400	<
401	<
402	<	{ TGlobalInterface }
403	<
404	<	function TGlobalInterface.GetMonitorCount: integer;
405	<	begin
406	<	Result := FMonitorCount^
407	<	end;
408	<
409	<	procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
410	<	begin
411	<	//writeln(ClassName+': Gate TimeOut');
412	<	DecMonitorCount
413	<	end;
414	<
415	<	constructor TGlobalInterface.Create;
416	<	begin
417	<	inherited Create;
418	<	FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
419	<
420	<	FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
421	<	FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
422	<	FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
423	<	FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
424	<	FReadReadyEvent.OnGateTimeout  := HandleGateTimeout;
425	<	FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
426	<	FReadFinishedEvent.OnGateTimeout  := HandleGateTimeout;
427	<
428	<	FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
429	<
430	<	if FInitialiser then
431	<	FMonitorCount^ := 0;
432	<	FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
433	<	FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
434	<	FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
435	<	FBuffer := FSharedMemory.Allocate(0); //All remaining
436	<	FMaxBufferSize := FSharedMemory.LastAllocationSize;
437	<
438	<	if FInitialiser then
439	<	begin
440	<	FBufferSize^ := 0;
441	<	FDataAvailableEvent.Lock
442	<	end;
443	<	end;
444	<
445	<	destructor TGlobalInterface.Destroy;
446	<	begin
447	<	if assigned(FWriteLock) then FWriteLock.Free;
448	<	if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
449	<	if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
450	<	if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
451	<	if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
452	<	if assigned(FSharedMemory) then FSharedMemory.Free;
453	<	inherited Destroy;
454	<	end;
455	<
456	<	procedure TGlobalInterface.IncMonitorCount;
457	<	begin
458	<	InterlockedIncrement(FMonitorCount^)
459	<	end;
460	<
461	<	procedure TGlobalInterface.DecMonitorCount;
462	<	begin
463	<	InterlockedDecrement(FMonitorCount^)
464	<	end;
465	<
466	<	procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
467	<	begin
468	<	FTraceDataType^ := Integer(TraceObject.FDataType);
469	<	FTimeStamp^ := TraceObject.FTimeStamp;
470	<	FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
471	<	Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
472	<	end;
473	<
474	<	procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
475	<	begin
476	<	SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
477	<	TraceObject.FDataType := TTraceFlag(FTraceDataType^);
478	<	TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
479	<	end;
480	<
481	<
482	<
1	>	const
2	>	MonitorHookNames: array[0..5] of String = (
3	>	'FB.SQL.MONITOR.Mutex1_0',
4	>	'FB.SQL.MONITOR.SharedMem1_0',
5	>	'FB.SQL.MONITOR.WriteEvent1_0',
6	>	'FB.SQL.MONITOR.WriteFinishedEvent1_0',
7	>	'FB.SQL.MONITOR.ReadEvent1_0',
8	>	'FB.SQL.MONITOR.ReadFinishedEvent1_0'
9	>	);
10	>	cDefaultTimeout = 1000; { 1 seconds }
11	>
12	>	type
13	>	TGlobalInterface = class;
14	>
15	>	{Interprocess Communication Objects. All platform dependent IPC is abstracted
16	>	into this set of objects }
17	>
18	>	{ TIpcCommon }
19	>
20	>	TIpcCommon = class
21	>	private
22	>	function GetSa: PSecurityAttributes;
23	>	protected
24	>	class var FInitialiser: boolean;
25	>	FSa : TSecurityAttributes;
26	>	private
27	>	Sd : TSecurityDescriptor;
28	>	public
29	>	constructor Create;
30	>	property Sa : PSecurityAttributes read GetSa;
31	>	end;
32	>
33	>	{ TSharedMemory }
34	>
35	>	{
36	>	The shared memory segment is used for interprocess communication and
37	>	holds both a message buffer and a number of shared variables. Shared
38	>	memory is allocated to each shared variable using the Allocate function.
39	>	An underlying assumption is that each process using the shared memory
40	>	calls "Allocate" in the same order and for the same memory sizes.
41	>
42	>	Windows:
43	>
44	>	The Windows implementation uses Windows shared memory. This is identified
45	>	by a global name known to every process. There is no security with
46	>	the windows implementation and the shared memory can be read by
47	>	any active process.
48	>
49	>	}
50	>
51	>	TSharedMemory = class(TIpcCommon)
52	>	private
53	>	FBuffer: PChar;
54	>	FLastAllocationSize: integer;
55	>	FUnused: integer;
56	>	FBufptr: PChar;
57	>	FSharedBuffer: THandle;
58	>	procedure GetSharedMemory(MemSize: integer);
59	>	public
60	>	constructor Create(MemSize: integer);
61	>	destructor Destroy; override;
62	>	function Allocate(Size: integer): PChar;
63	>	property LastAllocationSize: integer read FLastAllocationSize;
64	>	end;
65	>
66	>	{TMutex}
67	>
68	>	TMutex = class(TIpcCommon)
69	>	private
70	>	FMutex: THandle;
71	>	public
72	>	constructor Create(MutexName: string);
73	>	destructor Destroy; override;
74	>	procedure Lock;
75	>	procedure Unlock;
76	>	end;
77	>
78	>	{ TSingleLockGate }
79	>
80	>	{
81	>	A single lock gate is either open or closed. When open, any thread can pass
82	>	through it while, when closed, all threads are blocked as they try to pass
83	>	through the gate. When the gate is opened, all blocked threads are resumed.
84	>
85	>	There is an implementation assumption that only one writer thread at
86	>	a time (i.e. the thread which locks or unlocks the gate) can have access to
87	>	it at any one time. I.e. an external Mutex prevents race conditions.
88	>
89	>	Windows:
90	>
91	>	In the Windows implementation, a Windows Event is used to implement
92	>	the "gate". No additional functionality is required as the behaviour
93	>	of a Windows event meets the requirement.
94	>
95	>
96	>	Always initialised to the Unlocked state
97	>	}
98	>
99	>	TSingleLockGate = class(TIpcCommon)
100	>	private
101	>	FOwner: TGlobalInterface;
102	>	FEvent: THandle;
103	>	public
104	>	constructor Create(EventName: string; AOwner: TGlobalInterface);
105	>	destructor Destroy; override;
106	>	procedure PassthroughGate;
107	>	procedure Unlock;
108	>	procedure Lock;
109	>	end;
110	>
111	>	{ TMultilockGate }
112	>
113	>	{ This type of Gate is used where several reader threads must pass
114	>	through the gate before it can be opened for a writer thread.
115	>
116	>	The reader threads register their interest by each locking the gate.
117	>	The writer thread then waits on the locked gate until all the reader
118	>	threads have separately unlocked the gate.
119	>
120	>	There is an underlying assumption of a single writer. A Mutex must
121	>	be used to control access to the gate from the writer side if this
122	>	assumption is invalid.
123	>
124	>	Windows:
125	>
126	>	The Windows implementation uses an IPC Event and shared memory to hold
127	>	an integer - the reader count.
128	>
129	>	The readers lock the gate by resetting the event and incrementing the
130	>	reader count. They unlock the gate by decrementing the reader count
131	>	and calling set event when the reader count reaches zero.
132	>
133	>	The writer waits on the event for the gate to open. This is a timed wait
134	>	to avoid the writer being left in an indefinite wait state should a reader
135	>	terminate abnormally.
136	>
137	>	Always initialised to the Unlocked state
138	>	}
139	>
140	>	TMultilockGate = class(TIpcCommon)
141	>	private
142	>	FOnGateTimeout: TNotifyEvent;
143	>	FOwner: TGlobalInterface;
144	>	FEvent: THandle;
145	>	FLockCount: PInteger;
146	>	FMutex: TMutex;
147	>	function GetLockCount: integer;
148	>	public
149	>	constructor Create(EventName: string; AOwner: TGlobalInterface);
150	>	destructor Destroy; override;
151	>	procedure Lock;
152	>	procedure Unlock;
153	>	procedure PassthroughGate;
154	>	property LockCount: integer read GetLockCount;
155	>	property OnGateTimeout: TNotifyEvent read FOnGateTimeout write FOnGateTimeout;
156	>	end;
157	>
158	>	{ TGlobalInterface }
159	>
160	>	TGlobalInterface = class(TIpcCommon)
161	>	private
162	>	FMaxBufferSize: integer;
163	>	FSharedMemory: TSharedMemory;
164	>	FWriteLock: TMutex;
165	>	FBuffer: PChar;
166	>	FTraceDataType,
167	>	FBufferSize: PInteger;
168	>	FTimeStamp: PDateTime;
169	>	FReadReadyEvent: TMultiLockGate;
170	>	FReadFinishedEvent: TMultiLockGate;
171	>	FDataAvailableEvent: TSingleLockGate;
172	>	FWriterBusyEvent: TSingleLockGate;
173	>	FMonitorCount: PInteger;
174	>	procedure HandleGateTimeout(Sender: TObject);
175	>	function GetMonitorCount: integer;
176	>	public
177	>	constructor Create;
178	>	destructor Destroy; override;
179	>	procedure IncMonitorCount;
180	>	procedure DecMonitorCount;
181	>	procedure SendTrace(TraceObject: TTraceObject);
182	>	procedure ReceiveTrace(TraceObject: TTraceObject);
183	>	property DataAvailableEvent: TSingleLockGate read FDataAvailableEvent;
184	>	property WriterBusyEvent: TSingleLockGate read FWriterBusyEvent;
185	>	property ReadReadyEvent: TMultiLockGate read FReadReadyEvent;
186	>	property ReadFinishedEvent: TMultiLockGate read FReadFinishedEvent;
187	>	property WriteLock: TMutex read FWriteLock;
188	>	property MonitorCount: integer read GetMonitorCount;
189	>	property SharedMemory: TSharedMemory read FSharedMemory;
190	>	property MaxBufferSize: integer read FMaxBufferSize;
191	>	end;
192	>
193	>	{ TSharedMemory }
194	>
195	>	procedure TSharedMemory.GetSharedMemory(MemSize: integer);
196	>	begin
197	>	FSharedBuffer := CreateFileMapping(INVALID_HANDLE_VALUE, sa, PAGE_READWRITE,
198	>	0, MemSize, PChar(MonitorHookNames[1]));
199	>
200	>	if GetLastError = ERROR_ALREADY_EXISTS then
201	>	FSharedBuffer := OpenFileMapping(FILE_MAP_ALL_ACCESS, false, PChar(MonitorHookNames[1]))
202	>	else
203	>	FInitialiser := true;
204	>	if (FSharedBuffer = 0) then
205	>	IBError(ibxeCannotCreateSharedResource, [GetLastError]);
206	>	end;
207	>
208	>	constructor TSharedMemory.Create(MemSize: integer);
209	>	begin
210	>	inherited Create;
211	>	FInitialiser := false;
212	>	GetSharedMemory(MemSize);
213	>	FBuffer := MapViewOfFile(FSharedBuffer, FILE_MAP_ALL_ACCESS, 0, 0, 0);
214	>
215	>	if FBuffer = nil then
216	>	IBError(ibxeCannotCreateSharedResource, [GetLastError]);
217	>	FBufPtr := FBuffer;
218	>	FUnused := MemSize
219	>	end;
220	>
221	>	destructor TSharedMemory.Destroy;
222	>	begin
223	>	UnmapViewOfFile(FBuffer);
224	>	CloseHandle(FSharedBuffer);
225	>	inherited Destroy;
226	>	end;
227	>
228	>	function TSharedMemory.Allocate(Size: integer): PChar;
229	>	begin
230	>	if Size > FUnused then
231	>	IBError(ibxeCannotCreateSharedResource, ['Not enough shared memory']);
232	>	Result := FBufPtr;
233	>
234	>	if Size = 0 then
235	>	begin
236	>	FLastAllocationSize := FUnused;
237	>	FUnused := 0
238	>	end
239	>	else
240	>	begin
241	>	FLastAllocationSize := Size;
242	>	Dec(FUnused,Size);
243	>	end;
244	>	Inc(FBufPtr,Size)
245	>	end;
246	>
247	>	{ TIpcCommon }
248	>
249	>	function TIpcCommon.GetSa: PSecurityAttributes;
250	>	begin
251	>	Result := @FSa
252	>	end;
253	>
254	>	constructor TIpcCommon.Create;
255	>	begin
256	>	{ Setup Security so anyone can connect to the MMF/Mutex/Event.  This is
257	>	needed when IBX is used in a Service. }
258	>
259	>	InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
260	>	SetSecurityDescriptorDacl(@Sd,true,nil,false);
261	>	FSa.nLength := SizeOf(FSa);
262	>	FSa.lpSecurityDescriptor := @Sd;
263	>	FSa.bInheritHandle := true;
264	>	end;
265	>
266	>
267	>	{ TMutex }
268	>
269	>	constructor TMutex.Create(MutexName: string);
270	>	begin
271	>	inherited Create;
272	>	if FInitialiser then
273	>	FMutex := CreateMutex(sa, False, PChar(MutexName))
274	>	else
275	>	FMutex := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(MutexName));
276	>
277	>	if FMutex = 0 then
278	>	IBError(ibxeCannotCreateSharedResource, [GetLastError])
279	>	end;
280	>
281	>	destructor TMutex.Destroy;
282	>	begin
283	>	CloseHandle(FMutex);
284	>	inherited Destroy;
285	>	end;
286	>
287	>	{ Obtain ownership of the Mutex and prevent other threads from accessing protected resource }
288	>
289	>	procedure TMutex.Lock;
290	>	begin
291	>	WaitForSingleObject(FMutex, INFINITE);
292	>	end;
293	>
294	>	{Give up ownership of the Mutex and allow other threads access }
295	>
296	>	procedure TMutex.Unlock;
297	>	begin
298	>	ReleaseMutex(FMutex);
299	>	end;
300	>
301	>	{ TSingleLockGate }
302	>	constructor TSingleLockGate.Create(EventName: string; AOwner: TGlobalInterface);
303	>	begin
304	>	inherited Create;
305	>	FOwner := AOwner;
306	>	if FInitialiser then
307	>	FEvent := CreateEvent(sa, true, true, PChar(EventName))
308	>	else
309	>	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
310	>
311	>	if FEvent = 0 then
312	>	IBError(ibxeCannotCreateSharedResource, [GetLastError])
313	>	end;
314	>
315	>	destructor TSingleLockGate.Destroy;
316	>	begin
317	>	CloseHandle(FEvent);
318	>	inherited Destroy;
319	>	end;
320	>
321	>
322	>	procedure TSingleLockGate.PassthroughGate;
323	>	begin
324	>	WaitForSingleObject(FEvent,INFINITE)
325	>	end;
326	>
327	>	procedure TSingleLockGate.Unlock;
328	>	begin
329	>	SetEvent(FEvent) //Event State set to "signaled"
330	>	end;
331	>
332	>	procedure TSingleLockGate.Lock;
333	>	begin
334	>	ResetEvent(FEvent) //Event State set to "unsignaled"
335	>	end;
336	>
337	>	{ TMultilockGate }
338	>
339	>	constructor TMultilockGate.Create(EventName: string; AOwner: TGlobalInterface);
340	>	begin
341	>	inherited Create;
342	>	FOwner := AOwner;
343	>	FLockCount := PInteger(FOwner.SharedMemory.Allocate(sizeof(FLockCount)));
344	>	FMutex := TMutex.Create(EventName + '.Mutex');
345	>	if FInitialiser then
346	>	begin
347	>	FEvent := CreateEvent(sa, true, true, PChar(EventName));
348	>	FLockCount^ := 0;
349	>	end
350	>	else
351	>	FEvent := OpenEvent(EVENT_ALL_ACCESS, true, PChar(EventName));
352	>
353	>	if FEvent = 0 then
354	>	IBError(ibxeCannotCreateSharedResource, [GetLastError])
355	>	end;
356	>
357	>	destructor TMultilockGate.Destroy;
358	>	begin
359	>	if assigned(FMutex) then FMutex.Free;
360	>	CloseHandle(FEvent);
361	>	inherited Destroy;
362	>	end;
363	>
364	>	function TMultilockGate.GetLockCount: integer;
365	>	begin
366	>	Result := FLockCount^
367	>	end;
368	>
369	>	procedure TMultilockGate.Lock;
370	>	begin
371	>	FMutex.Lock;
372	>	try
373	>	Inc(FLockCount^);
374	>	ResetEvent(FEvent);
375	>	finally
376	>	FMutex.Unlock;
377	>	end;
378	>	//writeln('Lock '+IntToStr(FLockCount^));
379	>	end;
380	>
381	>	procedure TMultilockGate.Unlock;
382	>	begin
383	>	//writeln('Start UnLock '+IntToStr(FLockCount^));
384	>	FMutex.Lock;
385	>	try
386	>	Dec(FLockCount^);
387	>	if FLockCount^ <= 0 then
388	>	begin
389	>	SetEvent(FEvent);
390	>	FLockCount^ := 0
391	>	end;
392	>	finally
393	>	FMutex.Unlock;
394	>	end;
395	>	//writeln('UnLock '+IntToStr(FLockCount^));
396	>	end;
397	>
398	>	procedure TMultilockGate.PassthroughGate;
399	>	begin
400	>	if FLockCount^ = 0 then
401	>	Exit;
402	>	while WaitForSingleObject(FEvent,cDefaultTimeout)= WAIT_TIMEOUT do
403	>	{ If we have timed out then we have lost a reader }
404	>	begin
405	>	if FLockCount^ > 0 then
406	>	begin
407	>	UnLock;
408	>	if assigned(FOnGateTimeout) then
409	>	OnGateTimeout(self)
410	>	end
411	>	end;
412	>	end;
413	>
414	>
415	>	{ TGlobalInterface }
416	>
417	>	function TGlobalInterface.GetMonitorCount: integer;
418	>	begin
419	>	Result := FMonitorCount^
420	>	end;
421	>
422	>	procedure TGlobalInterface.HandleGateTimeout(Sender: TObject);
423	>	begin
424	>	//writeln(ClassName+': Gate TimeOut');
425	>	DecMonitorCount
426	>	end;
427	>
428	>	constructor TGlobalInterface.Create;
429	>	begin
430	>	inherited Create;
431	>	FSharedMemory := TSharedMemory.Create(cMonitorHookSize);
432	>
433	>	FWriteLock := TMutex.Create(PChar(MonitorHookNames[0]));
434	>	FDataAvailableEvent := TSingleLockGate.Create(MonitorHookNames[2],self);
435	>	FWriterBusyEvent := TSingleLockGate.Create(MonitorHookNames[3],self);
436	>	FReadReadyEvent := TMultiLockGate.Create(MonitorHookNames[4],self);
437	>	FReadReadyEvent.OnGateTimeout  := HandleGateTimeout;
438	>	FReadFinishedEvent := TMultiLockGate.Create(MonitorHookNames[5],self);
439	>	FReadFinishedEvent.OnGateTimeout  := HandleGateTimeout;
440	>
441	>	FMonitorCount := PInteger(FSharedMemory.Allocate(sizeof(FMonitorCount)));
442	>
443	>	if FInitialiser then
444	>	FMonitorCount^ := 0;
445	>	FTraceDataType := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
446	>	FTimeStamp := PDateTime(FSharedMemory.Allocate(sizeof(TDateTime)));
447	>	FBufferSize := PInteger(FSharedMemory.Allocate(sizeof(Integer)));
448	>	FBuffer := FSharedMemory.Allocate(0); //All remaining
449	>	FMaxBufferSize := FSharedMemory.LastAllocationSize;
450	>
451	>	if FInitialiser then
452	>	begin
453	>	FBufferSize^ := 0;
454	>	FDataAvailableEvent.Lock
455	>	end;
456	>	end;
457	>
458	>	destructor TGlobalInterface.Destroy;
459	>	begin
460	>	if assigned(FWriteLock) then FWriteLock.Free;
461	>	if assigned(FDataAvailableEvent) then FDataAvailableEvent.Free;
462	>	if assigned(FWriterBusyEvent) then FWriterBusyEvent.Free;
463	>	if assigned(FReadReadyEvent) then FReadReadyEvent.Free;
464	>	if assigned(FReadFinishedEvent) then FReadFinishedEvent.Free;
465	>	if assigned(FSharedMemory) then FSharedMemory.Free;
466	>	inherited Destroy;
467	>	end;
468	>
469	>	procedure TGlobalInterface.IncMonitorCount;
470	>	begin
471	>	InterlockedIncrement(FMonitorCount^)
472	>	end;
473	>
474	>	procedure TGlobalInterface.DecMonitorCount;
475	>	begin
476	>	InterlockedDecrement(FMonitorCount^)
477	>	end;
478	>
479	>	procedure TGlobalInterface.SendTrace(TraceObject: TTraceObject);
480	>	begin
481	>	FTraceDataType^ := Integer(TraceObject.FDataType);
482	>	FTimeStamp^ := TraceObject.FTimeStamp;
483	>	FBufferSize^ := Min(Length(TraceObject.FMsg), MaxBufferSize);
484	>	Move(TraceObject.FMsg[1], FBuffer^, FBufferSize^);
485	>	end;
486	>
487	>	procedure TGlobalInterface.ReceiveTrace(TraceObject: TTraceObject);
488	>	begin
489	>	SetString(TraceObject.FMsg, FBuffer, FBufferSize^);
490	>	TraceObject.FDataType := TTraceFlag(FTraceDataType^);
491	>	TraceObject.FTimeStamp := TDateTime(FTimeStamp^);
492	>	end;
493	>
494	>
495	>

Diff Legend

–	Removed lines
+	Added lines
<	Changed lines
>	Changed lines