unit fmslots;

{
  Una mailslot e' una forma di IPC (Inter Process Communication)
  utilizzabile sotto Dos con LanManager e Windows9x/NT/etc che fornisce
  un canale unidirezionale attraverso il quale possono essere spediti
  messaggi (datagrammi).  Qualunque programma dos/win puo' scrivere
  in una mailslot, ma soltanto il creatore dalla mailslot puo' leggerla.

  La sintassi dei nomi delle mailslot e' la seguente:
   - ms locale: \mailslot[\<path>]\<nome>
   - ms remota: \\<host>\mailslot[\<path>]\<nome>
   - broadcast: \\*\mailslot[\<path>]\<nome>

  dove <host> e' il nome NetBIOS della macchina su cui si trova la
  mailslot mentre <path> e <name> seguono le convenzioni 8.3.
  Si puo' scrivere in qualsiasi mailslot, ma possono essere create solo
  mailslot locali.
}

 interface {$X+}

  type
   mailslot = word;

  const
{ msMailslotSize - Dimensione della mailslot, deve essere compresa fra
  4kB e 64kB~ (precisamente 4096 < size < 65526) e comunque maggiore
  della dimensione massima del messaggio + 1 }
   msMailslotSize: word =  8192;

{ msBufferSize - Dimensione del buffer utilizzato per la mailslot, deve
  essere maggiore della dimensione della mailslot + 9 }
   msBufferSize: word = 10240;

{ msInvalidHandle - costante per indicare un handle a mailslot non valido }
   msInvalidHandle = $ffff;

{ msTimeout* - costanti per i timeout estremi delle operazione read/write }
   msTimeoutNone    =         0;
   msTimeoutForever = $ffffffff;

{ msE* - costanti per gli errori piu' comuni restituiti in msError/DosError
  per gli errori non in elenco fare riferimento a DosError o al Win32 SDK }
   msENone          =   0;
   msEBadNetpath    =  53; { percorso di rete non valido }
   msETimeout       = 121; { l'operazione ha terminato il tempo di attesa }
   msEInvalidName   = 123; { nome della mailslot non valido }
   msEAlreadyExists = 183; { mailslot gia' esistente }

  var
{ msError - riporta il codice di errore restituito dall'ultima operazione
  eseguita. Equivale alla DosError della unit dos }
   msError : integer;

{ CreateMailslot - crea la mailslot name specificando la dimensione
  massima dei messaggi ricevibili a maxMsgSize.
  Ritorna l'handle alla mailslot creata, oppure msInvalidHandle }
  function CreateMailslot
   (name: string; maxMsgSize: word): mailslot;

{ ReadMailslot - Legge size bytes dalla mailslot handle e li memorizza
  nella variabile puntata da buffer, attendendo al massimo timeout msec.
  Ritorna il numero di byte effettivamente letti }
  function ReadMailslot
   (handle: mailslot; buffer: pointer; size: word; timeout: longint): word;

{ MailslotMsgCount - restituisce il numero di messaggi in coda alla
  mailslot specificata }
  function MailslotMsgCount
   (handle: mailslot): integer;

{ MailslotMsgSize - restituisce la dimensione del prossimo messaggio in
  coda alla mailslot specificata }
  function MailslotMsgSize
   (handle: mailslot): word;

{ DeleteMailslot - chiude la mailslot specificata e ne dealloca le
  risorse temporanee }
  procedure DeleteMailslot
   (handle: mailslot);

{ WriteMailslot - invia size bytes presi dalla variabile puntata da buffer
  alla mailslot name, attendendo un massimo di timeout millisecondi.
  Ritorna true se l'operazione ha successo }
  function WriteMailslot
   (name: string; buffer: pointer; size: word; timeout: longint): boolean;

 implementation

  uses fms, dos;

  const
   MAX_MAILSLOT_NUM = 32;

  type
   inforec = record
    handle: word;
    bfsize: word;
    buffer: pointer;
   end;

  var
   infotmp : msMailslotInfoRec;
   msinfo  : array[0..MAX_MAILSLOT_NUM-1] of ^inforec;
   oldep   : pointer;

  function firstLocFree: integer;
   var
    n: word;
   begin
    firstLocFree := -1;
    for n := 0 to MAX_MAILSLOT_NUM-1 do
     if msinfo[n] = nil then
      begin
       firstLocFree := n;
       break;
      end;
   end;

  function CreateMailslot(name: string; maxMsgSize: word): mailslot;
   var
    hnd: word;
    loc: integer;
   begin
    CreateMailslot := msInvalidHandle;
    if maxMsgSize < msMailslotSize then
     begin
      loc := firstLocFree;
      if loc > 0 then
       begin
        GetMem(msinfo[loc], sizeof(inforec));
        GetMem(msinfo[loc]^.buffer, msBufferSize);
        if msinfo[loc] <> nil then
         begin
          hnd := DosMakeMailslot(name, msinfo[loc]^.buffer,
                                  maxMsgSize, msMailslotSize);
          if hnd <> 0 then
           begin
            CreateMailslot := hnd;
            msinfo[loc]^.handle := hnd;
            msinfo[loc]^.bfsize := msBufferSize;
           end;
         end;
      end;
     end;
    msError := DosError;
   end;

  function ReadMailslot(handle: mailslot; buffer: pointer;
                         size: word; timeout: longint): word;
   begin
    DosReadMailslot(handle, buffer, size, timeout);
    ReadMailslot := size;
    msError := DosError;
   end;

  function MailslotMsgCount(handle: mailslot): integer;
   begin
    if DosMailslotInfo(handle, infotmp) then
     begin
      MailslotMsgCount := infotmp.WaitingMsgs;
      msError := 0;
     end
    else
     begin
      MailslotMsgCount := -1;
      msError := DosError;
     end;
   end;

  function MailslotMsgSize(handle: mailslot): word;
   begin
    if DosMailslotInfo(handle, infotmp) then
     begin
      MailslotMsgSize := infotmp.NextMsgSize;
      msError := 0;
     end
    else
     begin
      MailslotMsgSize := 0;
      msError := DosError;
     end;
   end;


  procedure DeleteMailslot(handle: mailslot);
   var
    n: word;
   begin
    for n := 0 to MAX_MAILSLOT_NUM - 1 do
     if msinfo[n] <> nil then
      if msinfo[n]^.handle = handle then
       begin
        DosDeleteMailslot(msinfo[n]^.handle);
        FreeMem(msinfo[n]^.buffer, msinfo[n]^.bfsize);
        FreeMem(msinfo[n], sizeof(inforec));
        msinfo[n] := nil;
        msError := DosError;
        break;
       end;
   end;

  function WriteMailslot(name: string; buffer: pointer;
                         size: word; timeout: longint): boolean;
   begin
    WriteMailslot := DosWriteMailslot(name, buffer, size, timeout);
    msError := DosError;
   end;

  procedure msEntryProc;
   var
    n: word;
   begin
    for n := 0 to MAX_MAILSLOT_NUM - 1 do
     msinfo[n] := nil;
   end;

  procedure msExitProc; far;
   var
    n : word;
   begin
    for n := 0 to MAX_MAILSLOT_NUM - 1 do
     if msinfo[n] <> nil then
      begin
       DosDeleteMailslot(msinfo[n]^.handle);
       FreeMem(msinfo[n]^.buffer, msinfo[n]^.bfsize);
       FreeMem(msinfo[n], sizeof(inforec));
      end;
   end;

 begin
  msEntryProc;
  oldep := ExitProc;
  ExitProc := @msExitProc
 end.