(Ebook - Pdf) Kick Ass Delphi Programming
.pdf{Create a semaphore to control access to the mapped memory. If the handle comes back zero, we failed for some reason. }
SemaphoreHnd := CreateSemaphore(nil, 0, 1, SemaphoreName); LastErr := GetLastError;
if (SemaphoreHnd = 0) then begin
CloseHandle(ArrayHnd);
UnmapViewOfFile(ArrayBasePtr);
Exit;
end;
{Save then exit chain and insert the finalization routine. } SaveExit := ExitProc;
ExitProc := @FinalizeLibrary;
{If we created the semaphore, then force it to its "signaled" state. } if LastErr <> ERROR_ALREADY_EXISTS
then ReleaseSemaphore(SemaphoreHnd, 1, nil);
DLLValid := True; end.
Products | Contact Us | About Us | Privacy | Ad Info | Home
Use of this site is subject to certain Terms & Conditions, Copyright © 1996-2000 EarthWeb Inc.
All rights reserved. Reproduction whole or in part in any form or medium without express written permission of EarthWeb is prohibited. Read EarthWeb's privacy statement.
location. (Since the memory file can be considered merely as a chunk of memory, that’s how it will be treated from here on.)
The location of the memory is mapped to a pointer within the application through a call to MapViewOfFile, using the handle returned by CreateFileMapping. In this example, the value is assigned to ArrayBasePtr. The combination of calling CreateFileMapping and MapViewOfFile is a lot like making a call to GetMem.
Signals from a Semaphore
“Okay, Wunderkind,” said the old guy wearing the shopping bag. “How are you gonna keep multiple instances of the DLL from clobbering the shared memory? What if one instance adds something, and then another instance comes in right behind it and adds it again?”
“That’s a fair question,” I replied. “I think this situation calls for a semaphore.”
Win95 provides several synchronization objects, ranging from the trivial to the complex—semaphores, events, and mutexes. But for restricting access to the memory in this situation, the clear choice would be a semaphore. This puppy would enable different processes to cooperatively use the memory through a signal-and-counter system. Like the call to CreateFileMapping, the call to CreateSemaphore either returns the handle to a newly created object (in this case a semaphore), or the handle to an existing object, while generating an ERROR_ALREADY_EXISTS error code. If a new instance of the DLL creates the semaphore, it is given the sole responsibility for setting the semaphore to its signaled state.
By “signaled,” it means the semaphore’s counter has a non-zero value. Each time a process executes a call to WaitForSingleObject using the semaphore’s handle, the semaphore’s counter is examined. If it is non-zero, the counter is decremented by one and the next program statement in the process is executed. If the counter is already zero, the process goes into an efficient time-wasting loop, waiting for the counter to change to a non-zero value (or a timeout value to be exceeded).
The code in this example permits only two values (0 and 1) for the semaphore counter, effectively turning it into an off/on switch. One of our design goals was that, as long as one instance of a DLL was accessing the shared memory—for any purpose—no other instance could gain access at the same time. Listing 15.4 is an example routine that shows how we could use a semaphore to achieve that goal.
Listing 15.4 Using a semaphore to control memory access
procedure DoSomething; begin
WaitForSingleObject(SemaphoreHnd, INFINITE); DoSomeStuffWithTheMemory; ReleaseSemaphore(SemaphoreHnd, 1, nil);
end;
In this simple example, we first test the value of the semaphore. If another process is accessing the memory at the moment, the semaphore will be in its non-signaled state (0), and we will wait until forever (as specified by the INFINITE timeout constant), if necessary, for the semaphore to change to its signaled state (1).
Once the semaphore is signaled, its counter is automatically decremented by one (to zero), and our process goes ahead and DoSomeStuffWithTheMemory executes. While this is going on, any other process that examines the semaphore will find it unsignaled and (if the process has properly used a call to WaitForSingleObject) it will bide its time until we’re through.
When we’re all done with the memory, we place a call to ReleaseSemaphore, which will increment the semaphore’s counter by the amount we specify. We use a value of one, in effect turning “on” the semaphore “switch.”
Products | Contact Us | About Us | Privacy | Ad Info | Home
Use of this site is subject to certain Terms & Conditions, Copyright © 1996-2000 EarthWeb Inc.
All rights reserved. Reproduction whole or in part in any form or medium without express written permission of EarthWeb is prohibited. Read EarthWeb's privacy statement.
by Object Pascal.
The NumMsgReceivers function provides a good example of this technique. A pointer of type PMsgReceiverRec is assigned to the base address. Each time a record is examined, the Inc procedure is used to advance the pointer by exactly the size of a TMsgReceiverRec. Tracking the process with an index variable prevents us from accessing memory outside the bounds of the memory block we have been allocated. The NumMsgReceivers function simply counts all the records that have their Assigned field set True.
The Assigned field is managed by two routines, RegisterReceiver and
UnregisterReceiver. RegisterReceiver looks for the first unused record and, after clearing it, stores the handle value and class name passed into
RegisterReceiver. It also sets the record’s Assigned field True.
UnregisterReceiver, to no great surprise, does pretty much the opposite. It searches the fields with Assigned set True, looking for a handle value that matches the one specified. If the record is found, it sets the Assigned field
False.
BroadcastToOne, BroadcastToClass, and BroadcastToAll use the
SendMessage API function to transmit a message to the handle of a specific form, handles of all active forms of a given class name, or the handles of all active forms in the list. BroadcastToOne returns the value returned to it from the call to SendMessage; the other two return the first non-zero value returned by a call to SendMessage.
FirstReceiverAssigned and NextReceiverAssigned together provide a way for a user of the DLL to construct a list of all currently active record numbers in the array. It works a bit like the DOS FindFirst and FindNext routines. In this case, FirstReceiverAssigned returns an index to the first active form in the array. If that index value is then passed to NextReceiverAssigned, it will return an index to the next form, starting its search from the specified index. If no active form is found, these routines return a negative one.
Finally, BcastDLLValid returns a boolean that indicates whether or not the DLL was able to set up (or connect to) the required shared memory and the semaphore.
Products | Contact Us | About Us | Privacy | Ad Info | Home
Use of this site is subject to certain Terms & Conditions, Copyright © 1996-2000 EarthWeb Inc.
All rights reserved. Reproduction whole or in part in any form or medium without express written permission of EarthWeb is prohibited. Read EarthWeb's privacy statement.
{ |
|
|
} |
{ Written for *Kick-Ass Delphi Programming* |
} |
||
{ Copyright (c) 1996 |
The Coriolis Group, Inc. |
} |
|
{ |
Last |
Updated 5/2/96 |
} |
{———————————————————————————————————————————————————}
unit MsgSendr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
type
TBcastDLLValid = function : Boolean;
TRegisterReceiver = procedure(Hnd : THandle; CName : ShortString); TUnregisterReceiver = procedure(Hnd : THandle);
TBroadcastToClass = function(CName : ShortString; MessageID : Word; wParam : Word;
lParam : Longint) : Longint;
TBroadcastToAll = function(MessageID : Word; wParam : Word;
lParam : Longint) : Longint;
TBroadcastToOne = function(MessageID : Word; RcvNum : Integer; wParam : Word;
lParam : Longint) : Longint;
TNumClassMsgReceivers = function(CName : ShortString) : Integer; TNumMsgReceivers = function : Integer;
TFirstReceiverAssigned = function : Integer; TNextReceiverAssigned = function(RcvrNum : Integer) : Integer;
TMsgSender = class(TComponent) private
FIDString : ShortString; FMessageID : Word; LibraryHandle : THandle; DLLValid : Boolean; BcastDLLValid : TBcastDLLValid;
BroadcastToClass : TBroadcastToClass; BroadcastToAll : TBroadcastToAll; BroadcastToOne : TBroadcastToOne; NumClassMsgReceivers : TNumClassMsgReceivers; NumMsgReceivers : TNumMsgReceivers; FirstReceiverAssigned : TFirstReceiverAssigned; NextReceiverAssigned : TNextReceiverAssigned; procedure SetIDStr(NewID : ShortString); procedure RegisterIDStr;
public
ReceiverList : TStringList; { Read only -- do not modify! } constructor Create(AOwner : TComponent); override; destructor Destroy; override;
function ClassBroadcast(CName : ShortString; wParam : Word;
lParam : Longint) : Longint;
function AllBroadcast(wParam : Word; lParam : Longint) : Longint; function OneBroadcast
(RcvNum : Integer; wParam : Word; lParam : LongInt) : Longint; function NumClassReceivers(CName : ShortString) : Integer; function NumReceivers : Integer;
procedure UpdateReceiverList;
published
property IDString : ShortString read FIDString write SetIDStr; end;
procedure Register;
implementation
constructor TMsgSender.Create(AOwner : TComponent); begin
DLLValid := False; inherited Create(AOwner); FMessageID := 0;
if not (csDesigning in ComponentState) then begin
LibraryHandle := LoadLibrary('BCASTDLL.DLL'); if LibraryHandle > HINSTANCE_ERROR then
then begin
@BroadcastToClass :=
GetProcAddress(LibraryHandle, 'BroadcastToClass'); @BroadcastToAll :=
GetProcAddress(LibraryHandle, 'BroadcastToAll'); @BroadcastToOne :=
GetProcAddress(LibraryHandle, 'BroadcastToOne'); @NumClassMsgReceivers :=
GetProcAddress(LibraryHandle, 'NumClassMsgReceivers'); @NumMsgReceivers :=
GetProcAddress(LibraryHandle, 'NumMsgReceivers'); @FirstReceiverAssigned :=
GetProcAddress(LibraryHandle, 'FirstReceiverAssigned'); @NextReceiverAssigned :=
GetProcAddress(LibraryHandle, 'NextReceiverAssigned'); @BcastDLLValid :=
GetProcAddress(LibraryHandle, 'BcastDLLValid'); DLLValid := BcastDLLValid;
RegisterIDStr; end
else MessageDlg('Could not load DLL "BCASTDLL.DLL"', mtError, [mbOK], 0);
end;
ReceiverList := TStringList.Create; end;
destructor TMsgSender.Destroy; begin
ReceiverList.Free;
if not (csDesigning in ComponentState)
then if LibraryHandle > HINSTANCE_ERROR then
FreeLibrary(LibraryHandle); inherited Destroy;
end;
procedure TMsgSender.SetIDStr(NewID : ShortString); begin
if NewID <> FIDString then begin
FIDString := NewID; RegisterIDStr;
end;
end;
procedure TMsgSender.RegisterIDStr; var
IDStr : Array [0..255] of Char; begin
if not (csDesigning in ComponentState) and (Length(FIDString) > 0) then begin
StrPCopy(IDStr, FIDString);
FMessageID := RegisterWindowMessage(IDStr); end
else FMessageID := 0; end;
function TMsgSender.ClassBroadcast(CName : ShortString; wParam : Word;
lParam : Longint) : Longint;
begin
if DLLValid
then Result := BroadcastToClass(CName, FMessageID, wParam, lParam) else Result := -1;
end;
function TMsgSender.AllBroadcast(wParam : Word; lParam : Longint) : Longint;
begin
if DLLValid
then Result := BroadcastToAll(FMessageID, wParam, lParam) else Result := -1;
end;
function TMsgSender.OneBroadcast(RcvNum : Integer; wParam : Word;
lParam : Longint) : Longint;
begin
if DLLValid
then Result := BroadcastToOne(FMessageID, RcvNum, wParam, lParam) else Result := -1;
end;
function TMsgSender.NumClassReceivers(CName : ShortString) : Integer; begin
if DLLValid
then Result := NumClassMsgReceivers(CName) else Result := -1;
end;
function TMsgSender.NumReceivers : Integer; begin