program mscat;
{$X+}
{$M 4096, 131072, 131072}
uses fmslots;
const
version = '0.1';
{ default values for command line parameters }
name : string = '';
listen : boolean = false;
harder : boolean = false;
msgsize : word = 128;
SOnEoL : boolean = false;
timeout : longint = 1000;
{ internal default values }
mscMailslotSize = 48*1024 + 32; { 48kB + 32 }
mscBufferSize = 60*1024 + 32; { 60KB + 32 }
{ internal error codes }
eMsg : string = '';
eNoError = 0;
eBadCmdLine = 1;
eUnknownOpt = 2;
eBadParameter = 3;
eBadValue = 4;
{ internal error strings }
errmsg : array[0..4] of string[32] =
('No error !', 'Bad command line', 'Unknown option', 'Bad parameter',
'Bad value');
procedure displayHelp;
begin
writeln('Dreadnaut's Mailslot cat ' + version );
writeln(' usage: mscat [options] <mailslotname>');
writeln(' send mscat [-m<>|-M] [-w<>] <mailslotname>');
writeln(' receive mscat [-l|-L] [-m<>] [-w<>|-W] <mailslotname>');
writeln(# options:');
writeln(' -h this help');
writeln(' -l listen on local mailslot');
writeln(' -L listen harder - relisten after timeout, quit on Ctrl');
writeln(' -m<msgsize> set message size (up to 16384 bytes) [default ',msgsize,']');
writeln(' -M auto send messages on EoL');
writeln(' -w<timeout> set wait timeout on send/receive (in msec) [default ',timeout,']');
writeln(' -W wait forever on receive (pay attention !)');
writeln(# mailslot name syntax:');
writeln(' local \mailslot[\<path>]\<name> send/receive');
writeln(' remote \\<host>\mailslot[\<path>]\<name> send only');
writeln(' broadcast \\*\mailslot[\<path>]\<name> send only');
halt(0);
end;
function checkOptions: integer;
var
optl, optw, optm : boolean;
tmpw : word;
tmpi : integer;
tmpl : longint;
n: word;
s: string;
echeckOptions: integer;
begin
optl := true;
optw := true;
optm := true;
echeckOptions := 0;
for n := 1 to ParamCount do
begin
s := ParamStr(n);
if s[1] <> '-' then
if n < ParamCount then
begin
echeckOptions := eBadCmdLine;
break;
end
else name := s
else
case s[2] of
'h' : displayHelp;
'L' : if optl then
begin
listen := true;
harder := true;
optl := false;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -L';
break;
end;
'l' : if optl then
begin
listen := true;
optl := false;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -l';
break;
end;
'W' : if optw then
begin
timeout := msTimeoutForever;
optw := false;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -W';
break;
end;
'M' : if optm then
begin
soneol := true;
optm := false;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -M';
break;
end;
'm': if optm then
begin
if length(s) > 2 then
begin
Val(copy(s,3,length(s)), tmpw, tmpi);
if tmpi > 0 then
begin
echeckOptions := eBadParameter;
eMsg := '-m needs <msgsize> value';
break;
end;
msgsize := tmpw;
if (msgsize < 1) or (msgsize > 16384) then
begin
echeckOptions := eBadValue;
eMsg := '<msgsize> must be between 1 and 16384';
break;
end;
optm := false;
end
else
if n < ParamCount then
begin
Val(ParamStr(n+1), tmpw, tmpi);
if tmpi > 0 then
begin
echeckOptions := eBadParameter;
eMsg := '-m needs <msgsize> value';
break;
end;
msgsize := tmpw;
if (msgsize < 1) or (msgsize > 16384) then
begin
echeckOptions := eBadValue;
eMsg := '<msgsize> must be between 1 and 16384';
break;
end;
inc(n);
optm := false;
end
else
begin
echeckOptions := eBadParameter;
eMsg := '-m needs <msgsize> value';
break;
end;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -m';
break;
end;
'w': if optw then
begin
if length(s) > 2 then
begin
Val(copy(s,3,length(s)), tmpl, tmpi);
if tmpi > 0 then
begin
echeckOptions := eBadParameter;
eMsg := '-w needs <timeout> value';
break;
end;
timeout := tmpl;
if timeout < 0 then
begin
echeckOptions := eBadValue;
eMsg := '<timeout> must positive';
break;
end;
optw := false;
end
else
if n < ParamCount then
begin
Val(ParamStr(n+1), tmpl, tmpi);
if tmpi > 0 then
begin
echeckOptions := eBadParameter;
eMsg := '-w needs <timeout> value';
break;
end;
timeout := tmpl;
if timeout < 0 then
begin
echeckOptions := eBadValue;
eMsg := '<timeout> must positive';
break;
end;
optw := false;
inc(n);
end
else
begin
echeckOptions := eBadParameter;
eMsg := '-w needs <timeout> value';
break;
end;
end
else
begin
echeckOptions := eBadCmdLine;
eMsg := 'duplicate -w';
break;
end
else begin
echeckOptions := eUnknownOpt;
eMsg := #39 + s[2] + #39;
break;
end;
end;
end;
if (echeckOptions = 0) and (name = '') then
begin
echeckOptions := eBadCmdLine;
eMsg := '<mailslotname> missing';
end;
checkOptions := echeckOptions;
end;
var
buffer: PChar;
function CtrlHit: boolean;
begin
if (Mem[0:1047] and 4) <> 0 then CtrlHit := true
else CtrlHit := false;
end;
function sendData: integer;
var
sz : word;
c : char;
begin
while not(Eof) do
begin
sz := 0;
while not(Eof) and (sz < msgsize) do
begin
read(c);
buffer[sz] := c;
inc(sz);
if soneol and (c = #10) then break;
end;
WriteMailslot(name, buffer, sz, 0);
if msError <> 0 then break;
end;
sendData := msError;
end;
function receiveData: integer;
var
ms : mailslot;
sz : word;
begin
ms := CreateMailslot(name, msgsize);
receiveData := msError;
if ms <> msInvalidHandle then
begin
repeat
sz := ReadMailslot(ms, buffer, msgsize, timeout);
if harder then
while (msError = msETimeout) and not(CtrlHit) do
sz := ReadMailslot(ms, buffer, msgsize, timeout);
buffer[sz] := #0;
write(buffer);
until (msError <> 0) or (harder and CtrlHit);
receiveData := msError;
DeleteMailslot(ms);
end;
end;
function localName: boolean;
begin
localName := (copy(name, 1, 9) = '\mailslot');
end;
var
res: integer;
begin
msMailslotSize := mscMailslotSize;
msBufferSize := mscBufferSize;
if ParamCount = 0 then
displayHelp;
res := checkOptions;
if res <> 0 then
begin
write(' - ',errmsg[res]);
if eMsg <> '' then writeln(': ' + eMsg)
else writeln;
halt($1000+res);
end;
if listen then
begin
if soneol then
begin
writeln(' - Incompatible options');
halt($1010);
end;
if not localName then
begin
writeln(' - Listening allowed only on local mailslots');
halt($1011);
end;
end;
{
writeln ('error = ', res, ' ', eMsg);
writeln ('timeout: ', timeout);
writeln ('listen: ', listen);
writeln ('harder: ', harder);
writeln ('name: ', name);
writeln ('msgsize: ', msgsize);
}
GetMem(buffer, msgsize+1);
if buffer <> nil then
begin
if listen then
res := receiveData
else
res := sendData;
if (res <> 0) and (res <> msETimeout) then
begin
write(' - Error (', res, '): '); (* *)
case res of
msEBadNetpath : writeln('bad net path');
msEInvalidName : writeln('invalid mailslot name');
msEAlreadyExists : writeln('mailslot already exists');
2 : writeln('mailslot not found');
else writeln('see dos/windows error code reference');
end;
end;
FreeMem(buffer, msgsize+1);
end
else
writeln(' not enough memory ! (', msgsize, ' needed)');
end.