[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
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.
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]