{FTNAddr - unit for Fidonet-addresses
Copyright 1998-2000 by Bernhard R. Link (2:2476/841.64;brl@gmx.de)
maked parts from MKGlobT - Copyright 1993 by Mark May - MK Software
Changes (c) 2001 by Oliver Kopp (2:2471/1464;olly98@users.sourceforge.net)
****************************************************************************
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
****************************************************************************}

(* $Id: ftnaddr.pas,v 1.8 2001/04/08 23:19:00 olly98 Exp $ *)

unit FTNAddr;
{$I platform.inc}
{$I mkglobal.inc}
interface
uses aString,aTypes
     {$IFDEF PPC_VIRTUAL}
     ,Use32 {for val and co}
     {$ENDIF}
     ;

Type TMailType=(mtLocal,mtEcho,mtNetMail); {Muss bereinstimmen mit:MsgMailType in MKMsgAbs}

Const MaxNameStr=36; {Laut FTS-0001 drfen From und To nur diese Lnge haben}
      MaxSubjStr=72; {Laut FTS-0001 darf das Subj nur diese Lnge haben.}
      MaxOriginStr=79; {Laut FSC-0074.001 darf ein Origin sammt allem nicht lnger als 79 Zeichen sein}
      MaxMIDStr=8; {Maximale lnge fr HexDez-IDs (Als Strings, da Grosskleinschreibung von XP flchlicherweise unterschieden)}
      MaxFTNAddrS=19;{ZZZZ:NNNN/NODE.PPPP}

Type
{$IFDEF LongStrings}
     TNameStr=AnsiString;{Maximale Lnge fr An und Von-Felder
                           (An-Feld darf lnger sein, wenn es eine Gateway-To ist)}
     TAreaStr=AnsiString; {Um ein wenig Speicherplatz zu sparen}
     TOriginStr=AnsiString;
     TMIDStr=AnsiString;
     TTossPath=AnsiString; {Muss ausreichen, eine Datei samt Pfad und evtl
                             Endung zu spezifiezieren.}
     TFTNAddrS=AnsiString;
{$ELSE}
     TNameStr=String[MaxNameStr];{Maximale Lnge fr An und Von-Felder
                           (An-Feld darf lnger sein, wenn es eine Gateway-To ist)}
     TAreaStr=String[63]; {Um ein wenig Speicherplatz zu sparen}

     TOriginStr=String[MaxOriginStr];

     TMIDStr=String[MaxMIDStr];

     TTossPath=String[128]; {Muss ausreichen, eine Datei samt Pfad und evtl.
                             Endung zu spezifizieren.}

     TFTNAddrS=String[MaxFTNAddrS];
{$ENDIF}

     pFtnAddr=^tFtnAddr;
     TFTNAddr=packed Record zone,net,node,point:uInt2 end;

     pAddrType = ^AddrType;
     AddrType=TFTNAddr;

Function MsgIdStr:TString;

Function TakeFTN(const a:OpenString):TFTNAddrS;
{Addressennormalisierung:Leerzeichen und Domains entfernen}

{Aus MKGlobt:}
Function AddrStr(const Addr:TFTNAddr):TString;
Function PointlessAddrStr(const Addr:TFTNAddr):TString;
Function ParseAddr(AStr:OpenString; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
Function AddrEqual(Const Addr1, Addr2: AddrType):Boolean;

(*
  Returns:
    Full 4D-Addr of given Addr
*)
Function AddrStr4D(Addr:tFTNAddr) : string;

implementation
uses UDate,UDelay,UString;


Function AddrStr(const Addr:TFTNAddr):TString;
Begin
If Addr.Point = 0 Then
  AddrStr := IntToStr(Addr.Zone) + ':' + IntToStr(Addr.Net) + '/' +
    IntToStr(Addr.Node)
 else
  AddrStr := IntToStr(Addr.Zone) + ':' + IntToStr(Addr.Net) + '/' +
    IntToStr(Addr.Node) + '.' + IntToStr(Addr.Point);
end;

function AddrStr4D(Addr:tFTNAddr):string;
var
  resFromAddrStr: string;
begin
  resFromAddrStr:=AddrStr(Addr);
  if Addr.Point=0 then begin
    resFromAddrStr:=resFromAddrStr+'.0';
  end;
  AddrStr4D:=resFromAddrStr;
end;




Function PointlessAddrStr(const Addr:TFTNAddr): TString;
begin
PointlessAddrStr := IntToStr(Addr.Zone) + ':' + IntToStr(Addr.Net) + '/' +
   IntToStr(Addr.Node);
end;

{---Aus MKGlobT---Copyright Mark May}
Function ParseAddr(AStr:OpenString; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
  Var
    SPos: Word;
    EPos: Word;
    TempStr: TString;
    {$IFNDEF DelphiVal}Code: Word;{$ELSE}Code:Integer;{$ENDIF}
    BadAddr: Boolean;

  Begin
  BadAddr := False;
  AStr:=TrimStr(UpString(AStr));
  {EPos := Length(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 := TrimStr(Copy(AStr,1,Spos - 2));
    Val(TempStr,DestAddr.Zone,Code);
    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 := TrimStr(Copy(AStr,1,Spos - 2));
    Val(TempStr,DestAddr.Net,Code);
    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 := TrimStr(Copy(AStr,EPos,Length(AStr)));
    Val(TempStr,DestAddr.Point,Code);
    If Code <> 0 Then
      DestAddr.Point := 0;
    AStr := Copy(AStr,1,EPos -2);
    End
  Else
    DestAddr.Point := 0;
  TempStr := TrimStr(AStr);
  If Length(TempStr) > 0 Then
    Begin
    Val(TempStr,DestAddr.Node,Code);
    If Code <> 0 Then
      BadAddr := True;
    End
  Else
    DestAddr.Node := CurrAddr.Node;
  ParseAddr := Not BadAddr;
  End;

{---------------------}

{$I beginudw.inc}

Function MsgIdStr:TString;
var s:TMIDStr;l,l2:uInt4;i:Byte;
const HexTable:Array[0..15]of Char='0123456789ABCDEF';
begin
s:='';
l2:=GetTimeStamp;
Repeat
 Delay(10);
 l:=GetTimeStamp;
 until l<>l2;
For i:=8 downto 1 do
 begin
 Insert(HexTable[l and $F],s,1);
 l:=l shr 4;
 end;
MsgIdStr:=s;
end;

{$I endudw.inc}


Function TakeFTN(const a:OpenString):TFTNAddrS;
{Addressennormalisierung:Leerzeichen und Domains entfernen}
var s:TString;i:TSIndex;
begin
s:='';
For i:=1 to Length(a) do
  If a[i]='@' then
    Break {Domain ignorieren}
   else
    If a[i]>' ' then
      insert(a[i],s,Length(s)+1);
TakeFTN:=s;
end;

Function AddrEqual(Const Addr1, 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;

end.