Renegade-1.19/SOURCE/NODELIST.PAS

653 lines
18 KiB
Plaintext

{$IFDEF WIN32}
{$I DEFINES.INC}
{$ENDIF}
{$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-}
UNIT Nodelist;
INTERFACE
USES
Common;
PROCEDURE ToggleNetAttr(NetAttrT: NetAttr; VAR NetAttrS: NetAttribs);
PROCEDURE ToggleNetAttrs(C: CHAR; VAR NetAttrS: NetAttribs);
FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean;
PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean);
PROCEDURE ChangeFlags(VAR MsgHeader: MHeaderRec);
FUNCTION NetMail_Attr(NetAttribute: NetAttribs): AStr;
IMPLEMENTATION
USES
Mail0;
TYPE
CompProc = FUNCTION(VAR ALine,Desire; L: Char): Integer;
DATRec = RECORD
Zone, { Zone of board }
Net, { Net Address of board }
Node, { Node Address of board }
Point: SmallInt; { Either Point number OR 0 }
CallCost, { Cost to sysop to send }
MsgFee, { Cost to user to send }
NodeFlags: SmallWord; { Node flags }
ModemType, { Modem TYPE }
PassWord: STRING[9];
Phone,
BName,
CName,
SName: STRING[39];
BaudRate, { Highest Baud Rate }
RecSize: Byte; { Size of the Node on FILE }
END;
IndxRefBlk = RECORD
IndxOfs, { Offset of STRING into block }
IndxLen: SmallWord; { Length of STRING }
IndxData, { RECORD number of STRING }
IndxPtr: LongInt; { Block number of lower index }
END; { IndxRef }
LeafRefBlk = RECORD
KeyOfs, { Offset of STRING into block }
KeyLen: SmallWord; { Length of STRING }
KeyVal: LongInt; { Pointer to Data block }
END; { LeafRef }
CtlBlk = RECORD
CtlBlkSize: SmallWord; { blocksize of Index blocks }
CtlRoot, { Block number of Root }
CtlHiBlk, { Block number of last block }
CtlLoLeaf, { Block number of first leaf }
CtlHiLeaf, { Block number of last leaf }
CtlFree: LongInt; { Head of freelist }
CtlLvls, { Number of index levels }
CtlParity: SmallWord; { XOR of above fields }
END;
INodeBlk = RECORD
IndxFirst, { Pointer to next lower level }
IndxBLink, { Pointer to previous link }
IndxFLink: LongInt; { Pointer to next link }
IndxCnt: SmallInt; { Count of Items IN block }
IndxStr: SmallWord; { Offset IN block of 1st str }
{ IF IndxFirst is NOT -1, this is INode: }
IndxRef: ARRAY [0..49] OF IndxRefBlk;
END;
LNodeBlk = RECORD
IndxFirst, { Pointer to next lower level }
IndxBLink, { Pointer to previous link }
IndxFLink: LongInt; { Pointer to next link }
IndxCnt: SmallInt; { Count of Items IN block }
IndxStr: SmallWord; { Offset IN block of 1st str }
LeafRef: ARRAY [0..49] OF LeafRefBlk;
END;
PROCEDURE ToggleNetAttr(NetAttrT: NetAttr; VAR NetAttrS: NetAttribs);
BEGIN
IF (NetAttrT IN NetAttrS) THEN
Exclude(NetAttrS,NetAttrT)
ELSE
Include(NetAttrS,NetAttrT);
END;
PROCEDURE ToggleNetAttrs(C: CHAR; VAR NetAttrS: NetAttribs);
BEGIN
CASE C OF
'C' : ToggleNetAttr(Crash,NetAttrS);
'H' : ToggleNetAttr(Hold,NetAttrS);
'I' : ToggleNetAttr(InTransit,NetAttrS);
'K' : ToggleNetAttr(KillSent,NetAttrS);
'L' : ToggleNetAttr(Local,NetAttrS);
'P' : ToggleNetAttr(Private,NetAttrS);
END;
END;
FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean;
BEGIN
GetNewAddr := FALSE;
Prt(DisplayStr);
MPL(MaxLen);
Input(DisplayStr,MaxLen);
IF (DisplayStr = '') OR (Pos('/',DisplayStr) = 0) THEN
Exit;
IF (Pos(':',DisplayStr) > 0) THEN
BEGIN
Zone := StrToInt(Copy(DisplayStr,1,Pos(':',DisplayStr)));
DisplayStr := Copy(DisplayStr,Pos(':',DisplayStr)+1,Length(DisplayStr));
END
ELSE
Zone := 1;
IF (Pos('.',DisplayStr) > 0) THEN
BEGIN
Point := StrToInt(Copy(DisplayStr,Pos('.',DisplayStr)+1,Length(DisplayStr)));
DisplayStr := Copy(DisplayStr,1,Pos('.',DisplayStr)-1);
END
ELSE
Point := 0;
Net := StrToInt(Copy(DisplayStr,1,Pos('/',DisplayStr)));
Node := StrToInt(Copy(DisplayStr,Pos('/',DisplayStr)+1,Length(DisplayStr)));
GetNewAddr := TRUE;
END;
FUNCTION NetMail_Attr(NetAttribute: NetAttribs): Astr;
VAR
s: AStr;
BEGIN
s := '';
IF (Local IN NetAttribute) THEN
s := 'Local ';
IF (Private IN NetAttribute) THEN
s := s + 'Private ';
IF (Crash IN NetAttribute) THEN
s := s + 'Crash ';
IF (FileAttach IN NetAttribute) THEN
s := s + 'FileAttach ';
IF (InTransit IN NetAttribute) THEN
s := s + 'InTransit ';
IF (KillSent IN NetAttribute) THEN
s := s + 'KillSent ';
IF (Hold IN NetAttribute) THEN
s := s + 'Hold ';
IF (FileRequest IN NetAttribute) THEN
s := s + 'File Request ';
IF (FileUpdateRequest IN NetAttribute) THEN
s := s + 'Update Request ';
NetMail_Attr := s;
END;
FUNCTION CompName(VAR ALine,Desire; L: Char): Integer;
VAR
Key,
Desired: STRING[36];
Len: Byte ABSOLUTE L;
BEGIN
Key[0] := L;
Desired[0] := L;
Move(ALine,Key[1],Len);
Move(Desire,Desired[1],Len);
IF (Key > Desired) THEN
CompName := 1
ELSE IF (Key < Desired) THEN
CompName := -1
ELSE
CompName := 0;
END;
FUNCTION CompAddress(VAR ALine,Desire; L: Char): Integer;
TYPE
NodeType = RECORD
Zone,
Net,
Node,
Point: SmallWord;
END;
VAR
Key: NodeType ABSOLUTE ALine;
Desired: NodeType ABSOLUTE Desire;
Count: Byte;
K: Integer;
BEGIN
Count := 0;
REPEAT
Inc(Count);
CASE Count OF
1 : Word(K) := Key.Zone - Desired.Zone;
2 : Word(K) := Key.Net - Desired.Net;
3 : Word(K) := Key.Node - Desired.Node;
4 : BEGIN
IF (L = #6) THEN
Key.Point := 0;
Word(K) := Key.Point - Desired.Point;
END;
END;
UNTIL (Count = 4) OR (K <> 0);
Compaddress := K;
END;
PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean);
VAR
DataFile,
NDXFile: FILE;
s: STRING[36];
Location: LongInt;
Dat: DatRec;
Internet: Boolean;
FUNCTION FullNodeStr(NodeStr: AStr): STRING;
{ These constants are the defaults IF the user does NOT specify them }
CONST
DefZone = '1'; { Default Zone }
DefNet = '1'; { Default Net }
DefNode = '1'; { Default Node }
DefPoint = '0'; { Default Point }
BEGIN
IF (NodeStr[1] = '.') THEN
NodeStr := DefNode + NodeStr;
IF (Pos('/',NodeStr) = 0) THEN
IF (Pos(':',NodeStr) = 0) THEN
NodeStr := DefZone+':'+DefNet+'/'+NodeStr
ELSE
ELSE
BEGIN
IF (NodeStr [1] = '/') THEN
NodeStr := DefNet + NodeStr;
IF (Pos(':',NodeStr) = 0) THEN
NodeStr := DefZone + ':' + NodeStr;
IF (NodeStr[Length(NodeStr)] = '/') THEN
NodeStr := NodeStr + DefNode;
END;
IF (Pos('.',NodeStr) = 0) THEN
NodeStr := NodeStr+'.'+DefPoint;
FullNodeStr := NodeStr;
END;
FUNCTION MakeAddress(Z,Nt,N,P: Word): STRING;
TYPE
NodeType = RECORD { A Node address TYPE }
Len: Byte;
Zone,
Net,
Node,
Point: SmallWord;
END;
VAR
Address: NodeType;
S2: STRING ABSOLUTE Address;
BEGIN
WITH Address DO
BEGIN
Zone := Z;
Net := Nt;
Node := N;
Point := P;
Len := 8;
END;
MakeAddress := S2;
END;
FUNCTION MakeName(Name: AStr): STRING;
VAR
Temp: STRING[36];
Comma: STRING[2];
BEGIN
Temp := Caps(Name);
IF (Pos(' ', Name) > 0) THEN
Comma := ', '
ELSE
Comma := '';
MakeName := Copy(Temp, Pos(' ',Temp) + 1, Length(Temp) - Pos(' ',Temp))
+ Comma + Copy(Temp,1,Pos(' ',Temp) - 1) + #0;
END;
PROCEDURE UnPk(S1: STRING; VAR S2: STRING; Count: Byte);
CONST
UnWrk: ARRAY [0..38] OF Char = ' EANROSTILCHBDMUGPKYWFVJXZQ-''0123456789';
TYPE
CharType = RECORD
C1,
C2: Byte;
END;
VAR
U: CharType;
W1: Word ABSOLUTE U;
I,
J: Integer;
OBuf: ARRAY [0..2] OF Char;
Loc1,
Loc2: Byte;
BEGIN
S2 := '';
Loc1 := 1;
Loc2 := 1;
WHILE (Count > 0) DO
BEGIN
U.C1 := Ord(S1[Loc1]);
Inc(Loc1);
U.C2 := Ord(S1[Loc1]);
Inc(Loc1);
Count := Count - 2;
for J := 2 downto 0 DO
BEGIN
I := W1 MOD 40;
W1 := W1 DIV 40;
OBuf[J] := UnWrk[I];
END;
Move(OBuf,S2[Loc2],3);
Inc(Loc2,3);
END;
S2[0] := Chr(Loc2);
END;
FUNCTION GetData(VAR F1: FILE; SL: LongInt; VAR Dat: DATRec): Boolean;
TYPE
RealDATRec = RECORD
Zone, { Zone of board }
Net, { Net Address of board }
Node, { Node Address of board }
Point: SmallInt; { Either Point number OR 0 }
CallCost, { Cost to sysop to send }
MsgFee, { Cost to user to send }
NodeFlags: SmallWord; { Node flags }
ModemType, { Modem TYPE }
PhoneLen, { Length of Phone Number }
PassWordLen, { Length of Password }
BNameLen, { Length of Board Name }
SNameLen, { Length of Sysop Name }
CNameLen, { Length of City/State Name }
PackLen, { Length of Packed STRING }
Baud: Byte; { Highest Baud Rate }
Pack: ARRAY [1..160] of Char; { The Packed STRING }
END;
VAR
Data: RealDATRec;
Error: Boolean;
UnPack: STRING[160];
BEGIN
Seek(F1,SL);
{ Read everything at once to keep disk access to a minimum }
BlockRead(F1,Data,SizeOf(Data));
Error := (IOResult <> 0);
IF (NOT Error) THEN
WITH Dat,Data DO
BEGIN
Move(Data,Dat,15);
Phone := Copy(Pack,1,PhoneLen);
PassWord := Copy(Pack,(PhoneLen + 1),PasswordLen);
Move(Pack[PhoneLen + PasswordLen + 1],Pack[1],PackLen);
UnPk(Pack,UnPack,PackLen);
BName := Caps(Copy(UnPack,1,BNameLen));
SName := Caps(Copy(Unpack,(BNameLen + 1),SNameLen));
CName := Caps(Copy(UnPack,BNameLen + SNameLen + 1,CNameLen));
BaudRate := Baud;
RecSize := (PhoneLen + PassWordLen + PackLen) + 22;
END;
END;
PROCEDURE Get7Node(VAR F: FILE; SL: LongInt; VAR Buf);
BEGIN
Seek(F,SL);
BlockRead(F,Buf,512);
IF (IOResult <> 0) THEN
Halt(1);
END;
FUNCTION BTree(VAR F1: FILE; Desired: AStr; Compare: CompProc): LongInt;
LABEL
Return;
VAR
Buf: ARRAY [0..511] OF Char; { These four variables all occupy }
CTL: CTLBlk ABSOLUTE Buf; { the same memory location. Total }
INode: INodeBlk ABSOLUTE Buf; { of 512 bytes. }
LNode: LNodeBlk ABSOLUTE Buf; { --------------------------------- }
NodeCTL: CTLBlk; { Store the CTL block seperately }
ALine: STRING[160]; { Address from NDX FILE }
J,
K,
L,Count: Integer; { Temp integers }
TP: Word; { Pointer to location IN BUF }
Rec, { A temp RECORD IN the FILE }
FRec: LongInt; { The RECORD when found OR NOT }
BEGIN
FRec := -1;
Get7Node(F1,0,Buf);
IF (CTL.CTLBlkSize = 0) THEN GOTO
Return;
Move(Buf,NodeCTL,SizeOf(CTL));
Get7Node(F1,NodeCTL.CtlRoot * NodeCTL.CtlBlkSize,Buf);
WHILE (INode.IndxFirst <> -1) AND (FRec = -1) DO
BEGIN
Count := INode.IndxCnt;
IF (Count = 0) THEN GOTO
Return;
J := 0;
K := -1;
WHILE (J < Count) AND (K < 0) DO
BEGIN
TP := INode.IndxRef[J].IndxOfs;
L := INode.IndxRef[J].IndxLen;
{ ALine [0] := Chr (L); }
Move(Buf[TP],ALine[1],L);
K := Compare(ALine[1],Desired[1],Chr(L));
IF (K = 0) THEN
FRec := INode.IndxRef[J].IndxData
ELSE IF (K < 0) THEN
Inc(J);
END;
IF (FRec = -1) THEN
BEGIN
IF (J = 0) THEN
Rec := INode.IndxFirst
ELSE
Rec := INode.IndxRef[J - 1].IndxPtr;
Get7Node(F1,Rec * NodeCTL.CtlBlkSize,Buf);
END;
END;
IF (FRec = -1) THEN
BEGIN
Count := LNode.IndxCnt;
IF (Count <> 0) THEN
BEGIN
J := 0;
WHILE (J < Count) AND (FRec = -1) DO
BEGIN
TP := LNode.LeafRef[J].KeyOfs;
L := LNode.LeafRef[J].KeyLen;
{ ALine [0] := Chr (L); }
Move(Buf[TP],ALine[1],L);
K := Compare(ALine[1],Desired[1],Chr(L));
IF (K = 0) THEN
FRec := LNode.LeafRef[J].KeyVal;
Inc(J);
END;
END;
END;
Return :
BTree := FRec;
END;
FUNCTION Pull(VAR S: STRING; C: Char): STRING;
VAR
I: Byte;
BEGIN
I := Pos(C,S);
Pull := Copy(S,1,(I - 1));
Delete(S,1,I);
END;
BEGIN
NL;
Internet := FALSE;
IF NOT Exist(General.NodePath+'NODEX.DAT') OR
NOT Exist(General.NodePath+'SYSOP.NDX') OR
NOT Exist(General.NodePath+'NODEX.NDX') THEN
BEGIN
IF (GetFee) THEN
BEGIN
Fee := 0;
Exit;
END;
Print('Enter name of intended receiver.');
Prt(':');
InputDefault(SysOpName,SysOpName,36,[CapWords],TRUE);
IF (SysOpName = '') THEN
Exit;
IF (Pos('@',SysOpName) > 0) THEN
IF (PYNQ('Is this an Internet message? ',0,FALSE)) THEN
BEGIN
Internet := TRUE;
Zone := General.Aka[20].Zone;
Net := General.Aka[20].Net;
Node := General.Aka[20].Node;
Point := General.Aka[20].Point;
Fee := 0;
Exit;
END
ELSE
NL;
IF NOT GetNewAddr('Enter network address (^5Z^4:^5N^4/^5N^4.^5P^4 format): ',30,Zone,Net,Node,Point) THEN
Exit;
Exit;
END;
Assign(DataFile,General.NodePath+'NODEX.DAT');
IF (GetFee) THEN
BEGIN
s := IntToStr(Net)+'/'+IntToStr(Node);
IF (Zone > 0) THEN
s := IntToStr(Zone)+':'+s;
IF (Point > 0) THEN
s := s+'.'+IntToStr(Point);
s := FullNodeStr(s);
Assign(NDXFile,General.NodePath+'NODEX.NDX');
Reset(NDXFile,1);
Location := BTree(NDXFile,MakeAddress(StrToInt(Pull(S,':')),
StrToInt(Pull(S,'/')),StrToInt(Pull(S,'.')),
StrToInt(S)),Compaddress);
Close(NDXFile);
IF (Location <> -1) THEN
BEGIN
Reset(DataFile,1);
GetData(DataFile,Location,Dat);
Close(DataFile);
Fee := Dat.MsgFee;
END
ELSE
Fee := 0;
Exit;
END;
s := SysOpName;
SysOpName := '';
Fee := 0;
REPEAT
Print('Enter a name, a Fidonet address, or an Internet address.');
Prt(':');
InputDefault(s,s,36,[],TRUE);
IF (s = '') THEN
Break;
IF (Pos('/',s) > 0) THEN
BEGIN
s := FullNodeStr(s);
Assign(NDXFile,General.NodePath+'NODEX.NDX');
Reset(NDXFile,1);
Location := BTree(NDXFile,MakeAddress(StrToInt(Pull(S,':')),StrToInt(Pull(S,'/')),StrToInt(Pull(S,'.')),StrToInt(S)),
Compaddress);
Close(NDXFile);
END
ELSE
BEGIN
Assign(NDXFile,General.NodePath+'SYSOP.NDX');
Reset(NDXFile,1);
Location := BTree(NDXFile,MakeName(S),CompName);
Close(NDXFile);
END;
IF (Location <> -1) THEN
BEGIN
Reset(DataFile,1);
GetData(DataFile,Location,Dat);
Close(DataFile);
WITH Dat DO
BEGIN
Print('^1System: '+BName+' ('+IntToStr(Zone)+':'+IntToStr(Net)+'/'+IntToStr(Node)+')');
Print('SysOp : '+SName);
Print('Phone : '+Phone);
Print('Where : '+CName);
Print('Cost : '+IntToStr(MsgFee)+' credits');
END;
NL;
IF (Dat.MsgFee > (ThisUser.lCredit - ThisUser.Debit)) THEN
BEGIN
Print('You do not have enough credit to netmail this Node!');
s := '';
END
ELSE IF PYNQ('Is this correct? ',0,FALSE) THEN
BEGIN
SysOpName := Dat.Sname;
Zone := Dat.Zone;
Net := Dat.Net;
Node := Dat.Node;
Point := 0;
Fee := Dat.MsgFee;
END
ELSE
s := '';
END
ELSE IF (Pos('@',s) > 0) THEN
IF (NOT PYNQ('Is this an Internet message? ',0,FALSE)) THEN
BEGIN
Print('That name is not in the nodelist!'^M^J);
S := '';
END
ELSE
BEGIN
Internet := TRUE;
SysOpName := s;
Zone := General.Aka[20].Zone;
Net := General.Aka[20].Net;
Node := General.Aka[20].Node;
Point := General.Aka[20].Point;
Fee := 0;
END
ELSE
BEGIN
Print('That name is not in the nodelist!'^M^J);
S := '';
END
UNTIL (SysOpName <> '') OR (HangUp);
IF (NOT Internet) AND (Pos('/',s) = 0) AND (s <> '') THEN
BEGIN
NL;
Print('Enter name of intended receiver.');
Prt(':');
InputDefault(SysOpName,SysOpName,36,[CapWords],FALSE);
IF (SysOpName = '') THEN
Exit;
END;
LastError := IOResult;
END;
PROCEDURE ChangeFlags(VAR MsgHeader: MHeaderRec);
VAR
Cmd: Char;
BEGIN
IF (CoSysOp) AND (PYNQ('Change default netmail flags? ',0,FALSE)) THEN
BEGIN
Cmd := #0;
NL;
REPEAT
IF (Cmd <> '?') THEN
BEGIN
Print('^4Current flags: ^5'+NetMail_Attr(MsgHeader.NetAttribute));
NL
END;
Prt('Flag to change: ');
OneK(Cmd,'QPCAIKHRLU?'^M,TRUE,TRUE);
IF (Cmd IN ['?']) THEN
NL;
WITH MsgHeader DO
CASE Cmd OF
'L' : ToggleNetAttr(Local,NetAttribute);
'U' : ToggleNetAttr(FileUpdateRequest,NetAttribute);
'R' : ToggleNetAttr(FileRequest,NetAttribute);
'H' : ToggleNetAttr(Hold,NetAttribute);
'K' : ToggleNetAttr(KillSent,NetAttribute);
'I' : ToggleNetAttr(InTransit,NetAttribute);
'A' : ToggleNetAttr(FileAttach,NetAttribute);
'C' : ToggleNetAttr(Crash,NetAttribute);
'P' : ToggleNetAttr(Private,NetAttribute);
'?' : BEGIN
LCmds3(15,3,'Private','Crash','Attached File');
LCmds3(15,3,'InTransit','KillSent','Hold');
LCmds3(15,3,'Req file','Update Req','Local');
END;
END;
UNTIL (Cmd IN ['Q',^M]) OR (HangUp);
END;
NL;
END;
END.