unit MslotU;
{=================================================================}
{  Версия файла 3.0.000                                           }
{  от 4 декабря 2002 г.                                           }
{==========================} interface {==========================}

function  CreateMailslot(Name: String): Integer;
procedure SetMailslotTimeout(Slot, Timeout: Integer);
function  GetMailslotTimeout(Slot: Integer): Integer;
function  GetMailslotMessageCount(Slot: Integer): Integer;
function  GetMailslotMessageSize(Slot: Integer): Integer;
function  GetMailslotMaxMessageSize(Slot: Integer): Integer;
procedure SendMailslot(MS: Integer; var Buf; Count: Integer);
function  ReceiveMailslot(MS: Integer; var Buf; BufSize: Integer): Integer;
function  OpenMailslot(CompName, Name: String): Integer;
procedure CloseMailslot(MS: Integer);

function  GetComputerName: String;
function  GetUserName: String;

implementation

uses
  Windows;

function CreateMailslot(Name: String): Integer;
begin
  Name := '\\.\mailslot\' + Name;
  Result :=
    Windows.CreateMailslot(
      PChar(Name),
      1024,  // max msg size
      0,    // read timeout
      nil
    );
end;

procedure SetMailslotTimeout(Slot, Timeout: Integer);
begin
  SetMailslotInfo(Slot, Timeout);
end;

function GetMailslotTimeout(Slot: Integer): Integer;
var
  MaxMsgSize, NextSize, MsgCount, Timeout: DWORD;
begin
  GetMailslotInfo(Slot, @MaxMsgSize, NextSize, @MsgCount, @Timeout);
  Result := Timeout;
end;

function GetMailslotMessageCount(Slot: Integer): Integer;
var
  MaxMsgSize, NextSize, MsgCount, Timeout: DWORD;
begin
  GetMailslotInfo(Slot, @MaxMsgSize, NextSize, @MsgCount, @Timeout);
  Result := MsgCount;
end;

function GetMailslotMessageSize(Slot: Integer): Integer;
var
  MaxMsgSize, NextSize, MsgCount, Timeout: DWORD;
begin
  GetMailslotInfo(Slot, @MaxMsgSize, NextSize, @MsgCount, @Timeout);
  Result := NextSize;
end;

function GetMailslotMaxMessageSize(Slot: Integer): Integer;
var
  MaxMsgSize, NextSize, MsgCount, Timeout: DWORD;
begin
  GetMailslotInfo(Slot, @MaxMsgSize, NextSize, @MsgCount, @Timeout);
  Result := MaxMsgSize;
end;

procedure SendMailslot(MS: Integer; var Buf; Count: Integer);
var
  Wrt: DWORD;
  b:boolean;
begin
  b:=WriteFile(MS, Buf, Count, Wrt, nil);
end;

function ReceiveMailslot(MS: Integer; var Buf; BufSize: Integer): Integer;
var
  Rd: DWORD;
begin
  Result := GetMailslotMessageSize(MS);
  if (MS < 0) then Exit;
  if (BufSize < Result) then begin  Result := -2; Exit;  end;
  ReadFile(MS, Buf, Result, Rd, nil);
end;

function OpenMailslot(CompName, Name: String): Integer;
begin
  Name := '\\' + CompName + '\mailslot\' + Name;
  Result :=
    CreateFile(
      PChar(Name),
      GENERIC_WRITE,
      FILE_SHARE_READ,
      nil,
      OPEN_EXISTING,
      0,
      0
    );
end;

procedure CloseMailslot(MS: Integer);
begin
  CloseHandle(MS);
end;

function GetComputerName: String;
var
  Buf: array [0..MAX_COMPUTERNAME_LENGTH] of Char;
  Sz: DWORD;
begin
  Buf[MAX_COMPUTERNAME_LENGTH] := #0;
  Sz := MAX_COMPUTERNAME_LENGTH + 1;
  if not Windows.GetComputerName(Buf, Sz) then Sz := 0;
  SetString(Result, PChar(@Buf), Sz);
end;

function GetUserName: String;
var
  Buf: array [0..256] of Char;
  Sz: DWORD;
begin
  FillChar(Buf, SizeOf(Buf), 0);
  Sz := 256;
  if not Windows.GetUserName(Buf, Sz) then Sz := 0;
  SetString(Result, PChar(@Buf), Sz);
end;


end.