mailslots and WaitFor*
Walter
free (don't-have-a-paying-job) time. I'm trying it with MailSlots
because named pipes won't work under Windows 98. The design
I'm working on is to have an ever-present agent handle all the
"real work," and have each process connect to / through it. I'm a
complete novice at this.
I was hoping to assign a mail slot to each connection (each
process), and use WaitForMultipleObject, but it does not accept
mail slot handles. I'd rather not create a thread for each mail slot,
as I figure (perhaps incorrectly) that many connections could use
more resources than otherwise, and as I think mutex-locking could
be minimized using one loop to handle each message (one at a time).
I'm wondering if I have to add in an event for each mail slot connect
to make W-F-M-O happy.
Can anyone give me some guidance here?
Thanks.
Walter
Leonid Troyanovsky
Walter wrote:
> I'm trying to develop a general purpose messaging system in my
> free (don't-have-a-paying-job) time. I'm trying it with MailSlots
> because named pipes won't work under Windows 98. The design
> I'm working on is to have an ever-present agent handle all the
> "real work," and have each process connect to / through it. I'm a
> complete novice at this.
A TMailSlot component is a server-end of the mailslot.
For send text message you may use SendToMailSlot regular procedure.
unit MailSlot;
{Win9x: do not use more then 8 symbols at the slot name}
interface
uses
Windows,
SysUtils,
Classes,
Forms,
Messages;
const
BufferSize = 240; // do not use more then 412 bytes
SignalCancelRead = ^C;
ReadTimeout : DWord = MAILSLOT_WAIT_FOREVER;
type
TThreadReader = class(TThread)
private
MasterHWND : Integer;
protected
hMailSlot : THandle;
InputBuffer : array [0..BufferSize-1] of Char;
Position : Word;
nbRead : DWord;
ErrorCode : DWord;
fromAddr: String;
fText : String;
MessageID : String;
procedure Execute; override;
function ExtractNextField : String;
end;
TMailSlot = class(TComponent)
private
fSlot : String;
fFromAddr : String;
fMessageID : String;
fMessageText : String;
fOnMessage : TNotifyEvent;
fWindowHandle : HWND;
procedure WndProc(var Msg: TMessage);
protected
sd: TSecurityDescriptor;
sa: TSecurityAttributes;
ThreadReader: TThreadReader;
procedure DoMessage; dynamic;
public
property FromAddr : String read fFromAddr;
property MessageID : String read fMessageID;
property MessageText : String read fMessageText;
procedure Open; virtual;
procedure Close; virtual;
constructor Create(AOwner:TComponent); override;
destructor Destroy; override;
published
property Slot: String
read fSlot
write fSlot;
property OnMessage : TNotifyEvent
read fOnMessage
write fOnMessage;
end;
procedure SendToMailSlot(const ToComp, ToSlot, Text: String);
procedure Register;
implementation
const
cbLocalMachine: DWord = MAX_COMPUTERNAME_LENGTH+1;
var
LocalMachine: array [0..MAX_COMPUTERNAME_LENGTH] of Char;
procedure SendToMailSlot;
var
hMailWriter: THandle;
cbWrite : DWord;
MessageID : String;
AComp : String;
ASlot : String;
OutputBuffer : array [0.. BufferSize-1] of Char;
procedure AddToBuff(s:String);
var
lens: Word;
begin
lens := Length(s);
if lens > 0 then
begin
move(s[1], OutputBuffer[cbWrite], lens);
inc(cbWrite,lens);
OutputBuffer[cbWrite] := #0;
inc(cbWrite);
end;
end;
begin
ASlot := Trim(ToSlot);
if (ASlot = '') then
raise Exception.Create('Invalid slot name');
AComp := Trim(ToComp);
if (AComp = '') then
AComp := '.'; // local machine
cbWrite := 0;
AddToBuff(LocalMachine);
MessageID := IntToStr(GetTickCount);
AddToBuff(MessageID);
AddToBuff(Text);
hMailWriter := CreateFile(PChar('\\'+AComp+'\mailslot\'+ASlot),
GENERIC_WRITE,
FILE_SHARE_READ ,
nil,
OPEN_EXISTING ,
FILE_ATTRIBUTE_NORMAL,
0);
Win32Check(hMailWriter <> INVALID_HANDLE_VALUE);
try
Win32Check( WriteFile(hMailWriter, OutputBuffer, cbWrite, cbWrite, nil));
finally
CloseHandle(hMailWriter);
end;
end;
function TThreadReader.ExtractNextField : String;
var
b : Char;
begin
Result := '';
while Position < nbRead -1 do
begin
b := InputBuffer[Position];
inc(Position);
if (b = #0) then
Break;
Result := Result + b;
end;
end;
procedure TThreadReader.Execute;
var
PrevValue: String;
begin
while not Terminated do
begin
ErrorCode := 0;
Position := 0;
if not ReadFile(hMailSlot, InputBuffer, BufferSize, nbRead, nil) then
begin
ErrorCode := GetLastError;
Continue;
end;
if nbRead = 0 then
Continue;
PrevValue := fromAddr + MessageID;
fromAddr := ExtractNextField;
if fromAddr = '' then
Continue; // Invalid addr
MessageID := ExtractNextField;
if MessageID = '' then
Continue; // Invalid ID
if (fromAddr + MessageID) = PrevValue then
Continue; // Skip duplicates;
fText := ExtractNextField;
if fText[1] = SignalCancelRead then
Break;
SendMessage( MasterHWND,
WM_USER+1,
0,
0);
end;
end;
constructor TMailSlot.Create;
begin
inherited Create(AOwner);
// Security descriptor - for NT
Win32Check( InitializeSecurityDescriptor(@sd, 1) and
SetSecurityDescriptorDACL(@sd, true, PAcl(nil), False));
sa.nLength:=SizeOf(sa);
sa.lpSecurityDescriptor:=@sd;
sa.bInheritHandle:= False;
FWindowHandle := AllocateHWnd(WndProc);
ThreadReader := nil;
end;
procedure TMailSlot.WndProc(var Msg: TMessage);
begin
with Msg do
if Msg = WM_USER+1 then
try
DoMessage;
except
Application.HandleException(Self);
end
else
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure TMailSlot.Open;
begin
if Assigned (ThreadReader) then
Exit;
ThreadReader := TThreadReader.Create(False);
with ThreadReader do
begin
MasterHWND := FWindowHandle;
ErrorCode := 0;
InputBuffer[0] := #0;
Position := 0;
fromAddr := '';
MessageID := '';
hMailSlot := CreateMailSlot( PChar('\\.\MAILSLOT\' + fSlot),
BufferSize,
ReadTimeout,
@sa);
try
Win32Check(hMailSlot <> INVALID_HANDLE_VALUE);
except
Close;
raise;
end;
end;
end;
procedure TMailSlot.Close;
begin
if Assigned (ThreadReader) then
begin
if (ThreadReader.hMailSlot <> INVALID_HANDLE_VALUE) then
begin
SendToMailSlot( '.',
fSlot,
SignalCancelRead);
ThreadReader.WaitFor;
CloseHandle(ThreadReader.hMailSlot);
end;
ThreadReader.Free;
ThreadReader := nil;
end;
end;
destructor TMailSlot.Destroy;
begin
Close;
DeallocateHWnd(FWindowHandle);
inherited Destroy;
end;
procedure TMailSlot.DoMessage;
begin
fFromAddr := ThreadReader.fromAddr;
fMessageID := ThreadReader.MessageID;
fMessageText := ThreadReader.fText;
if Assigned(fOnMessage) then
fOnMessage(Self);
end;
procedure Register;
begin
RegisterComponents('Samples', [TMailSlot]);
end;
initialization
GetComputerName(LocalMachine, cbLocalMachine);
end.
--
Regards, LVT.
Leonid Troyanovsky
Walter wrote:
> I'm trying to develop a general purpose messaging system in my
> free (don't-have-a-paying-job) time. I'm trying it with MailSlots
> because named pipes won't work under Windows 98. The design
> I'm working on is to have an ever-present agent handle all the
> "real work," and have each process connect to / through it. I'm a
> complete novice at this.
A TMailSlot component is a server-end of the mailslot.