{$IFDEF WtrGate}{$IFDEF UseOvr}{$O+,F+}{$ENDIF}{$ENDIF}
UNIT UseAdres;

{$i platform.inc}

{ Usenet Adres Parsing                                }
{                                                     }
{ MD  12-04-1993  Overgenomen uit de source van SMail }
{ MD  20-07-1993  Toevoegen aan de Usenet routines    }

INTERFACE

TYPE EForm = (LOKAAL,
              DOMAIN, { USER@DOMAIN or DOMAIN!USER          }
              UUCP);  { HOST!ADDRESSS                       }

FUNCTION UseAdresParse (Address: STRING; VAR DomainAdr,User : STRING) : EForm;


IMPLEMENTATION

CONST MaxPath = 32;

TYPE Token = ARRAY[0..MAXPATH] OF BYTE;

{--------------------------------------------------------------------------}
{ SSplit                                                                   }
{                                                                          }
{ Deze routine zoekt naar een teken in een bepaalde string, en geeft het   }
{ aantal gevonden voorwerpen + de locatie waar ze gevonden kunnen worden   }
{ terug.                                                                   }
{                                                                          }
FUNCTION SSplit (Invoer : STRING; Teken : CHAR; VAR Uitvoer : Token) : BYTE;

VAR Lp,
    NbrFound : BYTE;
    WasWord  : BOOLEAN;

BEGIN
     NbrFound:=0;
     WasWord:=FALSE;

     FOR Lp:=1 TO Length (Invoer) DO
     BEGIN
          IF (NOT WasWord) THEN
          BEGIN
               Uitvoer[NbrFound]:=Lp;
               Inc (NbrFound);
          END;

          WasWord:=(Teken <> Invoer[Lp]);
     END;

     IF (NOT WasWord) THEN
     BEGIN
          Inc (NbrFound);
          Uitvoer[NbrFound]:=Lp;
     END;

     SSplit:=NbrFound;
END;


{--------------------------------------------------------------------------}
{ UseAdresParse                                                            }
{                                                                          }
{ Deze routine verbouwt verschillende Usenet adres stylen om en geeft      }
{ domain adres + username hieruit terug.                                   }
{                                                                          }
FUNCTION UseAdresParse (Address : STRING; VAR DomainAdr,User : STRING) : EForm;

VAR Buf,
    P,
    t_dom,
    t_User : STRING;
    Parts,
    Teller : INTEGER;
    Partv  : Token;
    A      : BYTE;

{ Yuk, joppes , aaggll ... tof ? }
LABEL LokaalAdres;

