[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]

    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.

[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]