Power-Programmierung/CD1.mdf/magazine/progjour/1991/04/nettools.pas

Pascal/Delphi Source File | 1991-05-13 | 5KB | 172 lines

{*****************************************************************************
** NetTools Unit Version 1.2                                    May 1, 1991 **
** Copyright 1987,1988,1991 by L. Brett Glass, Systems Consultant           **
******************************************************************************}

unit NetTools;

interface

uses NetBIOS;

const
  wildName : NetName = '*               ';

function NetToolsGetMyName(var myName : NetName) : Byte;

function NetToolsAddUniqueName(myName : NetName; var nameNum : Byte) : Byte;
  {Try to claim a unique name. Return the number of the name and
   also the return code.}

function NetToolsDeleteName(myName : NetName) : Byte;

function NetToolsCall(fromName, toName : NetName;
                     rtimeout, stimeout : Byte;
                     var session : Byte) : Byte;

function NetToolsStartListen(var listenBlock : NCB;
                             fromName, toName : NetName;
                             rtimeout, stimeout : Byte) : Byte;

function NetToolsCheckListen(var listenBlock : NCB;
                             var session : Byte;
                             var caller : NetName) : Byte;

procedure NetToolsAbortListen(var listenBlock : NCB);

function NetToolsHangUp(session : Byte) : Byte;

function NetToolsCancel(var netBlock : NCB) : Byte;

implementation

function NetToolsGetMyName(var myName : NetName) : Byte;
  var
    netBlock : NCB;
    buf : StatusBuf;
  begin
  with netBlock do
    begin
    Init(ADAPTER_STATUS);
    bufPtr := @buf;
    len := SizeOf(buf);
    callname.name := wildName;
    NetToolsGetMyName := ReturnCode;
    FillChar(myName,SizeOf(myName),0);
    Move(buf.unitID,myName[11],6);
    end;
  end; {NetToolsGetMyName}

function NetToolsAddUniqueName(myName : NetName; var nameNum : Byte) : Byte;
  {Try to claim a unique name. Return the number of the name and
   also the return code.}
  var
    addNCB : NCB;
  begin  {NetToolsAddUniqueName}
  with addNCB do
    begin
    Init(ADD_NAME);
    name := myName;
    NetToolsAddUniqueName := ReturnCode;
    nameNum := num
    end
  end; {NetToolsAddUniqueName}

function NetToolsDeleteName(myName : NetName) : Byte;
  var
    delNCB : NCB;
  begin  {NetToolsDeleteName}
  with delNCB do
    begin
    Init(DELETE_NAME);
    name := myName;
    NetToolsDeleteName := ReturnCode;
    end
  end; {NetToolsDeleteName}


function NetToolsCall(fromName, toName : NetName;
                     rtimeout, stimeout : Byte;
                     var session : Byte) : Byte;
  var
    netBlock : NCB;
  begin
  with netBlock do
    begin
    Init(CALL);
    callname.name := toName;
    name := fromName;
    rto := rtimeout;
    sto := stimeout;
    NetToolsCall := ReturnCode;
    session := lsn
    end;
  end; {NetToolsCall}

function NetToolsStartListen(var listenBlock : NCB;
                             fromName, toName : NetName;
                             rtimeout, stimeout : Byte) : Byte;
  begin
  with listenBlock do
    begin
    Init(LISTEN_NO_WAIT);
    callname.name := fromName;
    name := toName;
    rto := rtimeout;
    sto := stimeout;
    NetToolsStartListen := ReturnCode;
    end;
  end; {NetToolsStartListen}

function NetToolsCheckListen (var listenBlock : NCB;
                             var session : Byte;
                             var caller : NetName) : Byte;
  var
    status : Byte;
  begin
  with listenBlock do
    begin
    status := cmd_cplt; {Make a copy. If we don't, this field may
                         change between assignment and "if"}
    NetToolsCheckListen := status;
    if status = GOOD_RTN then
      begin
      session := lsn;
      caller := callname.name;
      end
    end
  end; {NetToolsCheckListen}

procedure NetToolsAbortListen(var listenBlock : NCB);
  begin
  if (listenBlock.cmd_cplt = GOOD_RTN) or
      (NetToolsCancel(listenBlock) = CMPL_DURING_CANCEL) then
    {Handle case where completion occurred}
    if NetToolsHangUp(listenBlock.lsn) <> GOOD_RTN then;
  end; {NetToolsAbortListen)}

function NetToolsHangUp(session : Byte) : Byte;
  var
    netBlock : NCB;
  begin
  with netBlock do
    begin
    Init(HANG_UP);
    lsn := session;
    NetToolsHangUp := ReturnCode;
    end;
  end; {NetToolsHangUp}

function NetToolsCancel(var netBlock : NCB) : Byte;
  var
    cancelBlock : NCB;
  begin
  with cancelBlock do
    begin
    Init(CANCEL);
    bufPtr := @netBlock;
    NetToolsCancel := ReturnCode;
    end;
  end; {NetToolsCancel}
end. {Unit NetTools}