home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mega CD-ROM 1
/
megacd_rom_1.zip
/
megacd_rom_1
/
MAGAZINE
/
PROGJOUR
/
PJ_9_4.ZIP
/
NETTOOLS.PAS
< prev
next >
Wrap
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}