BEGIN
     { verzoek: bij a!b!c@.. alles achter de @ weggooien }

     { is dit een adres in de vorm a!b!c@d ? In dat geval moet het omgezet }
     { worden in d!a!b!c, bijvoorbeeld:                                    }
     {    wsd.wline.se!ramon@wline.se                                      }
     { -> wline.se!wsd.wline.se!ramon                                      }

     { werkt alleen bij 1 zo'n constructie }
     A:=Pos ('@',Address);
     IF ((A > 0) AND (Pos ('!',Address) > 0)) THEN
     BEGIN
          { RWI 960204: Is dit een adres in de vorm a!b!c@d!e? In dat     }
          {             geval moet het deel vanaf de @ weggegooid worden. }

          { RWI 961102: NIET!! vergelijk: freetex!Jan.Botter@relay.nl.net }
          {                            -> Jan.Botter@freetex              }

          { RAWI 970618: NIET!! vergelijk:                                }
          {                       NK.Hongkong.net!"Joseph.Cheng@cni.net"  }
          {              moet worden: "..@.."@NK.hongkong.net             }
          { No change. Avoided call to this function instead.             }

          IF (Pos ('!',Copy (Address,A+1,255)) > 0) THEN
             Address:=Copy (Address,1,A-1)  { @... weggooien }
          ELSE
              Address:=Copy (Address,A+1,255)+'!'+Copy (Address,1,A-1);
     END;

     { Is dit een adres in de form @Domain_A@Domain_B ? }
     IF (Address[1] = '@') THEN
     BEGIN
          { converteer het naar een bangpath domain_A!domain_B!user }
          Buf:=Address;
          { verwijder de leading '@' }
          Delete (Buf,1,1);

          FOR Teller:=1 TO Length (Buf) DO
              CASE Buf[Teller] OF
                   ':' { Reached end of route } : Break;
                   ',' { verwijder ',' 's     } : Delete (Buf,Teller,1);
                   '@' { Domain verwijderen   } : Buf[Teller]:='!';
              END;

          IF (Buf[Teller] <> ':') THEN { bad syntax - punt }
             GOTO LokaalAdres;

          P:=Copy (Buf,Teller+1,Length (Buf));
          Delete (Buf,Teller,Length (Buf));

          IF (UseAdresParse (P,t_dom,t_user) <> LOKAAL) THEN
             Buf:=Buf+'!'+t_dom;

          Buf:=Buf+'!'+t_user;

          { Her-pars het adress }
          UseAdresParse:=UseAdresParse (Buf,DomainAdr,User);
          Exit;
     END;

     { Probeer te splitsen op de @, als dat werkt is het een user@domain, }
     { DOMAIN styl adres. Prefereer de meeste rechtse @ in a@b@c          }
     Parts:=SSplit (Address,'@',partv);

     IF (Parts >= 2) THEN
     BEGIN
          DomainAdr:=Copy (Address,partv[Parts-1],Length (Address));
          User:=Copy (Address,partv[0],partv[Parts-1]-Partv[0]-1);
          UseAdresParse:=DOMAIN;

          { RWI 960713. Kijk nog even of er een % in het user deel zit.  }
          {             Zoja, dan knippen die eraf en stoppen we die aan }
          {             het begin van het domain.                        }

          A:=Pos ('%',User);
          IF (A > 0) THEN
          BEGIN
               DomainAdr:=Copy (User,A+1,255)+'.'+DomainAdr;
               User:=Copy (User,1,A-1);
          END;

          Exit;
     END;

     { Probeer te splitsen op de !. Als dit werkt, kijk dan of het stuk }
     { VOOR de ! een '.' in zich heeft (DOMAIN) of niet (host!user)     }
     { (UUCP)                                                           }
     Parts:=SSplit (Address,'!',partv);

     IF (Parts > 1) THEN
     BEGIN
          User:=Copy (Address,Partv[Parts-1],Length (Address));

          { RWI 950902: Hier werd het verkeerde adres genomen. In het  }
          {             geval van een complex bang path, werd altijd   }
          {             het eerste deel genomen als domain adres, wat  }
          {             natuurlijk verkeerd is, bijvoorbeeld:          }
          {             wtrlnd!wsd.wlink.nl!floor2.wsd.wlink.nl!ramon  }
          {             werd ramon!wtrlnd. Dit wordt nu dus            }
          {             ramon@floor2.wsd.wlink.nl, wat wel correct is. }

          {
          DomainAdr:=Copy (Address,Partv[0],Partv[1]-Partv[0]-1);
          }
          DomainAdr:=Copy (Address,Partv[Parts-2],Partv[Parts-1]-Partv[Parts-2]-1);

          IF (SSplit (DomainAdr,'.',partv) < 2) THEN
             UseAdresParse:=UUCP
          ELSE
              UseAdresParse:=DOMAIN;

          Exit;
     END;

     { Probeer te splitsen op de '%', als dit werkt is het een user%domain }
     { welk we proberen te verstaan als user@domain.                       }
     Parts:=SSplit (Address,'%',partv);
     IF (Parts >= 2) THEN
     BEGIN
          DomainAdr:=Copy (Address,Partv[Parts-1],Length (Address));
          User:=Copy (Address,Partv[0],Partv[Parts-1]-Partv[0]-1);
          UseAdresParse:=DOMAIN;
     END;

     { Klaar met proberen, dit moet dan een gewoon USER naam zijn ... }
LokaalAdres:

     User:=Address;
     DomainAdr:='';
     UseAdresParse:=LOKAAL;
END;


END.
