{ ------------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.                   }
{ (c) 2025 FreeXP, http://www.freexp.de                               }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.         }
{                                                                     }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der     }
{ Datei SLIZENZ.TXT oder auf http://www.crosspoint.de/oldlicense.html }
{ ------------------------------------------------------------------- }

{ Deklarationen und diverse ausgelagerte Routinen fuer UUZ.PAS }

{$I XPDEFINE.INC }

unit uuz1;

interface  { ---------------------------------------------------------- }

uses  xpglobal,crt,clip,dos,dosx,typeform,xpovl,fileio,xpdatum,mimedec,
      montage,lfn,uuz0;

procedure OpenFile(var fn:pathstr);
function SetMailUser(mailuser:string):string;
procedure CheckEnvEmp(const s:string);
procedure ConvertMailfile(fn:pathstr; mailuser:string; const raw:boolean);
procedure ReadRFCheader(msgtyp:byte; s0:string);
  
implementation  { ----------------------------------------------------- }

{ --- UUCP/RFC -> ZConnect ------------------------------------------ }

{ my: Kompletter Rewrite                                   08/2002-01/2006 }
{     msgtyp: 1=Newsbatch, 2=UUCP/Raw-Mail, 3=SMTP-Mail, 4=mboxo, 5=mboxrd }

procedure ReadRFCheader(msgtyp:byte; s0:string);
const zz : string[40] = '';    { Datensegment-optimiert }
      s1 : string[40] = '';    { Original-Identifier    }
var  p,i : integer; { byte -> integer }

    chkd_trunc,
    MsgEnde,                    { Ende einer (defekten) SMTP/mbox-Mail }
    HdrLineComplete : boolean;

    DoneLPath  : boolean;     { LongHdr[LPath] ist "voll"   }
    DoneSPath  : boolean;     { hd.pfad ist "voll"          }
    DoneProg   : boolean;     { 'MAILER:' aus 'X-XP-Version' ermittelt }
    structured : byte;        { strukturierter Header (fr 'context')  }

    drealn: string[realnlen];       { Realname verl„ngert }
    delivToEmpf  : string[AdrLen];  { Envelope-Empf„nger in "Delivered-To:" }
    delivToCount : byte;            { Counter fr Delivered-To-Header }
    delivToAlias : boolean;         { true nach erstem Delivered-To-Alias }

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003              }
  {     RFC-U/X-Header bis 65500 Zeichen in verketteter Liste ablegen }
  procedure AppUHdr(const Id:string; const MIMEdecode:boolean);
  begin
    if not mailinglist then
      mailinglist:=is_mailinglist(msgtyp,lstr(Id));
    if MIMEdecode then
      s0:=GetHeader(HdrLine,HdrLen,rest,truncated,
                    overflow,true,false,structured);
    if maxavail>=GetMemAmount(sizeof(Ustart^))+GetMemAmount(HdrLen)+
                 GetMemAmount(length(id)+1) then
    begin
      if Ustart=nil then
      begin
        new(Ustart);
        Ustart^.next:=nil;
        getmem(Ustart^.hdr,HdrLen);
        fastmove(HdrLine^[1],Ustart^.hdr^[1],HdrLen);
        Ustart^.len:=HdrLen;
        Ustart^.rest:=rest;
        Ustart^.trunc:=truncated;
        getmem(Ustart^.Id,length(Id)+1);
        Ustart^.Id^:=Id;
        Ulauf:=Ustart;
      end
      else begin                    { hinten anfgen }
        new(Ulauf^.next);
        Ulauf:=Ulauf^.next;
        Ulauf^.next:=nil;
        getmem(Ulauf^.hdr,HdrLen);
        fastmove(HdrLine^[1],Ulauf^.hdr^[1],HdrLen);
        Ulauf^.len:=HdrLen;
        Ulauf^.rest:=rest;
        Ulauf^.trunc:=truncated;
        getmem(Ulauf^.Id,length(Id)+1);
        Ulauf^.Id^:=Id;
      end;
    end;
  end;

  { my: Langen Header bis 65500 Zeichen vollst„ndig }
  {     MIME-decodieren und an 's0' zurckgeben     }
  function GetMimeString:string;
  begin
    s0:=GetHeader(HdrLine,HdrLen,rest,truncated,         { MIME-Decodierung }
                  overflow,true,false,structured);
    GetMimeString:=s0;
  end;

  { my: hd.xabs anlegen }
  procedure NewABS;
  begin
    releaseMem(LAbs);                     { reservierten Speicher freigeben }
    new(hd.xabs);
    fillchar(hd.xabs^,sizeof(hd.xabs^),0);
    hd.absanz:=0;
  end;

  { my: Neues Element in hd.xabs anlegen }
  {     ('absanz' wird *nicht* erh”ht!   }
  function CreateABS(const n:integer; const a,r:string):boolean;
  begin
    CreateABS:=false;
    { Fr hd.xabs Speicher in voller Variablenl„nge  }
    { holen (wegen Vereinfachung einer m”glichen     }
    { sp„teren Ersetzung durch Sender/WAB und des    }
    { Rotierens von Elementen innerhalb von hd.xabs) }
    if maxavail>=GetMemAmount(adrlen+1)+GetMemAmount(realnlen+1) then
    begin
      getmem(hd.xabs^[n].adr,adrlen+1);
      getmem(hd.xabs^[n].name,realnlen+1);
      hd.xabs^[n].adr^:=a;
      hd.xabs^[n].name^:=r;
      CreateABS:=true;
    end;
  end;

  { my: Element in hd.xabs entfernen      }
  {     ('absanz' wird *nicht* reduziert! }
  procedure RemoveABS(const n:integer);
  begin
    freemem(hd.xabs^[n].adr,adrlen+1);
    freemem(hd.xabs^[n].name,realnlen+1);
    hd.xabs^[n].adr:=nil;
    hd.xabs^[n].name:=nil;
  end;

  { my: Elemente in hd.xabs von [1] bis [pos-1] um eine Position }
  {     nach hinten schieben (und damit hd.xabs^[1] freimachen)  }
  procedure ShiftABS(const pos:integer);
  var i : integer;
  begin
    for i:=pos downto 2 do
    begin
      hd.xabs^[i].adr^:=hd.xabs^[i-1].adr^;       { Elemente um 1 aufrcken }
      hd.xabs^[i].name^:=hd.xabs^[i-1].name^;
    end;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003      }
  {     (Untersttzung mehrerer Adressen im From:-Header)     }
  {     (Untersttzung langer From:-Header bis 65500 Zeichen) }
  procedure GetFrom;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      if xabs=nil then
        NewABS;
      while (HdrLen>0) and (absanz<maxabs) do
      begin
        oab:=''; oar:='';
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,oar,
                    rest,truncated,overflow,0,'');
        if (oab<>'') or (oar<>'') then
          if CreateABS(absanz+1,oab,oar) then          { HdrLine => hd.xabs }
            inc(absanz)
          else
            exit;                                       { Speicher alle :-( }
      end;
    end;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003        }
  {     (Realname wird jetzt nicht mehr weggeworfen)            }
  {     (Untersttzung langer Sender:-Header bis 65500 Zeichen) }
  procedure GetSender;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      oab:=''; oar:='';
      if xsender=nil then                   { nur ersten 'Sender:' beachten }
      begin
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,oar,
                    rest,truncated,overflow,0,'');
        if (oab<>'') then
        begin
          releaseMem(LWab);                 { reservierten Speicher freigeben }
          new(xsender);
          fillchar(xsender^,sizeof(xsender^),0);
          if maxavail>=GetMemAmount(length(oab)+1) +
                       GetMemAmount(length(oar)+1) then
          begin
            getmem(xsender^.adr,length(oab)+1);
            getmem(xsender^.name,length(oar)+1);
            xsender^.adr^:=oab;
            xsender^.name^:=oar;
          end;
        end;
      end;
    end;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003             }
  {     (Realname wird jetzt nicht mehr weggeworfen)              }
  {     (Untersttzung langer Reply-To:-Header bis 65500 Zeichen) }
  procedure GetPMReplyTo;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      if xreplyto=nil then
      begin
        releaseMem(LAnt);                 { reservierten Speicher freigeben }
        new(xreplyto);
        fillchar(xreplyto^,sizeof(xreplyto^),0);
        replytoanz:=0;
      end;
      while (HdrLen>0) and (replytoanz<maxreplyto) do
      begin
        oab:=''; oar:='';
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,oar,
                    rest,truncated,overflow,0,'nobody@nowhere');

        if oab<>'' then                            { HdrLine => hd.xreplyto }
          if maxavail>=GetMemAmount(length(oab)+1) +
                       GetMemAmount(length(oar)+1) then
          begin
            inc(replytoanz);
            getmem(xreplyto^[replytoanz].adr,length(oab)+1);
            getmem(xreplyto^[replytoanz].name,length(oar)+1);
            xreplyto^[replytoanz].adr^:=oab;                     { Adresse  }
            xreplyto^[replytoanz].name^:=oar;                    { Realname }
          end
          else exit;                                    { Speicher alle :-( }
      end;
    end;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003       }
  {     (Untersttzung langer To:-Header bis 65500 Zeichen) }
  procedure GetEmpf;
  begin
    with hd do
    begin
      if msgtyp=1 then
        AppUHdr('U-'+s1,false)         { Bei Postings als U-Header sichern! }
      else begin
        AppUHdr(BackupId+s1,false);           { Original-RFC-Header sichern }
        if xempf=nil then
        begin
          releaseMem(LEmp);               { reservierten Speicher freigeben }
          new(xempf);
          fillchar(xempf^,sizeof(xempf^),0);
          empfanz:=0;
        end;
        while (HdrLen>0) and (empfanz<maxemp) do
        begin
          oab:='';
          RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,drealn,
                      rest,truncated,overflow,0,'');
          if oab<>'' then                             { HdrLine => hd.xempf }
            if maxavail>=length(oab)+1 then
            begin
              inc(empfanz);
              getmem(xempf^[empfanz],length(oab)+1);
              xempf^[empfanz]^:=oab;
            end
            else exit;                                  { Speicher alle :-( }
        end;
      end;
    end;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003 }
  procedure GetEnvEmp;
  var p : word;
  begin
    AppUHdr('U-'+s1,false);                   { Original-RFC-Header sichern }
    { Sonderbehandlung "Original-Recipient:": }
    { 'rfc822;' entfernen, siehe RFC2298      }
    if zz='original-recipient' then
    begin
      p:=PosLong(';',HdrLine,1,HdrLen,true);
      if p>0 then
      begin
        move(HdrLine^[p+1],HdrLine^[1],HdrLen-p);
        dec(HdrLen,p);
      end;
    end;
    RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,hd.envemp,drealn,
                rest,truncated,overflow,0,'');
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003       }
  {     (Untersttzung langer Cc:-Header bis 65500 Zeichen) }
  procedure GetKOPs;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      if xkop=nil then
      begin
        releaseMem(LKop);                 { reservierten Speicher freigeben }
        new(xkop);
        fillchar(xkop^,sizeof(xkop^),0);
        kopanz:=0;
      end;
      while (HdrLen>0) and (kopanz<maxkop) do
      begin
        oab:=''; oar:='';
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,oar,
                    rest,truncated,overflow,0,'nobody@nowhere');
        if oab<>'' then                                { HdrLine => hd.xkop }
          if maxavail>=GetMemAmount(length(oab)+1) +
                       GetMemAmount(length(oar)+1) then
          begin
            inc(kopanz);
            getmem(xkop^[kopanz].adr,length(oab)+1);
            getmem(xkop^[kopanz].name,length(oar)+1);
            xkop^[kopanz].adr^:=oab;                             { Adresse  }
            xkop^[kopanz].name^:=oar;                            { Realname }
          end
          else exit;                                    { Speicher alle :-( }
      end;
    end;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003              }
  {     (Untersttzung langer Newsgroup:-Header bis 65500 Zeichen) }
  procedure GetNewsgroups;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      if msgtyp>1 then exit;
      if xempf=nil then
      begin
        releaseMem(LEmp);                 { reservierten Speicher freigeben }
        new(xempf);
        fillchar(xempf^,sizeof(xempf^),0);
        empfanz:=0;
      end;
      while (HdrLen>0) and (empfanz<maxemp) do
      begin
        oab:='';
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,drealn,
                    rest,truncated,overflow,1,'');
        if oab<>'' then                               { HdrLine => hd.xempf }
          if maxavail>=length(oab)+1 then
          begin
            if (oab[1]='/') and (cpos('@',oab)=0) then
              NGisOK:=true;
            inc(empfanz);
            getmem(xempf^[empfanz],length(oab)+1);
            xempf^[empfanz]^:=oab;
          end
          else exit;                                    { Speicher alle :-( }
      end;
    end;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003                }
  {     (Untersttzung langer Followup-To:-Header bis 65500 Zeichen) }
  procedure GetFollowup;
  begin
    with hd do
    begin
      AppUHdr(BackupId+s1,false);             { Original-RFC-Header sichern }
      if msgtyp>1 then exit;
      if followup=nil then
      begin
        releaseMem(LDis);                 { reservierten Speicher freigeben }
        new(followup);
        fillchar(followup^,sizeof(followup^),0);
        followups:=0;
      end;
      while (HdrLen>0) and (followups<maxfollow) do
      begin
        oab:='';
        RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,oab,drealn,
                    rest,truncated,overflow,1,'');
        if lstr(oab)='/poster' then
          hd.pm_reply:=true
        else if oab<>'' then                       { HdrLine => hd.followup }
          if maxavail>=length(oab)+1 then
          begin
            inc(followups);
            getmem(followup^[followups],length(oab)+1);
            followup^[followups]^:=oab;
          end
          else exit;                                    { Speicher alle :-( }
      end;
    end;
  end;
  
    { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  {     Erste gltige bzw. einzige MsgID holen        }
  function GetMsgID(loop:boolean):string;
  var     p0,p1,p2 : word;
      BruteForceID : string[midlen];
  begin
    { Im Falle, daá der Header keine RFC-konforme  }
    { MsgID enth„lt, kann er dennoch eine/mehrere  }
    { nicht RFC-konforme MsgIDs enthalten (es      }
    { wurden schon defekte GMX-Header gesichtet    }
    { wie: "In-Reply-To: mid1@fqdn, mid2@fqdn").   }
    { Daher ermitteln wir mit einer Brute-Force-   }
    { Methode zun„chst die einzige/letzte MsgID,   }
    { ohne auf Kommentare, Phrasen, WSPs  etc. zu  }
    { prfen. Bei Schleifenaufrufen muá der        }
    { Parameter 'loop' beim ersten Durchlauf mit   }
    { 'false', bei allen weiteren mit 'true'       }
    { bergeben werden, um sicherzustellen, daá    }
    { diese Methode nur beim ersten Durchlauf und  }
    { nicht bei Headern angewandt wird, die sowohl }
    { RFC-konforme als auch nicht RFC-konforme     }
    { MsgIDs enthalten!                            }
    BruteForceID:='';
    if not loop then                             { "BruteForceID" ermitteln }
    begin
      p0:=HdrLen;
      while (p0>1) and (HdrLine^[p0]<>'@') do dec(p0); { letztes '@' suchen }
      if (p0>1) and (p0<HdrLen) and
         (HdrLine^[p0]='@') then
      begin
        p1:=p0; p2:=p0;
        while (p1>1) and not
              (HdrLine^[p1-1] in [' ',',',';','<','>']) do dec(p1);
        while (p2<HdrLen) and not
              (HdrLine^[p2+1] in [' ',',',';','<','>']) do inc(p2);
        if (p1<p0) and (p2>p0) then
        begin
          p0:=min((p2-p1)+1,midlen);
          fastmove(HdrLine^[p1],BruteForceID[1],p0);
          BruteForceID[0]:=chr(p0);
        end;
      end;
    end;
    RfcToZcConv(HdrLine,HdrLen,midlen,realnlen,s0,    { "echte" MsgID holen }
                drealn,rest,truncated,overflow,2,'');
    if not loop and (s0='') and (BruteForceID<>'') then
    begin
      HdrLen:=0;                  { nur zur Sicherheit fr Schleifenaufrufe }
      s0:=BruteForceID;
    end;
    GetMsgID:=s0;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  function GetControl:string;
  var ts : string[7];
  begin
    s0:=trim(s0);
    ts:=left(s0,7);
    if (lstr(ts)='cancel ') and (length(s0)>7) then
    begin
      GetMsgID(false);                                        { MsgID => s0 }
      if left(s0,7)<>ts then s0:=ts+s0;
    end;
    GetControl:=s0;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003               }
  {     (Untersttzung langer References:-Header bis 65500 Zeichen) }
  procedure GetReferences;
  var loop : boolean;

     function DupeID:boolean;
     var i : byte;
     begin
       DupeID:=false;
       if s0=hd.ref then
       begin
         DupeID:=true;
         exit;
       end;
       for i:=1 to hd.addrefs do
         if s0=hd.addref[i] then
         begin
           DupeID:=true;
           exit;
         end;
     end;

  begin
    hd.ref:='';
    loop:=false;
    while HdrLen>0 do
    begin
      GetMsgID(loop);                                         { MsgID => s0 }
      loop:=true;
      if s0<>'' then
      begin
        if (hd.ref='') then
          hd.ref:=s0                    { erste (= „lteste) MsgID => hd.ref }
        else if not DupeID then begin
          if hd.addrefs<maxrefs then                { die 'maxrefs' letzten }
            inc(hd.addrefs)                         { MsgIDs => hd.addrefs  }
          else 
            FastMove(hd.addref[2],hd.addref[1],
                    (maxrefs-1)*sizeof(hd.addref[1]));
          hd.addref[hd.addrefs]:=s0;
        end;
      end;
    end;
  end;

  { --------------------------------------------------------------- }
  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003               }
  {     (Untersttzung langer In-Reply-To:-Header bis 65500 Zeichen }
  {      und Workaround fr DUUCP-Bug)                              }
  { --------------------------------------------------------------- }
  {                                                                 }
  {     Wir bercksichtigen bei mehreren MsgIDs jetzt die *letzte*  }
  {     MsgID, weil die am h„ufigsten benutzte ZC<=>RFC-Gatesoft    }
  {     "DUUCP" mehrere BEZ:-Header nicht, wie es korrekt w„re,     }
  {     nach "References:", sondern in eine komma-separierte Liste  }
  {     nach "In-Reply-To:" bernimmt.                              }
  {     Dadurch wird das Problem verursacht, daá bei einem Reply    }
  {     auf eine Mail in einem AM-Brett mit eingetragenem           }
  {     PM-Vertreter - h„ufige Konstellation bei Mailinglisten -    }
  {     bisher eine falsche Bezugsverkettung beim Empf„nger des     }
  {     Replies hergestellt wird.                                   }
  {                                                                 }
  {     Hinsichtlich der RFC-Konformit„t ist dies unproblematisch,  }
  {     weil alle MsgIDs in einem "In-Reply-To:"-Header direkte     }
  {     Bezge sind; da gem„á ZC-Draft mehrere direkte Bezge aber  }
  {     nicht untersttzt werden, kann ohnehin nur eine der MsgIDs  }
  {     im "In-Reply-To:"-Header bercksichtigt werden, und da ist  }
  {     die letzte genauso falsch oder richtig wie die erste.       }
  {                                                                 }
  { --------------------------------------------------------------- }
  procedure GetInReplyTo;
  var loop : boolean;
  begin
    loop:=false;
    while HdrLen>0 do
    begin
      GetMsgID(loop);                                         { MsgID => s0 }
      loop:=true;
      if s0<>'' then
        InReplyTo:=s0;
    end;
  end;

  { ---------------------------------------------------------------- }
  { Mail - Pfad aus Received-Headern bilden ("Received: from..by..") }
  {                                                                  }
  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003                }
  {     (Untersttzung langer ROT:-Header bis 65500 Zeichen)         }
  {                                                                  }
  { my: Routine komplett neu geschrieben, diverse Bugs beseitigt und }
  {     Auswertung beliebig langer Received-Header und Servernamen   }
  {     implementiert (Details siehe UUZ_ENH.TXT)            12/2005 }
  { ---------------------------------------------------------------- }
  procedure GetReceived;
  var     p1,p2 : word;                 { p1,p2 = Anfang-1,Ende in HdrLine^ }
        by,from : LongHdrP;         { Servernamen hinter 'by ' bzw. 'from ' }
      lby,lfrom : word;                             { L„nge der Servernamen }
          sdupe : boolean;                           { Dupeflag fr hd.pfad }
  const     sby = 'by ';
          sfrom = 'from ';
           sfor = 'for ';

    procedure QuitLPath(var slen:word);
    begin
      slen:=0;
      DoneLPath:=true;
      LongHdr[LPath].rest:='';
      LongHdr[LPath].trunc:=true;
    end;

    procedure GetRec(const key:datetimest; var server:LongHdrP;
                     var slen:word);
    var p3,p4 : word;
        ldupe : boolean;
    begin
      server:=nil; slen:=0; ldupe:=false; sdupe:=false; p2:=0;
      p1:=0;
      repeat
        inc(p1);                                    { 'from ruby by ...' !! }
        p1:=posLong(key,HdrLine,p1,HdrLen,false);   {         ^^^           }
      until (p1=0) or (p1=1) or ((p1>1) and (HdrLine^[p1-1]=' '));
      if p1>0 then
      begin
        inc(p1,length(key)-1);   { 'p1' steht danach auf dem WSP nach 'key' }
        while (p1<HdrLen) and                      { weitere WSPs berlesen }
              (HdrLine^[p1+1]=' ') do inc(p1);
        if p1<HdrLen then         { 'p1' steht jetzt vor dem ersten Zeichen }
        begin
          p2:=p1;
          while (p2<HdrLen) and not             { 'p2' steht danach auf dem }
                (HdrLine^[p2+1] in [' ',';']) do inc(p2); { letzten Zeichen }
          slen:=p2-p1;
          if key=sfor then exit;         { nur Envelope-Empf„nger ermitteln }
          if (slen>0) and not DoneLPath then
          begin
            { ------------- Dupecheck 'by ' vs. LongHdr[LPath] ------------ }
            if (key=sby) and (LongHdr[LPath].len>=slen) then
            begin               
              p3:=LongHdr[LPath].len;   { letztes Zeichen in LongHdr[LPath] }
              p4:=p2;            { letztes Zeichen des Servers hinter 'by ' }
              ldupe:=true;
              while ldupe and (p4>p1) do        { Stringvergleich rckw„rts }
              begin
                ldupe:=(LoCase(LongHdr[LPath].hdr^[p3])=LoCase(HdrLine^[p4])) and
                       ((p4>p1+1) or
                        ((p4=p1+1) and
                         ((p3=1) or (LongHdr[LPath].hdr^[p3-1]='!'))));
                dec(p3);
                dec(p4);
              end;
            end
            { ---------------- Dupecheck 'from ' vs. 'by ' ---------------- }
            {          (im Unterschied zu hd.pfad befindet sich der         }
            {         by-Server noch nicht im Array LongHdr[LPath]!)        }
            else if (key=sfrom) and (slen=lby) then
            begin
              p3:=lby;                            { letztes Zeichen in 'by' }
              p4:=p2;          { letztes Zeichen des Servers hinter 'from ' }
              ldupe:=true;
              while ldupe and (p4>p1) do        { Stringvergleich rckw„rts }
              begin
                ldupe:=LoCase(by^[p3])=LoCase(HdrLine^[p4]);
                dec(p3);
                dec(p4);
              end;
            end;
            if length(hd.pfad)>=slen then           { Dupecheck mit hd.pfad }
            begin
              p3:=length(hd.pfad);             { letztes Zeichen in hd.pfad }
              p4:=p2;            { letztes Zeichen des Servers hinter 'key' }
              sdupe:=true;
              while sdupe and (p4>p1) do        { Stringvergleich rckw„rts }
              begin
                sdupe:=(LoCase(hd.pfad[p3])=LoCase(HdrLine^[p4])) and
                       ((p4>p1+1) or
                        ((p4=p1+1) and
                         ((p3=1) or (hd.pfad[p3-1]='!'))));
                dec(p3);
                dec(p4);
              end;
            end;
          end;
          if ldupe or DoneLPath or
             ((key=sfrom) and               { 'from  by localhost' abfangen }
              (slen=length(trim(sby))) and
              (posLong(trim(sby),HdrLine,p1+1,p1+length(trim(sby)),false)=p1+1)) then
            slen:=0;
          if slen>0 then
          begin
            if maxavail>=slen then
            begin
              getmem(server,slen);
              fastmove(HdrLine^[p1+1],server^[1],slen);
            end
            else QuitLPath(slen);  { nicht gengend Speicher fr Server :-( }
          end;
        end;
      end;
    end;

    { Das Anh„ngen der Daten direkt aus HdrLine^ an hd.pfad muá }
    { v”llig separat geschehen, weil wir fr die Variablen 'by' }
    { und 'from' rein theoretisch nicht gengend Speicher zur   }
    { Verfgung haben k”nnten!                                  }

    procedure AppShortPath;
    var restlen,movelen : byte;

      procedure TruncateShortPath;
      begin
        hd.pfad:=left(hd.pfad,248-length(truncater))+truncater;
        DoneSPath:=true;
      end;

    begin
      if not (sdupe or DoneSPath) and (p2-p1>0) then
      begin
        restlen:=248-length(hd.pfad);
        if restlen>0 then
        begin
          if hd.pfad<>'' then
          begin
            hd.pfad:=hd.pfad+'!';
            dec(restlen);
          end;
          movelen:=min(p2-p1,restlen);
          if movelen>0 then
          begin
            fastmove(HdrLine^[p1+1],hd.pfad[length(hd.pfad)+1],movelen);
            inc(byte(hd.pfad[0]),movelen);
          end;
          if movelen<p2-p1 then TruncateShortPath;
        end
        else TruncateShortPath;
      end;
    end;

    procedure AppLongPath(var server:LongHdrP; var slen:word);
    var l1 : word;                                        { vorherige L„nge }
        l2 : longint;                                     { neue L„nge      }

      procedure CreateNewHeader(const newmem:word);
      begin
        getmem(LongHdr[LPath].hdr,newmem);
        fastmove(HdrLine^[1],LongHdr[LPath].hdr^[1],l1);
        LongHdr[LPath].len:=l1;
      end;

      procedure AppServer;
      begin
        if LongHdr[LPath].len>0 then
        begin
          LongHdr[LPath].hdr^[LongHdr[LPath].len+1]:='!';
          inc(LongHdr[LPath].len,1);
        end;
        fastmove(server^[1],LongHdr[LPath].hdr^[LongHdr[LPath].len+1],slen);
        inc(LongHdr[LPath].len,slen);
      end;

    begin
      if (slen>0) and not DoneLPath then
      begin
        l1:=LongHdr[LPath].len;          { vorherige L„nge von ROT: sichern }
        l2:=l1;
        if slen>0 then
          inc(l2,iif(l2>0,slen+1,slen));         { vorherige L„nge + Server }
        if l1=0 then                             { erster Received:-Header! }
        begin
          if maxavail>=l2 then
          begin
            getmem(LongHdr[LPath].hdr,l2);                   { Pfad anlegen }
            AppServer;                                    { Server anh„ngen }
          end
          else QuitLPath(slen);      { nicht gengend Speicher fr Pfad :-( }
        end
        else if (l2<=sizeof(LongHdr[LPath].hdr^)) then            { append: }
        begin
          fastmove(LongHdr[LPath].hdr^[1],HdrLine^[1],l1);   { ROT: sichern }
          DisposeLongHdr(LPath);                     { alten Pfad freigeben }
          if maxavail>=l2 then
          begin
            CreateNewHeader(l2);                       { neuen Pfad anlegen }
            AppServer;                                    { Server anh„ngen }
          end
          else begin               { nicht gengend Speicher fr neuen Pfad }
            CreateNewHeader(l1);             { vorherigen Pfad restaurieren }
            QuitLPath(slen);
          end;
        end
        else QuitLPath(slen);                        { Arraygrenze erreicht }
      end;
      if (slen>0) and (server<>nil) then    { Speicher fr Server freigeben }
      begin
        freemem(server,slen);
        slen:=0;
        server:=nil;
      end;
    end;

  begin
    AppUHdr('U-'+s1,false);                   { Original-RFC-Header sichern }
    { "(qmail id xxx invoked from network)" enth„lt "from " }
    RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,   { Kommentare/Quoting  }
                s0,drealn,rest,truncated,overflow,3,'');{ in Header entfernen }
    { Envelope-Empf„nger ermitteln }
    if getrecenvemp and (ReceivedEnv='') then
    begin
      GetRec(sfor,by,lby);                { 'lby' miábrauchen, 'by' = Dummy }
      if lby>0 then
      begin
        byte(ReceivedEnv[0]):=min(lby,sizeof(ReceivedEnv)-1);
        fastmove(HdrLine^[p1+1],ReceivedEnv[1],byte(ReceivedEnv[0]));
      end;
      if cpos('@',ReceivedEnv)>0 then
        RFC2822_Remove(ReceivedEnv,0)
      else
        ReceivedEnv:='';
    end;

    if DoneSPath and DoneLPath then exit;
    GetRec(sby,by,lby);                   { Server hinter 'by '   finden    }
    AppShortPath;                         { by-Server   an hd.pfad anh„ngen }
    GetRec(sfrom,from,lfrom);             { Server hinter 'from ' finden    }
    AppShortPath;                         { from-Server an hd.pfad anh„ngen }
    { ---------------------------------------------- }
    { 'AppLongPath' darf auch fr den by-Server erst }
    { hier aufgerufen werden, weil wir die Daten im  }
    { Array 'HdrLine' zwischenlagern, wenn wir       }
    { 'LongHdr[LPath]' "verl„ngern" - und wrden den }
    { from-Server nicht mehr finden, weil dieser     }
    { dann bereits berschrieben worden w„re.        }
    { ---------------------------------------------- }
    AppLongPath(by,lby);           { by-Server   an LongHdr[LPath] anh„ngen }
    AppLongPath(from,lfrom);       { from-Server an LongHdr[LPath] anh„ngen }

  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003                 }
  {     (Untersttzung langer Delivered-To:-Header bis 65500 Zeichen) }
  procedure GetDeliveredTo;
  begin
    AppUHdr('U-'+s1,false);                   { Original-RFC-Header sichern }
    if not UseEnvTo or delivToAlias then exit;
    hd.oab:='';
    RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,hd.oab,drealn,
                rest,truncated,overflow,0,'');
    if hd.oab<>'' then
    begin
      inc(delivToCount);
      if (lstr(left(hd.oab,6))='alias-') then      { Ersten Alias-Header    }
      begin                                        { immer bercksichtigen! }
        delivToAlias:=true;
        delivToEmpf:=mid(hd.oab,7);
      end
      else if (delivToCount<3) then { ansonsten zweiten Delivered-To nehmen }
        delivToEmpf:=hd.oab;
    end;
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  procedure GetMsgDate;
  begin
    RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,   { Kommentare/Quoting  }
                s0,drealn,rest,truncated,overflow,3,'');{ in Header entfernen }
    hd.zdatum:=RFC2Zdate(s0);
    ZCtoZdatum(hd.zdatum,hd.datum);
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  procedure GetMime(p:mimeproc);
  begin
    AppUHdr('U-'+s1,structured=0);            { Original-RFC-Header sichern }
    RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,   { *nur* Kommentare in }
                s0,drealn,rest,truncated,overflow,4,'');{ Header entfernen!   }
    p(s0);
  end;

  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  procedure GetPriority;  { robo: (X)-Priority konvertieren }
  var p : integer;
  begin
    if hd.priority = 0 then   { nur ersten (X)-Priority Header beachten }
    begin  
      RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,   { Kommentare/Quoting  }
                  s0,drealn,rest,truncated,overflow,3,'');{ in Header entfernen }
      p := 1;
      { nur Zahl am Anfang beachten: }
      while (s0 [p] in ['0'..'9']) and (p <= length (s0)) do inc (p);
      if p = 1 then begin
        { keine Zahl: auf urgent/high, normal, low/non-urgent prfen }
        s0 := lstr (left (s0, 3));
        { laufzeitoptimierte Abfrage: das Wahrscheinlichste zuerst }
        if s0 = 'nor' then hd.priority := 3
        else if (s0 = 'hig') or (s0 = 'urg') then hd.priority := 1
        else if (s0 = 'low') or (s0 = 'non') then hd.priority := 5;
      end
      else begin
        { Zahl 1:1 konvertieren und auf 1..5 begrenzen }
        s0 := left (s0, p - 1);
        hd.priority := minmax (ival (s0), 1, 5);
      end;
    end;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003       }
  {     Untersttzung langer Subject:-Header bis 65500 Zeichen }
  {     Original-RFC-Header sichern, wenn er MIME-codiert war  }
  procedure GetBetreff;
  var subjBak : LongHdrP;
      subjLen : word;
  begin
    subjBak:=nil;
    if maxavail>=HdrLen then                    { tempor„res Backup anlegen }
    begin
      subjLen:=HdrLen;
      getmem(subjBak,subjLen);
      fastmove(HdrLine^,subjBak^,subjLen);
    end;
    SaveLongHdr(LSub,BetreffLen,s0,hd.betreff,true,structured);
    if subjBak<>nil then
    begin
      if subjLen>HdrLen then                      { Subject wurde ver„ndert }
      begin
        fastmove(subjBak^,HdrLine^,subjLen);
        HdrLen:=subjLen;
        freemem(subjBak,subjLen);
        subjBak:=nil;
        AppUHdr(BackupId+s1,false);
      end
      else begin                            { Subject wurde nicht ver„ndert }
        freemem(subjBak,subjLen);
        subjBak:=nil;
      end;
    end;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003        }
  {     (Untersttzung langer MAILER:-Header bis 65500 Zeichen) }
  procedure GetProgramm(const is_xp:boolean);
  begin
    { Workaround fr UKA_PPP/NOS-BOX-Postings mit }
    { Headern "X-Newsreader:" *und* "X-Mailer:"   }
    { sowie VSoup-Postings mit Headern            }
    { "X-Newsreader:" *und* "User-Agent:"         }
    if (((zz='x-mailer') and
         ((left(lstr(s0),7)='uka_ppp') or
          (left(lstr(s0),7)='nos-box'))) or
        ((zz='user-agent') and
         (left(lstr(s0),5)='vsoup'))) and
       (hd.programm<>'') then
    begin
      if length(hd.programm)+length(s0)+5<=sizeof(hd.programm)-1 then
        hd.programm:=hd.programm+' via '+s0
    end
    else if ((left(lstr(hd.programm),7)='uka_ppp') or
             (left(lstr(hd.programm),7)='nos-box') or
             (left(lstr(hd.programm),5)='vsoup')) and
            (length(hd.programm)+length(s0)+5<=sizeof(hd.programm)-1) then
      hd.programm:=s0+' via '+hd.programm
    else if not DoneProg then
    begin
      DoneProg:=is_xp;                                { bereits vorhandenen }
      if not (is_xp and (hd.programm<>'') and         { FreeXP-Header evtl. }
              (length(hd.programm)>length(s0)) and    { nicht berschreiben }
              (left(hd.programm,length(s0))=s0)) then
        SaveLongHdr(LProg,sizeof(hd.programm)-1,s0,hd.programm,true,structured);
    end
    else begin                                     { "X-XP-Version:" evtl.  }
      if (length(s0)>length(hd.programm)) and      { trotzdem berschreiben }
         (left(s0,length(hd.programm))=hd.programm) then
        SaveLongHdr(LProg,sizeof(hd.programm)-1,s0,hd.programm,true,structured);
    end;
  end;

  { read a string variable and remove comments        }
  { my: Anpassung im Zuge des Rewrite 08/2002-04/2003 }
  procedure GetVar(var r0,s0:string);
  begin
    RFC2822_Remove(s0,4);
    r0:=s0;
  end;

  { my: Neue Routine im Zuge des Rewrite 08/2002-04/2003 }
  {     (Gelesenen String ins Header-Array kopieren)     }
  procedure MoveString;
  begin
    fastmove(s[1],HdrLine^[HdrLen+1],min(length(s),sizeof(HdrLine^)-HdrLen));
    if not overflow then 
      overflow:=(sizeof(HdrLine^)-HdrLen)<(length(s));
    if overflow and not chkd_trunc then
    begin
      rest:=copy(s,sizeof(HdrLine^)-HdrLen,sizeof(rest)-1);
      truncated:=not (((length(rest)=3) and (mid(rest,2)='?=')) or
                      ((length(rest)=2) and (rest='?=')));
      chkd_trunc:=true;
      rest:=mid(rest,2);
    end;
    inc(HdrLen,min(length(s),sizeof(HdrLine^)-HdrLen));
  end;

  { Die folgenden Header betrachten wir als strukturierte Header und }
  { ersetzen gem„á RFC2822 via 'GetHeader' mehrfache Leerzeichen     }
  { auáerhalb von Kommentaren und quoted-strings durch eines (der    }
  { umgekehrte Weg, nur bei unstrukturierten Headern mehrfache Leer- }
  { zeichen nicht zu ersetzen, geht deshalb nicht, weil optionale    }
  { Header als unstrukturiert anzusehen und daher nicht eindeutig    }
  { definiert sind.                                                  }

  function is_structured:byte;
  begin
    is_structured:=
      minmax(
               {*}                       { von UUZ interpretierte Header: }
      pos(';'+zz+';',';cc;content-type;content-transfer-encoding;control;'
                   + 'date;delivered-to;disposition-notification-to;'
                   + 'distribution;envelope-to;from;followup-to;') +
      pos(';'+zz+';',';in-reply-to;keywords;message-id;newsgroups;'
                   + 'original-recipient;path;references;received;'
                   + 'reply-to;return-receipt-to;sender;supersedes;to;'
                   + 'x-envelope-to;x-original-to;') +
               {*} { trace fields (RFC2822), von UUZ nicht interpretiert: }
      pos(';'+zz+';',';resent-date;resent-from;resent-sender;resent-to;'
                   + 'resent-cc;resent-bcc;resent-message-id;return-path;'
                   + 'resent-reply-to;delivery-date;') +
               {*}    { seltene News-Header, von UUZ nicht interpretiert: }
      pos(';'+zz+';',';also-control;approved;article-names;article-updates;'
                   + 'expires;see-also;x-complaints-to;x-trace;xref;') +
               {*}                   { einige weitere Header aus RFC2076: }
      pos(';'+zz+';',';disclose-recipients;content-disposition;for-comment;'
                   + 'for-handling;apparently-to;errors-to;content-id;'
                   + 'obsoletes;expiry-date;reply-by;')
             ,0,1);
  end;

begin   { of ReadRFCheader }
  ReceivedEnv:='';
  delivToEmpf:='';
  delivToCount:=0;
  delivToAlias:=false;
  hd.mime.ctype:=tText;   { Default: Text }
  HdrLen:=0;
  overflow:=false;
  truncated:=false;
  rest:='';
  chkd_trunc:=false;
  DoneLPath:=false;
  DoneSPath:=false;
  DoneProg:=false;
  NGisOK:=false;
  mailinglist:=false;
  hd.xabs:=nil;
  hd.xsender:=nil;
  hd.xempf:=nil;
  hd.xoem:=nil; 
  hd.xkop:=nil; 
  hd.xreplyto:=nil;
  hd.followup:=nil;
  InReplyTo:='';
  Ustart:=nil;
  if mails+news>1 then                { ab 2. Nachricht erneut Speicher fr }
    allocMem;                         { dynamische ZC-Header reservieren    }
  new(HdrLine);
  { ----------------------------------------------------------------------- }
  if s0<>'' then                { Leerzeile hinter 'DATA', "From_" oder     }
  repeat                        { '#! rnews' => Zeilen als Body betrachten! }
    p:=cpos(':',s0);
    if p>1 then                                          { neue Headerzeile }
    begin
      zz:=left(s0,p-1);                              { Identifier ermitteln }
      if (msgtyp in [4,5]) and                            { mbox: '>From '? }
         (left(zz,length(mboxline)+1)='>'+mboxline) then
        delfirst(zz);
      zz:=rtrim(zz);
      if not FieldNameOK(zz) then                    { Identifier ungltig! }
        p:=0          { (f„ngt auch 'From [...] 12:09:43 2004' bei mbox ab) }
      else
        s0:=mid(s0,p+1);
    end
    else p:=0;
 (* fillchar(HdrLine^,sizeof(HdrLine^),0); *)     { jm: Performance-Killer! }
    s0:=ltrim(s0);
    if (p>0) and (s0<>'') then
    begin
      fastmove(s0[1],HdrLine^[1],length(s0));
      inc(HdrLen, length(s0));
    end;

    repeat                          { aktuelle Headerzeile bis zum Ende und }
      while eol=0 do                { alle gefoldeten Headerzeilen einlesen }
      begin
        if (p=0) or overflow then
          ReadString(false)          { zu verwerfende (Rest)Zeile berlesen }
        else begin
          ReadString(true);
          if HdrLen=0 then s:=ltrim(s);   { ltrim, falls nur Blanks gelesen }
          MoveString;
        end;
      end;
      MsgEnde:=end_of_mail(msgtyp);
      if not MsgEnde then ReadString(true);         { *n„chste* Zeile lesen }
      HdrLineComplete:=MsgEnde or
        not ((s<>'') and (s[1] in [' ',#9]));
      if not HdrLineComplete then              { gefoldete Zeile => HdrLine }
      begin
        if HdrLen=0 then s:=ltrim(s);
        if not overflow then MoveString;
      end;
    until HdrLineComplete or (bufpos>=bufanz);

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

    with hd do
    begin

      s1:=zz;
      LoString(zz);

      structured:=is_structured;  { in Funktion ausgelagert wegen Stackgr”áe }

      s0:=GetHeader(HdrLine,HdrLen,rest,truncated,   { TABs und Multi-WSPs   }
                    overflow,false,true,structured); { ersetzen, Hdr => 's0' }

      if p>0 then
      begin
        case zz[1] of
        'c': if zz='cc'           then GetKOPs else
             if zz='content-type' then getmime(GetContentType) else
             if zz='content-transfer-encoding' then getmime(GetCTencoding) else
             if zz='control'      then control:=GetControl
             else AppUHdr('U-'+s1,structured=0);
        'd': if zz='date'         then GetMsgDate else
             if zz='delivered-to' then GetDeliveredTo else
             if zz='disposition-notification-to' then
                      RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,EmpfBestTo,
                                  drealn,rest,truncated,overflow,0,'') else
             if zz='distribution' then
             begin
               RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,   { Kommentare }
                           s0,drealn,rest,truncated,overflow,4,'');{ entfernen  }
               AppUHdr('U-'+s1,false);
             end
             else AppUHdr('U-'+s1,structured=0);
        'm': if zz='message-id'   then msgid:=GetMsgID(false) else
             if zz='mime-version' then getmime(GetMimeVersion) else
             if zz='mailer' {RFC2076} then GetProgramm(false) else
             if zz='mail-system-version' {RFC2076} then GetProgramm(false)
             else AppUHdr('U-'+s1,structured=0);
        'o': if zz='organization' then SaveLongHdr(LOrg,sizeof(organisation)-1,s0,organisation,true,structured) else
             if zz='organisation' then SaveLongHdr(LOrg,sizeof(organisation)-1,s0,organisation,true,structured) else
             if zz='original-recipient' then GetEnvEmp else
             if zz='originating-client' {RFC2076} then GetProgramm(false) else
             if zz='obsoletes'    then ersetzt:=GetMsgID(false)
             else AppUHdr('U-'+s1,structured=0);
        'r': if zz='references'   then GetReferences else
             if (zz='received') and (msgtyp>1) then GetReceived else
             if zz='reply-to'     then GetPMReplyTo else
             if zz='return-receipt-to' then
                      RfcToZcConv(HdrLine,HdrLen,adrlen,realnlen,EmpfBestTo,
                                  drealn,rest,truncated,overflow,0,'')
             else AppUHdr('U-'+s1,structured=0);
        's': if zz='subject'      then GetBetreff else
             if zz='sender'       then GetSender else
             if zz='supersedes'   then ersetzt:=GetMsgID(false) else
             if zz='summary'      then SaveLongHdr(LSum,sizeof(summary)-1,s0,summary,true,structured)
             else AppUHdr('U-'+s1,structured=0);
        'x': if zz='x-comment-to' then fido_to:=s0 else
             if zz='x-gateway'    then
                  SaveLongHdr(LGate,sizeof(gateway)-1,s0,gateway,true,structured) else
             if zz='x-mailer'     then GetProgramm(false) else
             if zz='x-newsreader' then GetProgramm(false) else
             if zz='x-news-reader'then GetProgramm(false) else
             if zz='x-reader'     then GetProgramm(false) else  { my: Mozilla! }
             if zz='x-software'   then GetProgramm(false) else
             if zz='x-xp-version' then GetProgramm(true) else
             if zz='x-z-post'     then
                  SaveLongHdr(LPost,sizeof(postanschrift)-1,s0,postanschrift,true,structured) else
             if zz='x-zc-post'    then
                  SaveLongHdr(LPost,sizeof(postanschrift)-1,s0,postanschrift,true,structured) else
             if zz='x-z-telefon'  then
                  SaveLongHdr(LTele,sizeof(telefon)-1,s0,telefon,true,structured) else
             if zz='x-zc-telefon' then
                  SaveLongHdr(LTele,sizeof(telefon)-1,s0,telefon,true,structured) else
             if zz='x-xp-ctl'     then XPointCtl:=ival(s0) else

             { X-No-Archive Konvertierung }
             if zz='x-no-archive' then
             begin          { Kommentare/Quoting entfernen }
               RfcToZcConv(HdrLine,HdrLen,sizeof(s0)-1,realnlen,
                           s0,drealn,rest,truncated,overflow,3,'');
               if lstr(s0)='yes' then xnoarchive:=true;
               AppUHdr('U-'+s1,false);   { hier 'AppUHdr' ausnahmsweise     }
             end else                    { erst zum Schluá, weil der Wert   }
                                         { in XPMAKEHD.INC ausgewertet wird }
             if zz='x-priority'   then GetPriority else
             if zz='x-xp-mode'    then xpmode:=s0 else
             if zz='x-homepage'   then
                  SaveLongHdr(LHome,sizeof(homepage)-1,s0,homepage,true,structured) else
             if zz='x-envelope-to' then GetEnvEmp else
             if zz='x-original-to' then GetEnvEmp else
             if (left(zz,4)<>'x-xp') then AppUHdr(s1,structured=0);
        else if zz='from'         then GetFrom else
             if zz='to'           then GetEmpf else
             if zz='newsgroups'   then GetNewsgroups else
             if (zz='path') and (msgtyp=1) then  { 'Path:' nur bei News sichern }
                      SaveLongHdr(LPath,sizeof(pfad)-1,s0,pfad,true,structured) else
             if zz='keywords'     then
                      SaveLongHdr(LKey,sizeof(keywords)-1,s0,keywords,false,structured) else
             if zz='in-reply-to'  then GetInReplyTo else
             if zz='followup-to'  then getFollowup else
             if zz='newsreader'   then GetProgramm(false) else
             { User-Agent is new in grandson-of-1036 }
             if zz='user-agent'   then GetProgramm(false) else
             if zz='encrypted'    then pgpflags:=iif(ustr(s0)='PGP',fPGP_encoded,0) else
             if zz='priority'     then GetPriority else
             if zz='importance'   then GetPriority else
             if zz='envelope-to'  then GetEnvEmp else
             if zz<>'lines'       then AppUHdr('U-'+s1,structured=0);
        end; { case }
      end;
      s0:=s;
      HdrLen:=0;
      overflow:=false;
      truncated:=false;
      chkd_trunc:=false;
      rest:='';
    end;
  until (MsgEnde or ((s0='') and lasteol)) or (bufpos>=bufanz);
  { ----------------------------------------------------------------------- }
  with hd do
  begin

    { ---------------------- kein From:-Header vorhanden => hd.xabs anlegen }
    if xabs=nil then
      NewABS
    { ----------------------------------------- From:-Header war vorhanden: }
    else if xabs^[1].adr<>nil then
    begin
      i:=0;
      while i<absanz do                                     { Dupes filtern }
      begin
        inc(i);
        while (i<absanz) and                        { gefilterte und leere  }
              ((xabs^[i].adr=nil) or                { Adressen berspringen }
               ((xabs^[i].adr<>nil) and
                (xabs^[i].adr^=''))) do
          inc(i);
        if xabs^[i].adr=nil then break;          { letzte existente Adresse }
        if (absanz>1) and (i<absanz) then for p:=i+1 to absanz do
        begin
          while (p<absanz) and                      { gefilterte und leere  }
                ((xabs^[p].adr=nil) or              { Adressen berspringen }
                 ((xabs^[p].adr<>nil) and
                  (xabs^[p].adr^=''))) do
            inc(p);
          if xabs^[p].adr=nil then break;        { letzte existente Adresse }
          if (lstr(xabs^[i].adr^)=lstr(xabs^[p].adr^)) then     { Dupe      }
            RemoveABS(p);                                       { entfernen }
        end;
      end;
      { -------------------------------- evtl. entstandene Lcken schlieáen }
      i:=0;
      if absanz>1 then while i<absanz-1 do
      begin
        inc(i);
        while xabs^[i].adr<>nil do inc(i);             { erste Lcke suchen }
        if i<absanz then
          p:=i+1
        else break;                                 { keine Lcke vorhanden }
        while (p<absanz) and (xabs^[p].adr=nil) do    { n„chsten ABS suchen }
          inc(p);
        if xabs^[p].adr=nil then break;       { kein n„chster ABS vorhanden }
        absender:=xabs^[p].adr^;                  { Adresse  zwischenlagern }
        realname:=xabs^[p].name^;                 { Realname zwischenlagern }
        RemoveABS(p);                          { ABS hinter Lcke entfernen }
        if CreateABS(i,absender,realname) then    { ABS nach Lcke kopieren }
        begin
          absender:='';
          realname:='';
        end;
        if p=absanz then break;      { dann kann keine Lcke mehr kommen... }
      end;
    end;

    i:=0;
    while (i<absanz) and (xabs^[i+1].adr<>nil) do       { Aktuelle 'absanz' }
    begin                                               { ermitteln         }
      inc(i);
      if (i>1) and (xabs^[1].adr^='') and       { evtl. aktuell gltige     }
         (cpos('@',xabs^[i].adr^)>0) then       { Adresse => leere xabs^[1] }
      begin                      
        absender:=xabs^[i].adr^;                  { Adresse  zwischenlagern }
        realname:=xabs^[i].name^;                 { Realname zwischenlagern }
        ShiftABS(i);                         { Elemente nach hinten shiften }
        xabs^[1].adr^:=absender;
        xabs^[1].name^:=realname;
      end;
    end;
    absanz:=i;

    if (absanz=0) and                   { Kommt vor, wenn From:-Header      }
       (CreateABS(1,'','')) then        { nicht vorhanden war oder nur      }
      inc(absanz);                      { leere Adressen/Realnames enthielt }

    { -------------------------------------------- Ende Analyse ABS:-Header }

    { Wenn hier 'xabs^[1].adr' immer noch leer ist, dann  }
    { sind auch die Adressen in allen folgenden Elementen }
    { leer bzw. es sind gar keine weiteren Elemente im    }
    { Array mehr vorhanden.                               }
    { Wenn 'xabs^[1]' das einzige Element und die Adresse }
    { leer ist, dann *kann* 'xabs^[1].name' dennoch einen }
    { Inhalt haben. Wenn mehr als ein Element vorhanden   }
    { und die Adresse in 'xabs^[1].adr' leer ist, dann    }
    { *muá* der Name in *allen* Elementen einen Inhalt    }
    { haben (sonst wrden die Elemente nicht existieren). }

    if (xsender<>nil) then             { WAB: setzen, Sender: hat Priorit„t }
    begin
      if (cpos('@',xsender^.adr^)>0) then
      begin
        wab:=xsender^.adr^;
        war:=xsender^.name^;
      end;
      freemem(xsender^.adr,length(xsender^.adr^)+1);
      freemem(xsender^.name,length(xsender^.name^)+1);
      xsender^.adr:=nil;
      xsender^.name:=nil;
      dispose(xsender);
    end;

  (*
    { my: Schreiben des WAB nach ABS: bei leerem ABS:  }
    {     vorerst auskommentiert, Verhalten umstritten }

    if (xabs^[1].adr^='') and           { kein gltiger Absender vorhanden: }
       (wab<>'') then 
    begin
      if (xabs^[1].name^<>'') and (absanz<maxabs) then
        if (CreateABS(absanz+1,'','')) then
        begin
          inc(absanz);
          ShiftABS(absanz);                  { Elemente nach hinten shiften }
        end;
      xabs^[1].adr^:=wab;                                 { WAB => xabs^[1] }
      xabs^[1].name^:=war;
      wab:='';
      war:='';
    end;
  *)

    for i:=1 to absanz do if xabs^[i].adr^='' then       { alle leeren ABS: }
      xabs^[i].adr^:='unknown@sender';                   { fllen           }

    i:=0;                                    { Dupecheck WAB: <=> alle ABS: }
    while (i<absanz) and (wab<>'') do
    begin
      inc(i);
      if lstr(wab)=lstr(xabs^[i].adr^) then  { Wenn WAB: in ABS: vorhanden, }
      begin                                  { aktuelle Adresse => xabs^[1] }
        wab:='';
        if i>1 then
        begin
          absender:=xabs^[i].adr^;                { Adresse  zwischenlagern }
          realname:=xabs^[i].name^;               { Realname zwischenlagern }
          ShiftABS(i);                       { Elemente nach hinten shiften }
          xabs^[1].adr^:=absender;
          xabs^[1].name^:=realname;
        end;
      end;
    end;

    if (cpos('@',envemp)=0) and (cpos('@',delivToEmpf)>0) then
      envemp:=delivToEmpf;

    MimeAuswerten;
  end;
  dispose(HdrLine);
end;   { of ReadRFCheader }

procedure OpenFile(var fn:pathstr);
begin
  assign(f1,fn);
  reset(f1,1);
  ReadBuf;
  eol:=1;    { damit lasteol beim ersten RestString true wird }
end;

function SetMailUser(mailuser:string):string;
begin
  if (OwnSite='') or (mailuser='') then
    if cpos('@',mailuser)=0 then
      SetMailUser:=''
    else
      SetMailUser:=mailuser
  else
    if cpos('@',mailuser)=0 then
      if cpos('!',mailuser)=0 then
        SetMailUser:=mailuser+'@'+OwnSite
      else
        SetMailUser:=mid(mailuser,rightpos('!',mailuser)+1)+'@'+OwnSite
    else
      SetMailUser:=left(mailuser,cpos('@',mailuser))+OwnSite;
end;

{ Envelope-Empf„nger prfen, ggf. EMP: => OEM: }

procedure CheckEnvEmp(const s:string);
var        i : integer;
    EnvInEMP : boolean;
begin
  EnvInEMP:=false;
  if s<>'' then
  begin
    for i:=1 to hd.empfanz do                 { Envelope-Empf. in hd.xempf? }
    begin
      EnvInEMP:=s=hd.xempf^[i]^;
      if EnvInEMP then break;
    end;
    if not EnvInEMP then
    begin
      releaseMem(LOem);      { res. Speicher fr Envelope-Empf. (xempf^[1]) }
      if maxavail>=GetMemAmount(length(s)+1) +
                   GetMemAmount(sizeof(hd.xempf^)) then
      begin
        hd.xoem:=hd.xempf;                   { Envelope-Empf„nger einsetzen }
        hd.oemanz:=hd.empfanz;
        new(hd.xempf);
        fillchar(hd.xempf^,sizeof(hd.xempf^),0);
        getmem(hd.xempf^[1],length(s)+1);
        hd.xempf^[1]^:=s;
        hd.empfanz:=1;
      end;
    end;
  end;
end;

{ UUCP-Mail -> ZConnect }

procedure ConvertMailfile(fn:pathstr; mailuser:string; const raw:boolean);
var p,p2,p3 : byte;
          i : integer;
      fp,bp : longint;
         _s : string;

begin
  write('mail: ',fn);
  inc(mails);
  start_of_UTF:=true;
  end_of_UTF:=false;
  OpenFile(fn);
{  ok:=true; }
  fillchar(hd,sizeof(hd),0);
  if client then
    hd.netztyp:=nt_Client
  else
    hd.netztyp:=nt_RFC;
  repeat             { Envelope einlesen }
    ReadString(true);
    _s:=s;
    if raw then break;
    p:=cpos(' ',s);
    if p=0 then p:=cpos(#9,s);
    if (p<=1) then p:=length(s)+1;
    LoString(s);
    if s[p-1]<>':' then
    begin
      if (left(s,p-1)='from') or (left(s,p-1)='>from') then
      begin
        s:=trim(mid(s,p));                           { Envelope-Absender }
        p:=cpos(' ',s);
        if p>0 then
        begin
          hd.wab:=left(s,p-1);
          delete(s,1,p);
          p:=cpos('!',hd.wab);
          if cpos('!',hd.wab)>0 then
          begin
            p2:=length(hd.wab);
            while hd.wab[p2]<>'!' do dec(p2);   { rechtes "!" suchen }
            p:=p2-1;
            while (p>0) and (hd.wab[p]<>'!') do dec(p);   { n„chstes "!" suchen }
            p3:=cpos('@',mid(hd.wab,p2+1));
            if p3>0 then
              if stricmp(copy(hd.wab,p2+1,p3-1)+'@'+copy(hd.wab,p+1,p2-p-1),
                         hd.absender) then
                hd.wab:=''
              else
                hd.wab:=copy(hd.wab,p2+1,p3-1)+'%'+copy(hd.wab,p+1,p2-p-1)+
                       mid(hd.wab,p2+p3)
            else
              hd.wab:=mid(hd.wab,p2+1)+'@'+copy(hd.wab,p+1,p2-p-1);
            end
          else if cpos('@',hd.wab)=0 then
          begin
            p:=pos('remote from',s);
            if p>0 then hd.wab:=hd.wab+'@'+mid(s,p+12)
            else hd.wab:='';   { war wohl nix }
          end;
        end;
      end;
      p:=0;
    end;
    if (eol=0) and ((p=0) or (s[p-1]<>':')) then
      ReadString(false);
  until ((p>0) and (s[p-1]=':')) or (bufpos=bufanz) or
    (s='');        { Leerzeile hinter "From_" => Zeilen als Body betrachten }
  if bufpos<bufanz then
  begin
    if hd.wab<>'' then
      writeln(' from ',hd.wab)
    else
      writeln('');
    s:=_s;
    ReadRFCheader(2,s);

    if (mailuser='') then
    begin
      if UseEnvTo and (hd.envemp<>'') then
        mailuser:=SetMailuser(hd.envemp)
      else if getrecenvemp and (ReceivedEnv<>'') then
      begin
        hd.envemp:=ReceivedEnv;
        mailuser:=SetMailuser(hd.envemp);
      end;
    end;

    if mailuser<>'' then CheckEnvEmp(mailuser);

    fp:=fpos; bp:=bufpos;
    hd.groesse:=0;
    ReadRfcBody(2,false,0);     { Mailgr”áe berechnen }
    seek(f1,fp); ReadBuf; bufpos:=bp;
    WriteZcHeader(true);        { ZC-Header erzeugen }
    CheckMem(1,fn,true);
  end
  else writeln;
  ReadRfcBody(2,true,0);        { Body anh„ngen }
  close(f1);
  setfattr(f1,0);   { Archivbit abschalten }
  start_of_UTF:=false;  { Default setzen! }
  end_of_UTF:=false;    { Default setzen! }
end;


begin

end.
