Category : Files from Magazines
Archive   : PJ94.ZIP
Filename : NETTOOLS.PAS
** 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}
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/