Unit MkFidoAddr32; {Delphi32 Only!}
Interface
///////////////////////////////////////////////////////////////////////////////
// MKFidoAddr32 Coded in Part by G.E. Ozz Nixon Jr. of www.warpgroup.com //
// ========================================================================= //
// Original Source for DOS by Mythical Kindom's Mark May (mmay@dnaco.net) //
// Re-written and distributed with permission! //
// See Original Copyright Notice before using any of this code! //
///////////////////////////////////////////////////////////////////////////////
Type AddrType = Record {Used for Fido style addresses}
Zone: Word;
Net: Word;
Node: Word;
Point: Word;
End;
Type SecType = Record
Level: Word; {Security level}
Flags: LongInt; {32 bitmapped flags}
End;
Const
BbsVersion : String='Your BBS Name Here - Version 0.01 Alpha';
Copyright : String='Your Copyright 1992-1997 by Mark May and Ozz Nixon';
Contact : String='Contact Name Here';
Const
uoNotAvail = 0;
uoBrowse = 1;
uoXfer = 2;
uoMsg = 3;
uoDoor = 4;
uoChat = 5;
uoQuest = 6;
uoReady = 7;
uoMail = 8;
uoWait = 9;
uoLogIn = 10;
Function AddrStr(Addr: AddrType): String;
Function PointlessAddrStr(Var Addr: AddrType): String;
Function ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
Function ValidAddr(Addr: AddrType): Boolean;
Function Access(USec: SecType; RSec: SecType): Boolean;
Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
{Result in seconds}
Function NameCrcCode(Str: String): LongInt; {Get CRC code for name}
Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
Const
UseEms: Boolean = True;
LocalMode: Boolean = False;
LogToPrinter: Boolean = False;
ReLoad: Boolean = False;
NodeNumber: Byte = 1;
OverRidePort: Byte = 0;
OverRideBaud: Word = 0;
UserBaud: Word = 0;
ExitErrorLevel: Byte = 0;
TimeToEvent: LongInt = 0;
ShellToMailer: Boolean = False;
Implementation
Uses Crc32, MKString32;
Function AddrStr(Addr: AddrType): String;
Begin
If Addr.Point = 0 Then AddrStr:=PointLessAddrStr(Addr)
Else AddrStr:=PointLessAddrStr(Addr)+Long2Str(Addr.Point);
End;
Function PointlessAddrStr(Var Addr: AddrType): String;
Begin
PointlessAddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
Long2Str(Addr.Node);
End;
Function Access(USec: SecType; RSec: SecType): Boolean;
Begin
If (USec.Level >= RSec.Level) Then
Access := ((RSec.Flags and Not(USec.Flags)) = 0)
Else
Access := False;
End;
Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
Begin
If BaudRate > 0 Then
EstimateXferTime := ((FS * 100) Div Effic) Div (BaudRate Div 10)
Else
EstimateXferTime := ((FS * 100) Div Effic) Div (960);
End;
Function NameCrcCode(Str: String): LongInt;
Var
NCode: LongInt;
i: WOrd;
Begin
NCode := UpdC32(Length(Str),$ffffffff);
i := 1;
While i < Length(Str) Do
Begin
NCode := Updc32(Ord(UpCase(Str[i])), NCode);
Inc(i);
End;
NameCrcCode := NCode;
End;
Function ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
Var
SPos: Word;
EPos: Word;
TempStr: String;
Code: Word;
BadAddr: Boolean;
Begin
BadAddr := False;
AStr := StripBoth(Upper(AStr), ' ');
{thanks for the fix domain problem to Ryan Murray @ 1:153/942}
Code := Pos('@', AStr);
If Code > 0 then
Delete(Astr, Code, Length(Astr) + 1 - Code);
SPos := Pos(':',AStr) + 1;
If SPos > 1 Then
Begin
TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
DestAddr.Zone:=Str2Long(TempStr);
If Code <> 0 Then
BadAddr := True;
AStr := Copy(AStr,Spos,Length(AStr));
End
Else
DestAddr.Zone := CurrAddr.Zone;
SPos := Pos('/',AStr) + 1;
If SPos > 1 Then
Begin
TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
DestAddr.Net:=Str2Long(TempStr);
If Code <> 0 Then
BadAddr := True;
AStr := Copy(AStr,Spos,Length(AStr));
End
Else
DestAddr.Net := CurrAddr.Net;
EPos := Pos('.', AStr) + 1;
If EPos > 1 Then
Begin
TempStr := StripBoth(Copy(AStr,EPos,Length(AStr)), ' ');
DestAddr.Point:=Str2Long(TempStr);
If Code <> 0 Then
DestAddr.Point := 0;
AStr := Copy(AStr,1,EPos -2);
End
Else
DestAddr.Point := 0;
TempStr := StripBoth(AStr,' ');
If Length(TempStr) > 0 Then
Begin
DestAddr.Node:=Str2Long(TempStr);
If Code <> 0 Then
BadAddr := True;
End
Else
DestAddr.Node := CurrAddr.Node;
ParseAddr := Not BadAddr;
End;
Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
Begin
AddrEqual := ((Addr1.Zone = Addr2.Zone) and (Addr1.Net = Addr2.Net)
and (Addr1.Node = Addr2.Node) and (Addr1.Point = Addr2.Point));
End;
Function ValidAddr(Addr: AddrType): Boolean;
Begin
ValidAddr := ((Addr.Zone<>0) And (Addr.Net<>0));
{ We have to skip administrative '/0' addresses}
End;
End.