Category : Files from Magazines
Archive   : ITP9002.ZIP
Filename : NETINFO.PAS

 
Output of file : NETINFO.PAS contained in archive : ITP9002.ZIP
PROGRAM NetInfo;
USES Crt, Dos;
CONST
Redirector = $08;
Receiver = $80;
Messenger = $04;
Server = $40;
AnyType = $CC;

TYPE
String15 = STRING[15];
LocalDevice = ARRAY[1..16] OF Char;
RedirDevice = ARRAY[1..128] OF Char;
DevicePtr = ^DevInfo;
DevInfo = RECORD
LD : LocalDevice;
RD : RedirDevice;
ND : DevicePtr
END;

VAR Done:Boolean;
Name:String15;
Ver:Word;
I,Key:Integer;
DevIn:STRING[16];
RedIn:STRING[128];
LDevice:LocalDevice;
RDevice:RedirDevice;
DeviceList,NextDevice : DevicePtr;

PROCEDURE ClrCursor;
VAR Regs : Registers;
BEGIN
Regs.CH:=$20;
Regs.AH:=$01;
INTR($10,Regs);
END;

PROCEDURE SetCursor;
VAR Regs : Registers;
BEGIN
Regs.AH:=1;
IF LastMode <> Mono THEN
BEGIN
Regs.CH:=6;
Regs.CL:=7
END
ELSE
BEGIN
Regs.CH:=12;
Regs.CL:=13
END;
INTR($10,Regs);
END;

FUNCTION GetExtended : Integer;
VAR CH:Char;
BEGIN
CH:=#0;GetExtended:=0;CH:=ReadKey;
IF Ord(CH)=0 THEN

BEGIN
CH:=ReadKey;
GetExtended:=Ord(CH)
END
END;

FUNCTION GetFileName(S:STRING):STRING;
VAR FileName:STRING[11];
I:Integer;
BEGIN
FileName:='';
I:=1;
WHILE S[I]<>#0 DO
BEGIN
FileName[I]:=(S[I]);
I:=I+1
END;
FileName[0]:=Chr(i-1);
GetFileName:=FileName
END;

FUNCTION ChkNetInterface : Boolean;
VAR NetRegs:Registers;
BEGIN
NetRegs.AH:=$00;
INTR($2A,NetRegs);
IF NetRegs.AH = 0 THEN ChkNetInterface:=FALSE
END;

PROCEDURE ChkPCLan;
VAR NetRegs:Registers;
ChkType:Integer;
BEGIN
NetRegs.AX:=$B800;
INTR($2F,NetRegs);
IF NetRegs.AH = 0 THEN
WriteLn('Network Not Installed')
ELSE
BEGIN
ChkType:= NetRegs.BL AND AnyType;
IF (ChkType AND Server > 0) THEN
WriteLn('Server')
ELSE
IF (ChkType AND Messenger > 0) THEN
WriteLn('Messenger')
ELSE
IF (ChkType AND Receiver > 0) THEN
WriteLn('Receiver')
ELSE
IF (ChkType AND Redirector > 0) THEN
WriteLn('Redirector')
ELSE
WriteLn('Unknown Type')
END
END;

FUNCTION NetName : String15;
VAR NetRegs:Registers;
Name:ARRAY[1..15] OF Char;

BEGIN
WITH NetRegs DO
BEGIN
AH:=$5E;
AL:=$00;
DS:=Seg(Name);
DX:=Ofs(Name)
END;
MsDos(NetRegs);
IF NetRegs.CH<>0 THEN
NetName:=Name
ELSE
NetName:='NOT DEFINED'
END;

FUNCTION ChkDrive(DriveNo:Integer):Integer;
VAR DriveRegs: Registers;
BEGIN
WITH DriveRegs DO
BEGIN
AH:=$44;
AL:=$09;
BL:=DriveNo;
MsDos(DriveRegs);
IF (FLAGS AND 1) = 0 THEN
IF (DX AND $1000) = $1000 THEN
ChkDrive := 1
ELSE
ChkDrive := 0
ELSE
ChkDrive := AX * -1
END
END;

FUNCTION GetDevices: DevicePtr;
VAR NetRegs: Registers;
FstDevice, CurDevice,NewDevice : DevicePtr;
DevName: LocalDevice;
RedName: RedirDevice;
NextDev: Integer;
More : Boolean;

BEGIN
More:=TRUE;
FstDevice:=NIL;
CurDevice:=NIL;
NextDev:=0;
WHILE More DO
BEGIN
WITH NetRegs DO
BEGIN
AH:=$5F;
AL:=$02;
BX:=NextDev;
DS:=Seg(DevName);
SI:=Ofs(DevName);
ES:=Seg(RedName);
DI:=Ofs(RedName)
END;
MsDos(NetRegs);
IF (NetRegs.FLAGS AND 1) = 1 THEN
More:=FALSE
ELSE
BEGIN
NEW(NewDevice);
NewDevice^.LD:=DevName;
NewDevice^.RD:=RedName;
NewDevice^.ND:=NIL;
IF (CurDevice = NIL) AND (FstDevice=NIL) THEN
BEGIN
CurDevice:=NewDevice;
FstDevice:=NewDevice
END
ELSE
BEGIN
CurDevice^.ND:=NewDevice;
CurDevice:=NewDevice
END;
Inc(NextDev)
END
END;
GetDevices:=FstDevice
END;

PROCEDURE AssignDevice(DevName:LocalDevice;
RedName:RedirDevice);
VAR NetRegs: Registers;
DevType: Byte;
Dummy : Integer;

