unit fms;
{
  Implementazione delle chiamate all'int21 per l'utilizzo di mailslot a
  basso livello. Riferimenti dalla Ralph Brown's Interrupt List

  Note:
   - la funzione DosPeekMailslot non e' supportata sotto Win9x/NT/etc
   - priorita' e classe non hanno effetto sotto Win9x/NT/etc,
     qua sono utilizzate per difetto classe 2 e priorita' 0
}
 interface

  type
   msMailslotInfoRec = record
    MaxMsgSize,
    MailslotSize,
    NextMsgSize,
    NextMsgPriority,
    WaitingMsgs      : word;
   end;

{ INT 21 u - LAN Manager Enhanced DOS - DosMakeMailslot
	AX = 5F4Dh
	BX = message size
	CX = mailslot size (must be bigger than message size by at least 1)
			   (minimum 1000h, maximum FFF6h)
			   (buffer must be 9 bytes bigger than this)
	DS:SI -> name
	ES:DI -> memory buffer
Return: CF clear if successful
	    AX = handle
	CF set on error
	    AX = error code
}
  function DosMakeMailslot
   (name: string; buffer: pointer; msgsize, mailslotsize: word): word;


{ INT 21 u - LAN Manager Enhanced DOS - DosReadMailslot
	AX = 5F50h
	BX = handle
	DX:CX = timeout
	ES:DI -> buffer
Return: CF clear if successful
	    AX = bytes read
	    CX = next item's size
	    DX = next item's priority
	CF set on error
	    AX = error code
}
  function DosReadMailslot
   (handle: word; buffer: pointer; var size: word; timeout: longint): word;


{ INT 21 u - LAN Manager Enhanced DOS - DosPeekMailslot
	AX = 5F51h
	BX = handle
	ES:DI -> buffer
Return: CF clear if successful
	    AX = bytes read
	    CX = next item's size
	    DX = next item's priority
	CF set on error
	    AX = error code
}
  function DosPeekMailslot  { non supportata sotto win9x/NT/etc !! }
   (handle: word; buffer: pointer; var size: word): word;


{ INT 21 u - LAN Manager Enhanced DOS - DosMailslotInfo
	AX = 5F4Fh
	BX = handle
Return: CF clear if successful
	    AX = max message size
	    BX = mailslot size
	    CX = next message size
	    DX = next message priority
	    SI = number of messages waiting
	CF set on error
	    AX = error code
}
  function DosMailslotInfo
   (handle: word; var info: msMailslotInfoRec): boolean;


{ INT 21 u - LAN Manager Enhanced DOS - DosWriteMailslot
	AX = 5F52h
	BX = class
	CX = length of buffer
	DX = priority
	ES:DI -> DosWriteMailslot parameter structure (see #01726)
	DS:SI -> mailslot name
Return: CF clear if successful
	CF set on error
	    AX = error code
}
  function DosWriteMailslot
   (name: string; buffer: pointer; size: word; timeout: longint): boolean;


{ INT 21 u - LAN Manager Enhanced DOS - DosDeleteMailslot
	AX = 5F4Eh
	BX = handle
Return: CF clear if successful
	    ES:DI -> memory to be freed (allocated during DosMakeMailslot)
	CF set on error
	    AX = error code
}
  function DosDeleteMailslot
   (handle: word): pointer;

 implementation

  uses dos;

  var
   Regs: Registers;

{ Format of LAN Manager DosWriteMailslot parameter structure:
  Offset	Size	Description	(Table 01726)
     00h	DWORD	timeout
     04h	DWORD	-> buffer
}
  type
   msWriteRec = record
    timeout: longint;
    buffer:  pointer;
   end;

 function DosMakeMailslot(name: string; buffer: pointer;
                          msgsize, mailslotsize: word): word;
  var
   msname: string;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F4D;
   regs.bx := msgsize;
   regs.cx := mailslotsize;
   msname := name + #0;
   regs.ds := seg(msname[1]);
   regs.si := ofs(msname[1]);
   regs.es := seg(buffer^);
   regs.di := ofs(buffer^);
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosMakeMailslot := 0;
    end
   else
    begin
     DosError := 0;
     DosMakeMailslot := regs.ax;
    end;
  end;

 function DosReadMailslot(handle: word; buffer: pointer;
                          var size: word; timeout: longint): word;
  var
   msname: string;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F50;
   regs.bx := handle;
   regs.dx := timeout shr 16;
   regs.cx := timeout and $FFFF;
   regs.es := seg(buffer^);
   regs.di := ofs(buffer^);
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosReadMailslot := $FFFF;
     size := 0;
    end
   else
    begin
     DosError := 0;
     DosReadMailslot := regs.cx;
     size := regs.ax;
    end;
  end;

 function DosPeekMailslot(handle: word; buffer: pointer;
                          var size: word): word;
  var
   msname: string;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F51;
   regs.bx := handle;
   regs.es := seg(buffer^);
   regs.di := ofs(buffer^);
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosPeekMailslot := $FFFF;
     size := 0;
    end
   else
    begin
     DosError := 0;
     DosPeekMailslot := regs.cx;
     size := regs.ax;
    end;
  end;

 function DosMailslotInfo(handle: word; var info: msMailslotInfoRec): boolean;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F4F;
   regs.bx := handle;
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosMailslotInfo := false;
    end
   else
    begin
     DosError := 0;
     DosMailslotInfo := true;
     info.MaxMsgSize := regs.ax;
     info.MailslotSize := regs.bx;
     info.NextMsgSize := regs.cx;
     info.NextMsgPriority := regs.dx;
     info.WaitingMsgs := regs.si;
    end;
  end;

 function DosDeleteMailslot(handle: word): pointer;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F4E;
   regs.bx := handle;
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosDeleteMailslot := nil;
    end
   else
    begin
     DosError := 0;
     DosDeleteMailslot := Ptr(regs.es, regs.di);
    end;
  end;

 function DosWriteMailslot(name: string; buffer: pointer; size: word;
                           timeout: longint): boolean;
  var
   msname: string;
   st : msWriteRec;
  begin
   FillChar (regs, SizeOf(regs), 0);
   regs.ax := $5F52;
   regs.bx := 2;
   regs.cx := size;
   regs.dx := 0;
   msname := name + #0;
   st.timeout := timeout;
   st.buffer  := buffer;
   regs.es := seg(st);
   regs.di := ofs(st);
   regs.ds := seg(msname[1]);
   regs.si := ofs(msname[1]);
   MsDos(regs);
   if (regs.flags and fCarry) <> 0 then
    begin
     DosError := regs.ax;
     DosWriteMailslot := false;
    end
   else
    begin
     DosError := 0;
     DosWriteMailslot := true;
    end;
  end;

 end.