BEGIN
IF Pos(':',DevName)=2 THEN
DevType:=4
ELSE
DevType:=3;

WITH NetRegs DO
BEGIN
AH:=$5F;
AL:=$03;
BL:=DevType;
CX:=0;
DS:=Seg(DevName);
SI:=Ofs(DevName);
ES:=Seg(RedName);
DI:=Ofs(RedName)
END;
MsDos(NetRegs);
IF (NetRegs.FLAGS AND 1) = 1 THEN
BEGIN
TextColor(Red);GotoXY(WhereX+6,WhereY);
WriteLn('An Error Occurred on Assign');
TextColor(Red+128);GotoXY(WhereX+13,WhereY);
Write('Press Any Key');
Dummy:=GetExtended;
TextColor(White);
ClrScr
END
END;

PROCEDURE DeleteDevice(DevName:LocalDevice);
VAR NetRegs: Registers;
Dummy : Integer;

BEGIN
WITH NetRegs DO
BEGIN
AH:=$5F;
AL:=$04;
DS:=Seg(DevName);
SI:=Ofs(DevName)
END;
MsDos(NetRegs);
IF (NetRegs.FLAGS AND 1) = 1 THEN
BEGIN
TextColor(Red);GotoXY(WhereX+6,WhereY);
WriteLn('An Error Occurred on Delete');
TextColor(Red+128);GotoXY(WhereX+13,WhereY);
Write('Press Any Key');
Dummy:=GetExtended;
TextColor(White);
ClrScr
END
END;

FUNCTION SrchDevice(Drive:LocalDevice):DevicePtr;
VAR NDevice:DevicePtr;
BEGIN
NDevice:=GetDevices;
WHILE (NDevice <> NIL) AND
(Copy(NDevice^.LD,1,3) <>
Copy(Drive,1,3)) DO
BEGIN
NDevice:=NDevice^.ND
END;
SrchDevice:=NDevice
END;

PROCEDURE DisplayDrives;
VAR I:Integer;
LDevice:LocalDevice;
NextDevice : DevicePtr;
BEGIN
FOR I:=1 TO 26 DO
BEGIN
CASE ChkDrive(I) OF
0 : BEGIN
Write(#32,#32,Chr(64+I),':');
GotoXY(WhereX+3,WhereY);
WriteLn('Local')
END;
1 : BEGIN
Write(#32,#32,Chr(64+I),':');
GotoXY(WhereX+3,WhereY);
Write('Remote');
LDevice[1]:=Chr(64+I);
LDevice[2]:=':';
LDevice[3]:=#0;
NextDevice:=SrchDevice(LDevice);
GotoXY(WhereX+7,WhereY);
WITH NextDevice^ DO
WriteLn(Copy(RD,1,Pos(#0,RD)))
END
END
END
END;

PROCEDURE ScrnSetup;
BEGIN
ClrCursor;
TextBackground(Blue);
TextColor(White);
ClrScr;
GotoXY(30,2);Write('Network Status');
TextColor(LightGray);
GotoXY(2,5);Write('Dos Version:');
GotoXY(21,5);Write('Network Name:');
GotoXY(51,5);Write('Node Type:');
TextColor(White);
GotoXY(31,7);Write('Drive Status');
TextColor(LightGray);
GotoXY(20,9);Write('Drive');
GotoXY(27,9);Write('Location');
GotoXY(40,9);Write('Connection');
GotoXY(15,25);Write('F1 - Assign Device');
GotoXY(35,25);Write('F2 - Delete Device');
GotoXY(55,25);Write('F10 - Exit');
TextBackground(Black);
Ver:=DosVersion;
GotoXY(15,5);
WriteLn(Lo(Ver),'.',Hi(Ver))
END;

PROCEDURE SetScreen(W,X,Y,Z,Back,Txt:Integer);
BEGIN
Window(W,X,Y,Z);
TextColor(Txt);
TextBackground(Back);
ClrScr
END;

BEGIN
ScrnSetup;
IF ChkNetInterface THEN
BEGIN
GotoXY(35,5); WriteLn(NetName);GotoXY(62,5);
ChkPCLan;
Window(20,10,60,20);ClrScr;
DisplayDrives;
REPEAT
SetScreen(20,21,60,24,Blue,White);
Key:=GetExtended;
CASE Key OF
59:BEGIN
SetCursor;
Write('Drive to Redirect ');
ReadLn(DevIn);
Write('Remote Definition ');
ReadLn(RedIn);
ClrCursor;
FOR I:= 1 TO Ord(DevIn[0]) DO
LDevice[I]:=DevIn[I];
LDevice[Ord(DevIn[0])+1]:=#0;
FOR I:= 1 TO Ord(RedIn[0]) DO
RDevice[I]:=RedIn[I];
RDevice[Ord(RedIn[0])+1]:=#0;
AssignDevice(LDevice,RDevice)
END;
60:BEGIN
Write('Drive to Delete ');
SetCursor;
ReadLn(DevIn);
ClrCursor;
FOR I:= 1 TO Ord(DevIn[0]) DO
LDevice[I]:=DevIn[I];
LDevice[Ord(DevIn[0])+1]:=#0;
DeleteDevice(LDevice)
END
END;
SetScreen(20,10,60,20,Black,LightGray);
DisplayDrives;
UNTIL Key = 68;

END
ELSE
WriteLn('NetBIOS Interface Not Available')
END.



  3 Responses to “Category : Files from Magazines
Archive   : ITP9002.ZIP
Filename : NETINFO.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. 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/