{*****************************************************************************
 *
 *  ParserSup.pas - E-mail Parser Support Routines (27-July-1998)
 *
 *  Copyright (c) 1998-99 Michael Haller
 *
 *  Author:     Michael Haller
 *  E-mail:     michael@discountdrive.com
 *  Homepage:   http://www.discountdrive.com/sunrise
 *
 *  This program is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU General Public License
 *  as published by the Free Software Foundation;
 *
 *  This program 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 General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 *
 *----------------------------------------------------------------------------
 *
 *  Revision history:
 *
 *     DATE     REV                 DESCRIPTION
 *  ----------- --- ----------------------------------------------------------
 *  JUN 2002    AH  Added extra FW/RE Headings
 *****************************************************************************}

unit ParserSup;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Base64Sup, UUCode, ComCtrls; //AH16 Added...


type
  TState = set of (stNone, stReply, stReColon, stReBra, stNumber, stOther);

const
  AlphaNumCharsI = ['A'..'Z', 'a'..'z', '0'..'9', #13, #10, #32];
  AlphaNumCharsN = ['0'..'9'];
  AlphaNumCharsQ = ['%', '#', '$', '^', '&', '*', '>', '|']; // Quote characters...
  AlphaPunctation = ['.', ',', ':', ';', '?', '!'];


function SkipChar(S: string; C: Char): string;
procedure CommataStringToStringList(S: string; var SL: TStringList);
function StringListToCommataString(SL: TStringList; Decoded: Boolean): string;
procedure SaveMIMEToFile(var SL: TStringList; ContentType, ContentEncoding:
  string);
procedure GetFieldArguments(S: string; var S1, S2: string);
procedure MakeFields(var SL: TStringList; ClearEmpties: Boolean);
function GetContentType(Variable, ContentType: string): string;
function FromQuotedPrintable(S: string): string;
function ToQuotedPrintable(S: string): string;
function GetMIMEFilename(Dir, ContentType: string): string;
procedure GetMIMEType(Filename: string; var Content, Encoding: string; var
  Format: Byte);
function GetMIMEHeaderField(Field: string): string;
function SetMIMEHeaderField(Field: string): string;
function BreakString(S: string; wrapcol : integer = -1): string; //AHRJ05
function NewBreakString(S : String; wrapcol : integer; sPrefix : string) : string;
function NewBreakStringD(S: String; wrapcol : integer; aPrefix : string): String;
procedure AttachFileToTextfile(var F: Text; Filename: string; Format: Byte);
procedure SkipSpaces(var S: string);
function GetToken(var S: string): string;
function ApplyFilter(Msg, Filter: string; var Points: Integer): Boolean;
function GetUniqueMailName: string;
function ExtractEMailAddress(S: string): string;
function ExtractEMailName(S: string): string;
procedure GetOutcomingMailFileList(Node: TTreeNode; var SL: TStringList);
function StretchString(S: string; Count: Integer): string;
function SoftLineBreak(S: string; Quoted : Boolean): string;
function GetCommataStringReceiver: string;
procedure SetPXTreeNodeName(Node: TTreeNode);
function GetPXTreeNodeName(Node: TTreeNode): string;
procedure ParseMailto(const AIn: string; var AAddress, ASubject, ABody: string);
procedure FromAddressFormat(S: string; var AddressInfo:Tstringlist);
procedure FromOldAddressFormat(S: string; var I1: Integer; var S1, S2,
  S3, S4, S5: string);
function GenerateBoundary : string;
function NumberReplies(repstring : string; astring : string) : String; // AHRJ02
//-- Parser support for Charsets.
function IsCharsetConversionNeeded(s : string) : boolean; // AHRJ03
function IsValidFileName(afilename : string) : boolean;
procedure HeaderAddressToStringList(S : string; SL : TStringList); //AHRK46
function NewBreakStringE(S : string; wrapcol : integer; aprefix : string) : string;
procedure AddBookToStringList(abook : string; AString : TStringList);

implementation

uses
  PXStuff, MailParser;

var
  FT: Text;
  FF: file;

procedure FromAddressFormat(S: string; var AddressInfo:Tstringlist);
var
  I,j: Integer;
  sTemp:string;
begin
  j:=0;
  AddressInfo.Clear;
  I := Pos(chr(30), S);
  while I>0  do begin
    AddressInfo.Add(Copy(S, 1, I - 1));
    Delete(S, 1, I);
    I := Pos(chr(30), S);
    j:=j+1;
  end;
  AddressInfo.Add(S);
end;

procedure AddBookToStringList(abook : string; AString : TstringList);
var l : TStringList;
    x, I1: Integer;
    S1, S2, S3, S4, S5, S6, S7: string;
begin
 { if Assigned(Astring) then
  begin
    l := TStringList.Create;
    try
      if Pos(abook, '.ssf') = 0 then
        abook := abook + '.ssf';
      l.LoadFromFile(sAddressBookFolder + abook);
      // Skip the 'header'.
      for x := 1 to l.Count - 1 do
      begin
        FromAddressFormat(l.Strings[x], I1, S1, S2, S3, S4, S5, S6, S7);
        if S3 <> '' then
          AString.Add('<' + S3 + '>');
      end;
    finally
      l.Free;
    end;
  end;}
end;

procedure FromOldAddressFormat(S: string; var I1: Integer; var S1, S2,
  S3, S4, S5: string);
var
  I: Integer;
begin
  I := Pos(',', S);
  I1 := 0;
  try
    I1 := StrToInt(Copy(S, 1, I - 1));
  except end;
  Delete(S, 1, I);

  I := Pos(',', S);
  S1 := Copy(S, 1, I - 1);
  Delete(S, 1, I);

  I := Pos(',', S);
  S2 := Copy(S, 1, I - 1);
  Delete(S, 1, I);

  I := Pos(',', S);
  S3 := Copy(S, 1, I - 1);
  Delete(S, 1, I);

  I := Pos(',', S);
  S4 := Copy(S, 1, I - 1);
  Delete(S, 1, I);

  S5 := S;
end;


procedure SetPXTreeNodeName(Node: TTreeNode);
var
  SearchRec: TSearchRec;
  Found, UnreadCount, WholeCount, QueueCount: Integer; //AH11 QueueCount
  Dir, Name: string;
  B, isQFolder: Boolean; //AH11 isQFolder added
  p: integer;
begin

  if Node = nil then Exit;
  isQFolder := False; //AH11
  if Node.StateIndex = tnAccounts then Exit;

  if Node.StateIndex = tnAccount then begin
    Dir := PAccountData(Node.Data)^.Path;
    Name := PAccountData(Node.Data)^.Name;
  end;

  if Node.StateIndex = tnFolder then begin
    Dir := PFolderData(Node.Data)^.Path;
    Name := PFolderData(Node.Data)^.Name;
    if PFolderData(Node.Data)^.Outbox or PFolderData(Node.Data)^.Drafts then
      isQFolder := True;
  end;

  if Node.StateIndex = tnThrashBag then begin
    Dir := sTrashFolder;
    Name := Node.Text;
  end;

  if Node.StateIndex = tnRepository then begin
    Dir := sRepositoryFolder;
    Name := Node.Text;
  end;
  //AH03
  if Node.StateIndex = tnStationary then begin
    Dir := sStationaryFolder;
    Name := Node.Text;
  end;
  //AH03
  Screen.Cursor := crHourGlass;
  UnreadCount := 0;
  WholeCount := 0;
  QueueCount := 0;
  Found := FindFirst(Dir + '*.MSG', faAnyFile, SearchRec);
  if Found = 0 then begin
    while Found = 0 do begin
      if ((SearchRec.Attr and faArchive) = 0) then
        Inc(UnreadCount);
      if Pos('+', SearchRec.Name) > 0 then //AH11 Added
        Inc(QueueCount);
      Inc(WholeCount);
      Found := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
  end;

  B := False;

  p := Pos(' (', Name);
  if p > 0 then Name := Copy(Name, 1, p - 1);
  //GOTO -oMjg:counts of read /unread/queue/unqueue
  if bShowCntInBrackets then begin
    if (UnreadCount > 0) or (WholeCount > 0) or (QueueCount > 0) then //AH11
    begin
      // AH11 Check if Node = draft or Outbox...
      if isQFolder then
        Node.Text := Name //+ ' (' + IntToStr(QueueCount) + '/' + IntToStr(WholeCount) + ')'
      else
        Node.Text := Name ;//+ ' (' + IntToStr(UnreadCount) + '/' + IntToStr(WholeCount) + ')';
      B := True;
    end;
  end
  else begin
    if (UnreadCount > 0) or (QueueCount > 0) then //AH11
    begin
      if isQFolder then
        Node.Text := Name //+ ' (' + IntToStr(QueueCount) + ')'
      else
        Node.Text := Name ;//+ ' (' + IntToStr(UnreadCount) + ')';
      B := True;
    end;
  end;


  if B = False then
  begin
    Node.Text := Name;
  end;

  // AH09 -- Jeez: what a mess above!
  // AH14 Update here too..
  // AH16 When mail moves to account folder extra check...
  Node.OverlayIndex := (Ord(UnreadCount > 0)) - 1;
  if (Pos(LowerCase(sDefaultAccount), LowerCase(Node.Text)) = 1) and
  (sDefaultAccount <> '')  then
  begin
    // AH16 ---
    Node.OverlayIndex := 1;
  end;
  // AH09

  Screen.Cursor := crDefault;
end;

function GetPXTreeNodeName(Node: TTreeNode): string;
begin
  if Node = nil then
    Exit;
  if Node.StateIndex = tnAccount then
    Result := PAccountData(Node.Data)^.Name
  else if Node.StateIndex = tnFolder then
    Result := PFolderData(Node.Data)^.Name
  else if Node.StateIndex = tnThrashBag then
    Result := sTrashBagCaption
  else if Node.StateIndex = tnAccounts then
    Result := Node.Text
  else if Node.StateIndex = tnRepository then
    Result := sRepositoryCaption
  else if Node.StateIndex = tnStationary then    // AH03
    Result := sStationaryCaption;
end;


function GetCommataStringReceiver: string;
var
  S, S1, S2, S3: string;
begin
  S1 := StringListToCommataString(CurrentEMail.ToReceiver, False);
  S2 := StringListToCommataString(CurrentEMail.CC, False);
  S3 := StringListToCommataString(CurrentEMail.BCC, False);
  S := '';
  if S1 <> '' then
    S := S1;
  if S2 <> '' then
    if S = '' then
      S := S2
    else
      S := S + ', ' + S2;
  if S3 <> '' then
    if S = '' then
      S := S3
    else
      S := S + ', ' + S3;
  Result := S;
end;

function SoftLineBreak(S: string; Quoted : Boolean): string;
var
  I, E, C: Integer;
  B: Boolean;
  QuoteChar: string;
  qlength: integer;

  function IsNotAlreadyQuoted: Boolean;
  begin
    if Length(S) >= qlength then
      Result := CompareStr(Copy(S, 1, qlength), QuoteChar) > 0
    else Result := true;
  end;

begin
  Result := #13#10 + '*** SMAIL Error: Lines have been cut off! ***' +
    #13#10;
  QuoteChar := GetMessageString(92);
  qlength := Length(QuoteChar);
  C := iLineBreakAt;
  try
    I := C;

    if Quoted and IsNotAlreadyQuoted then
    begin
        S := QuoteChar + S;
    end;
      //while text longer than 76
    while Length(S) > I do begin
      B := False;
      //Search space char
      for E := I downto (I - C + 2) do begin
        if Ord(S[E]) <= 32 then begin
          I := E + 1;
          B := True;
          Break;
        end;
      end;
      //found space char
      if B then begin
        if Quoted then begin
          Insert(CrLf + QuoteChar, S, I);
          Inc(I, C + 1);
        end
        else begin
          Insert(CrLf, S, I);
          Inc(I, C + 1);
        end;
      end
      else begin
        if Quoted then begin
          Insert(CrLf + QuoteChar, S, I + 1);
          Inc(I, C + 1);
        end
        else begin
          Insert(CrLf + #32, S, I + 1);
          Inc(I, C + 1);
        end; { if }
      end; { if }
    end; { while }
    Result := S;
  except
  end;
end;

procedure AttachFileToTextfile(var F: Text; Filename: string; Format: Byte);
const
   L = 57;
var
  S: string;
  I, E, K: Integer;
  FF: file;
begin
  SetFileAttr(Filename, False, True, False, False);
  //Quoted printable
  if Format = 0 then begin
    AssignFile(FT, Filename);
    Reset(FT);
    while not EoF(FT) do begin
      ReadLn(FT, S);
            // AH01 S := SoftLineBreak(ToQuotedPrintable(S), False);
      S := ToQuotedPrintable(s);
      WriteLn(F, S);
    end;
    CloseFile(FT);
  end;
  //Base64
  if Format = 1 then begin
    AssignFile(FF, Filename);
    Reset(FF, 1);
    E := Trunc(FileSize(FF) / L);
    K := FileSize(FF) - (E * L);
    SetLength(S, L);
    for I := 1 to E do begin
      BlockRead(FF, S[1], L);
      WriteLn(F, StringToBase64(S));
    end;
    if K > 0 then begin
      SetLength(S, K);
      BlockRead(FF, S[1], K);
      WriteLn(F, StringToBase64(S));
    end;
    CloseFile(FF);
  end;
end;


function BreakString(S: string; wrapcol : integer = -1): string;
const
  TB = #9;
  LF = #10;
  CR = #13;
  SP = #32;
var
  I: Integer;
  bSplit: boolean;
begin
  // AHRJ05, BreakString breaks at iLineBreakAt by default: so when breaking
  // headers, make sure to add the second parameter (standard = 78...,
  // See compileMsgTODisk)
  if wrapcol = -1 then
    wrapcol := iLineBreakAt;

  if length(s) > wrapcol then begin

    Result := '';
    while length(s) > wrapcol do begin
      // look for space preceding wrap column
      i := wrapcol;
      // DB17 range violation.
      while i > 0 do
      begin
        case s[i] of
        SP :
          begin
            dec(i);
            break;
          end;
        TB :
          begin
            dec(i);
            break;
          end;
        '<', '[', '(' :
          begin
            dec(i);
          end;
        '>', ']', ')' :
          begin
            break;
          end;
        ',', ':', ';' :
          begin
            // the comma could be the last character: if so, continue
            // breaking off...
            if (i + 1 < length(s)) then
            begin
              inc(i);
              break;
            end
            else
            begin
              dec(i);
            end;
          end;
        else
          dec(i);
        end;
      end;

      // if space not found, use wrap column (ie, split line)
      bSplit := false;
      if i = 0 then begin
        i := wrapcol;
        bSplit := true;
      end;

      // if not first chunk, add newline
      if length(Result) > 0 then
        Result := Result + CR + LF + SP;
      // AHRJ05 -- Added CR+LF+TB
      if bSplit then begin
        Result := Result + copy(s, 1, i);
        s := copy(s, succ(i), length(s));
      end
      else begin
        Result := Result + copy(s, 1, i);
        s := copy(s, succ(i), length(s));
      end;

    end;
    //AHRJ05 -- Correction...
    if length( Result ) > 0 then
      Result := Result + CR + LF + SP;
    Result := Result + s;

  end
  else
    Result := s;
end;

function NewBreakStringD(S: String; wrapcol : integer; aPrefix : string): String;
var stack, otxt : TStringList;
    c, curpos : integer;
    para, curPrefix, thisline : string;
    abreak : boolean; //AHRK33

    function CheckPrefix(s : string; var p : integer) : string;
    var mode : (preNone, preQuote, preEnd);
    begin
      result := aPrefix;
      p := length(s) + 1; // AH16.... RTFM
      if length(s) = 0 then
        exit;

      p := 1;
      mode := preNone;
      while mode <> preEnd do
      begin

        if p = length(s) then
        begin
          p := 1;
          result := aprefix;
          break;
        end;

        case s[p] of
          ' ' :
          begin
            case mode of
              preNone, preQuote :
              begin
                inc(p);
              end;
            end;
          end;
        else
          if s[p] in AlphaNumCharsQ then
          begin
            Mode := preQuote;
            result := result + s[p];
            inc(p);
          end
          else
          begin
            case mode of
              preNone :
              begin
                p := 1;
                result := aprefix;
              end;
            end;
            mode := preEnd;
          end;
        end;
      end;
    end;

    function WWrap(St : string; max : integer; prefix : string):string;
    var t, margin : integer;
        ps : string;
        breakmode : (psNone, psHard, psSoft);
    begin
      result := '';
      margin := max;
      while length(st) > 0 do
      begin
        t := pos(#15, st);

        if (t > 0) and (t <= max) then
          breakMode := psHard
        else
          breakMode := psSoft;

        case breakMode of
          psHard :
          begin
            Result := result + prefix + copy(st, 1, t -1) + #13#10;
            Delete(st, 1, t);
          end;
          psSoft :
          begin
            // DBRK06 -- check length...
            if margin > Length(st) then margin := length(st);
            while (margin > 0) do
            begin
              if (st[margin] <> #32) then
                dec(margin)
              else
                break; // break this loop...
            end;
            // if margin = 0 then break at the max...
            if margin = 0 then
            begin
              // No CR+LF, split line at max (minus cursor).
              margin := max;
            end;
            // actually break....
            ps := copy(st, 1, margin);
            result := result + prefix + ps + #14;
            Delete(st, 1, margin);
            margin := max;
          end;
        end;
        application.ProcessMessages;
      end; // End while
      // clean up the softbreaks...
      Result := StringReplace(result, #14, #13#10, [rfReplaceAll]);
    end;
begin
  Result := '';
  Abreak := False; // AHRK33  
  if s = '' then
  begin
    exit;
  end;
  otxt := TStringList.Create;
  stack := TStringList.Create;
  stack.Add('>');

  otxt.Text := s;
  c := 0;
  while c < otxt.Count do
  begin
    curprefix := (CheckPrefix(otxt.Strings[c], curpos));
    thisline := TrimRight(Copy(otxt.strings[c], curpos,
      length(otxt.strings[c])));
    // AHRK33
    if length(thisline) < wrapcol - length(Stack.Strings[stack.count -1]) then
    begin
      if abreak then
      begin
        thisline := ' ' + thisline +#15;
        abreak := false;
      end
      else
      begin
        thisline := thisline +#15;
        abreak := false;
      end;
    end
    else
    begin
      if abreak then
      begin
        thisline := ' ' + thisline;
        abreak := False;
      end
      else
      begin
        abreak := True;
      end;
    end;
    // AHRK33

    if curprefix = Stack.Strings[stack.count -1] then
    begin
      para := para + thisline;
    end
    else
    begin
      para :=  wWrap(para, wrapcol - length(Stack.Strings[stack.count -1]),
        Stack.strings[stack.count -1]);
      result := result + para;
      Stack.Delete(stack.count -1);
      Stack.Add(curPrefix);
      para := thisline;
    end;
    Application.ProcessMessages;
    inc(c);
  end;

  if stack.Count > 0 then
  begin
    para := wWrap(para, wrapcol - length(Stack.Strings[stack.count -1]),
      Stack.strings[stack.count -1]);
    result := result + para;
  end;
  otxt.Free;
  stack.Free;
end;

function NewBreakStringE(S : string; wrapcol : integer; aprefix : string) : string;
var i, h, hEnd,
    numbers_of_chars_on_line, quoteindex : integer;
    oldprefix, quoteprefix, quoted, here : string;
    firsttime : boolean;
    procedure  copy_and_wrap_with_paragraph_fill;
    var  h_bol, quotelen, i : integer;
	quitloop : boolean;
    begin
      quitloop := False;
      quotelen := length(quoteprefix);
      i := 1;
      if quoteprefix = oldprefix then
      begin
        numbers_of_chars_on_line := 0;
      end;

      if (not firsttime) and (numbers_of_chars_on_line = 0) then
      begin
        // Put carriage return after last line.
        quoted := quoted + #13#10;
        inc(quoteindex);  inc(quoteindex);
      end;
      firsttime := false;

      if (here[h] <> #10) and  (h < hEnd) then
      begin
        // Add prefix...
        if (numbers_of_chars_on_line = 0) then
        begin
          while i <= quotelen do
          begin
            quoted := quoted + quoteprefix[i];
            inc(i); inc(quoteindex);
          end;
        end;
        oldprefix := quoteprefix;
        numbers_of_chars_on_line := numbers_of_chars_on_line + i -1;
        quoteindex := quoteindex -1;

        h_bol := h;

        while ((here[h] <> #13) and (h < hEnd) and (not quitLoop)) do
        begin
          quoted := quoted + here[h];
          inc(h);
          inc(quoteindex);
          inc(numbers_of_chars_on_line);
          if ((numbers_of_chars_on_line >= wrapcol) and (here[h] <> #13)) then
          begin
            while ((numbers_of_chars_on_line > quotelen)  and (h > h_bol)
            and (not (here[h] in [' ', '-', #13, #10]))) do
            begin
              // Delete(quoted, quoteindex, 1); // Delete...
              Delete(quoted, length(quoted), 1);
              dec(quoteindex);
              dec(numbers_of_chars_on_line);
              dec(h);
            end;
            dec(numbers_of_chars_on_line);

            if (numbers_of_chars_on_line <= quotelen) then
            begin
              while (numbers_of_chars_on_line < wrapcol) do
              begin
                quoted := quoted + here[h];
                inc(h);
                inc(quoteindex);
                inc(numbers_of_chars_on_line);
              end;
            end;

            numbers_of_chars_on_line := 0;

            while (here[h] = ' ') do
            begin
              inc(h);
            end;

            if here[h] = #13 then
            begin
              quoted := quoted + #13#10;
              inc(quoteindex);inc(quoteindex);
            end
            else
              copy_and_wrap_with_paragraph_fill;

            quitloop := true;
          end;
        end;

      end
      else
      begin
        if numbers_of_chars_on_line <> 0 then
        begin
          quoted := quoted + #13#10;
          inc(quoteindex); inc(quoteindex);
        end;

        i := 1;
        while i <= quotelen do
        begin
          quoted := quoted + quoteprefix[i];
          inc(i); inc(quoteindex);
        end;

        if here[h + 1] = #10 then
        begin
          Delete(quoted, length(quoted), 1);
          dec(quoteindex);
          inc(h);
        end;

        if (h + 1) >= hEnd then
        begin
          quoted := quoted + #13#10;
          inc(h);inc(h);
          inc(quoteindex); inc(quoteindex);
        end;

        numbers_of_chars_on_line := 0;
        quitloop := true;
      end;

      if not quitloop then
      begin
        quoted := quoted + ' ';
        inc(quoteindex);
        if quoted[quoteindex - 1] <> ' ' then
        begin
          inc(quoteindex); inc(numbers_of_chars_on_line);
        end;
        inc(h);
        if here[h] = #10 then
        begin
          Delete(quoted, length(quoted), 1);
          dec(quoteindex);
          inc(h);
          numbers_of_chars_on_line := 0; //AHDB1
        end;
      end;
    end;
begin
  firsttime := True;
  numbers_of_chars_on_line := 0;
  hEnd := length(s);
  quoteindex := 1;
  here := s;
  h := 1;
  while (h < hEnd) do
  begin
    //    quoteprefix := aprefix;
    i := 1;
    quoteprefix := '';
    while ( (h <= hEnd) and (i <= 10) and (here[h] in AlphaNumCharsQ)) do
    begin
      quoteprefix := quoteprefix + here[h];
      inc(h); inc(i);
    end;
    quoteprefix := aprefix + quoteprefix;
    copy_and_wrap_with_paragraph_fill;
  end;
  result := quoted;
end;

function NewBreakString(s : string; wrapcol : integer; sPrefix : string) : string;
const
  LF = #10;
  CR = #13;
  SP = #32;
var p,  t : integer;
    apstr : string;
    csp : integer;
    function BackToLastSpace(m : string; ll : integer) : integer;
    begin
      result := ll;
      while (ll > 0) do
      begin
        if m[ll] = SP then
        begin
          result := ll -1;
          exit;
        end;
        dec(ll);
      end;
    end;
begin
  // Do not call this function after a message has already been quoted!
  Result := '';
  p := length(s);
  while p > 0 do
  begin
    t := 1;
    csp := 0;
    // Find a CR/LF combination
    while t < (wrapcol - Length(sPrefix)) do
    begin
      if (s[t] = CR) and (s[t +1] = LF) then
      begin
        apstr := sPrefix + copy(s, 1, t + 1);
        Delete(s, 1, t + 1);
        break;
      end;

      if s[t] = SP then
        inc(csp);
      inc(t);
    end;
    // there was no CR/LF combination, now just split the sentence
    if t = (wrapcol - length(sPrefix)) then
    begin
      if csp > 2 then
      begin
        t := BackToLastSpace(s, t);
      end;
      apstr := sPrefix  + copy(s, 1, t) + CR + LF;
      Delete(s, 1, t);
    end;
    result := result + apstr;
    p := length(s);
  end;
end;


function IsValidFileName(afilename : string) : boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 1 to Length(afileName) do
  begin
    if afileName[i] in
      [Chr(0)..Chr(31), '|', '/', '*', ':', '?', '"','<', '>', '\'] then
         Exit;
  end;
  Result := True;
end;


procedure SaveMIMEToFile(var SL: TStringList; ContentType, ContentEncoding:
  string);
var
  S, T, G, H: string;
  BL: TStringList;

  procedure DecodeTextfile;
  var
    I: Integer;
  begin
    // Textfile
    AssignFile(FT, S);
    Rewrite(FT);
    for I := 0 to SL.Count - 1 do begin
      H := SL.Strings[I];
      if (I = SL.Count - 1) and (H = '') then
        Break;
      WriteLn(FT, H);
    end;
    CloseFile(FT);
  end;

  procedure DecodeQuotedPrintable;
  var
    I: Integer;
  begin
    // Quoted-Printable Textfile
    AssignFile(FT, S);
    Rewrite(FT);
    WriteLn(FT, '    ');
    BL := TStringList.Create;
    I := 0;
    while I <= SL.Count - 1 do
    begin
      H := SL.Strings[I];
      // AHRK92
      while (H <> '') and (H[Length(H)] = '=') do
      begin
        Delete(H, Length(H), 1);
        if I < SL.Count - 1 then
        begin
          H := H + SL.Strings[I + 1];
          Inc(I);
        end;
      end;
      // AHRK92--

      //AH13/AH14: trim trailing, WriteLN takes care of the
      //      right CR+LF (UNIX -> CR only).
      H := TrimRight(FromQuotedPrintable(H));
      if (I = SL.Count - 1) and (H = '') then
        Break;
      WriteLn(FT, H);
      Inc(I);
    end;
    SL.Clear;
    SL.Assign(BL);
    BL.Free;
    CloseFile(FT);
  end;

  procedure DecodeBase64;
  var
    I: Integer;
  begin
    //BASE64 binary file
    AssignFile(FF, S);
    Rewrite(FF, 1);
    for I := 0 to SL.Count - 1 do
      if SL.Strings[I] <> '' then begin
        G := _Base64ToString(SL.Strings[i]);
        if G <> '' then
          BlockWrite(FF, G[1], Length(G));
      end;
    CloseFile(FF);
  end;

  procedure DecodeUUCoded;
  begin
    // UUCode binary file
    SL.SaveToFile(S + '.uu');
    UUDecode(S + '.uu');
    DeleteFile(S + '.uu'); // temporary file -> no conflicts
  end;

begin
  S := GetContentType('name', ContentType);
  S := SkipChar(S, '"');

  if not IsValidFilename(s) then
    s := '';

  T := LowerCase(GetContentType('', ContentEncoding));
  G := LowerCase(GetContentType('', ContentType));
  if T = '' then
    T := '7bit';
  if G = '' then
    G := 'text/plain';
  if S = '' then begin
    if not FileExists(sTempMessageFile) then begin
      // CurrentEMail.MsgType := StandardMsgType; AHRK01--Removed...
      if G = 'text/html' then begin
        CurrentEMail.MsgType := mtHtml;
        S := sTempMessageFile;
      end
      else if G = 'text/plain' then begin
        CurrentEMail.MsgType := mtText;
        S := sTempMessageFile;
      end
      else if G = 'text/richtext' then begin
        CurrentEMail.MsgType := mtRich;
        S := sTempMessageFile;
      end
      // AHRK04
      // Warning: MsgType is set for the complete e-mail:
      // the good news is that (while we set the MsgType here),
      // that PGP/MIMEd messages always need a 'version' mime part.
      // That version part (caught here) tells us that we (indeed)
      // have a PGP-ed message.
      else if G = 'application/pgp-encrypted' then
      begin
        CurrentEmail.MsgType := mtEncrypted;
        S := GetMimeFileName(sTemporaryFolder, G);
      end
      // AHRK04
      else
        S := GetMIMEFilename(sTemporaryFolder, G);
    end
    else
      S := GetMIMEFilename(sTemporaryFolder, G);
  end
  else
    S := sTemporaryFolder + S;

  // Decode files
  if (T = '7bit') or (T = '8bit') or (T = 'binary') then   // Bugfix was 'Binary'
    //Text file
    DecodeTextfile
  else if T = 'quoted-printable' then
    //Quoted-printable text file
    DecodeQuotedPrintable
  else if T = 'base64' then
    //BASE64 binary file
    DecodeBase64
  else if T = 'x-uuencode' then
    // UUCode binary file
    DecodeUUCoded;
end;

procedure GetMIMEType(Filename: string; var Content, Encoding: string; var
  Format: Byte);
var
  S: string;
begin
  // AH16-- application.jpg -> Image/JPG
  S := ExtractFileExt(ExtractFilename(Filename)); { tf - columnarized }
  if S = '.txt' then begin Content := 'text/txt; charset=GB2312'; Encoding := 'Quoted-printable'; Format := 0; end else
    if S = '.rtf' then begin Content := 'text/rtf; charset=GB2312'; Encoding := 'Quoted-printable'; Format := 0; end else
      if S = '.htm' then begin Content := 'text/htm; charset=GB2312'; Encoding := 'Quoted-printable'; Format := 0; end else
        if S = '.html' then begin Content := 'text/html'; Encoding := 'BASE64'; Format := 1; end else
          if S = '.pdf' then begin Content := 'application/pdf'; Encoding := 'BASE64'; Format := 1; end else
            if S = '.zip' then begin Content := 'application/zip'; Encoding := 'BASE64'; Format := 1; end else
              if S = '.doc' then begin Content := 'application/msword'; Encoding := 'BASE64'; Format := 1; end else
                if S = '.bmp' then begin Content := 'application/x-bmp'; Encoding := 'BASE64'; Format := 1; end else
                  if S = '.jpg' then begin Content := 'image/jpeg'; Encoding := 'BASE64'; Format := 1; end else
                    if S = '.jpeg' then begin Content := 'image/jpeg'; Encoding := 'BASE64'; Format := 1; end else
                      if S = '.gif' then begin Content := 'image/gif'; Encoding := 'BASE64'; Format := 1; end else
                        if S = '.ief' then begin Content := 'image/ief'; Encoding := 'BASE64'; Format := 1; end else
                          if S = '.tif' then begin Content := 'image/tiff'; Encoding := 'BASE64'; Format := 1; end else
                            if S = '.tiff' then begin Content := 'image/tiff'; Encoding := 'BASE64'; Format := 1; end else
                              if S = '.mov' then begin Content := 'video/quicktime'; Encoding := 'BASE64'; Format := 1; end
                              else begin Content := 'application/octet-stream'; Encoding := 'BASE64'; Format := 1; end;
  Content := Content + '; Name=' + ExtractFilename(Filename);
end;

function GetMIMEFilename(Dir, ContentType: string): string;
var
  I: Integer;
  S: string;
begin
  S := LowerCase(GetContentType('', ContentType));
  if S = 'text/plain' then S := 'txt' else { tf - columnarized }
  if S = 'text/richtext' then S := 'rtf' else
  if S = 'text/html' then S := 'htm' else
  if S = 'message/rfc822' then S := 'msg' else
  if S = 'message/partial' then S := 'txt' else
  if S = 'message/external-body' then S := 'txt' else
  if S = 'message/news' then S := 'msg' else
  if S = 'application/rtf' then S := 'rtf' else
  if S = 'application/pdf' then S := 'pdf' else
  if S = 'application/zip' then S := 'zip' else
  if S = 'application/msword' then S := 'doc' else
  if S = 'application/x-bmp' then S := 'bmp' else
  if S = 'image/jpeg' then S := 'jpg' else
  if S = 'image/gif' then S := 'gif' else
  if S = 'image/ief' then S := 'ief' else
  if S = 'image/tiff' then S := 'tif' else
  if S = 'video/mpeg' then S := 'mpg' else
  if S = 'video/quicktime' then S := 'mov' else
  if S = 'multipart/parallel' then S := 'txt' else
  if S = 'multipart/alternative' then S := 'txt' else
  // AHRK04 PGP-Version part. Using latest known MsgType here: bah, I hate
  // globals... Must see if I can correct this after.
  if S = 'application/pgp-encrypted' then s := 'ver' else
  if (S = 'application/octet-stream') and (CurrentEmail.MsgType = mtEncrypted)
  then s := 'pgp'
  else
     S := 'bin';
  I := 0;
  while FileExists(Dir + 'Noname' + IntToStr(I) + '.' + S) do
    Inc(I);
  Result := Dir + 'Noname' + IntToStr(I) + '.' + S;
end;

function GetMIMEHeaderField(Field: string): string;
var
  I, E: Integer;
  S1, S2, S3: string;
begin
  Result := '';
  S3 := Field;
  try
    while Pos('=?', Field) > 0 do begin
      //Find =?
      I := Pos('=?', Field);
      Result := Result + Copy(Field, 1, I - 1);
      Delete(Field, 1, I + 1);
      //find ?Q?
      I := Pos('?', Field);
      S1 := Field[I + 1];
      Delete(Field, 1, I + 2);
      //find ?=
      I := Pos('?=', Field);
      S2 := Copy(Field, 1, I - 1);
      Delete(Field, 1, I + 1);
      //encode
      if UpperCase(S1) = 'Q' then begin
        S2 := FromQuotedPrintable(S2);
        for E := 1 to Length(S2) do
          if S2[E] = '_' then
            S2[E] := ' ';
      end
      else begin
        S2 := Base64ToString(S2);
      end;
      Result := Result + S2;
    end;
    Result := Result + Field;
  except
    Result := S3;
  end;
end;

function SetMIMEHeaderField(Field: string): string;
var
  I: Integer;
  S1, S2: string;
  B: Boolean;
begin
  Result := Field;
  B := False;
  for I := 1 to Length(Field) do
    if Ord(Field[I]) > 127 then
      B := True;
  if B then begin
    I := Pos('<', Field);
    S2 := '';
    S1 := '';
    if I > 0 then begin
      S1 := Copy(Field, 1, I - 1);
      S2 := Copy(Field, I, Length(Field) - I + 1);
    end
    else
      S1 := Field;
    Result := '=?GB2312?Q?' + ToQuotedPrintable(S1) + '?=' + S2;
  end;
end;

function FromQuotedPrintable(S: string): string;
var
  I, E: Integer;
begin
  I := 1;
  Result := '';
  while I <= Length(S) do begin
    if (S[I] = '=') and (I < Length(S) - 1) then begin
      E := HexToInt(S[I + 1] + S[I + 2]);
      Inc(I, 3);
      Result := Result + Chr(E);
    end
    else begin
      Result := Result + S[I];
      Inc(I);
    end;
  end;
end;

function ToQuotedPrintable(S: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
    if (Ord(S[I]) > 127) or (S[I] = '?') or (S[I] = '=') then
      Result := Result + '=' + IntToHex(Ord(S[I]), 2)
    else
      Result := Result + S[I];
end;

procedure GetFieldArguments(S: string; var S1, S2: string);
var
  E: Integer;
begin
  // parse line in S1 and S2 and the ':' between them
  E := Pos(':', S);
  S1 := Copy(S, 0, E - 1);
  while (Length(S1) > 0) and (S1[1] = ' ') do
    Delete(S1, 1, 1);
  S2 := Copy(S, E + 1, Length(S) - E);
  while (Length(S2) > 0) and (S2[1] = ' ') do
    Delete(S2, 1, 1);
  S2 := GetMIMEHeaderField(S2);
end;

procedure MakeFields(var SL: TStringList; ClearEmpties: Boolean);
var
  H: TStringList;
  I, E: Integer;
  S: string;
begin
  H := TStringList.Create;
  I := -1;
  for E := 0 to SL.Count - 1 do begin
    S := SL.Strings[E];
    if ClearEmpties = True then begin
      if S <> '' then begin // if not empty line
        if S[1] in [#32, #9] then begin // if Tab or Space
          Delete(S, 1, 1); // manual linebreak
          if I = -1 then
            I := H.Add(''); // add to previous line
          H[I] := H[I] + S;
        end
        else // if normal line
          I := H.Add(S);
      end;
    end;
    if ClearEmpties = False then begin
      if (Length(S) > 1) and (S[1] in [#32, #9]) then begin // if Tab or Space
        Delete(S, 1, 1); // manual linebreak
        if I = -1 then
          I := H.Add(''); // add to previous line
        H[I] := H[I] + S;
      end
      else // if normal line
        I := H.Add(S);
    end;
  end;
  SL.Clear;
  SL.Assign(H);
  H.Free;
end;

function GetContentType(Variable, ContentType: string): string;
var
  I: Integer;
  S: string;
begin
  Result := '';
  SkipChar(ContentType, ' ');
  I := 1;
  S := '';
  while (I <= Length(ContentType)) and (ContentType[I] <> ';') do begin
    S := S + ContentType[I];
    Inc(I);
  end;
  if Variable = '' then begin
    Result := S;
    Exit;
  end;
  I := Pos(LowerCase(Variable), LowerCase(ContentType));
  if I = 0 then
    Exit;
  Delete(ContentType, 1, I + Length(Variable));
  I := Pos(';', ContentType);
  if I = 0 then
    I := Length(ContentType) + 1;
  Result := Copy(ContentType, 1, I - 1);
end;

function SkipChar(S: string; C: Char): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
    if S[I] <> C then
      Result := Result + S[I];
end;

procedure CommataStringToStringList(S: string; var SL: TStringList);
var
  T: string;
  I: Integer;
begin
  SL.Clear;
  T := '';
  S := S + ',';
  for I := 1 to Length(S) do
    if S[I] = ',' then begin
      if Length(T) > 1 then
        while (T[1] = ' ') or (T[1] = #9) do
          Delete(T, 1, 1);
      T := GetMIMEHeaderField(T);
      if T <> '' then
        SL.Add(T);
      T := '';
    end
    else begin
      if S[I] <> '"' then
        T := T + S[I];
    end;
end;


procedure HeaderAddressToStringList(S : string; SL : TStringList);
var Emailmode : (emNone, emDescription, emEmail, emNext, emEnd);
    p : integer;
    mailthing : string;
begin
  if s = '' then exit;

  mailthing := '';
  p := 1;
  Emailmode := emNone;
  while Emailmode <> emEnd do
  begin
     case s[p] of
    '@' :
      begin
        EmailMode := emEMail;
        mailthing := mailthing + s[p];
      end;
    '<' :
      begin
        EmailMode := emEMail;
        mailthing := mailthing + s[p];
      end;
    '"', '''' :
      begin
        EmailMode := emDescription;
        mailthing := mailthing + s[p];
      end;
    ',' :
        case EmailMode of
          emEMail :
            begin
              MailThing := Trim(MailThing);
              if MailThing <> '' then
                SL.Add(MailThing);
              MailThing := '';
              EmailMode := emNone;
            end;
          emDescription :
            begin
              MailThing := MailThing + s[p];
            end;
          emNone :
            begin
              MailThing := '';
            end;
          else
            // Do regular stuff...
            MailThing := Mailthing + s[p];
        end;
    '>' :
        case EmailMode of
          emEmail :
            begin
              MailThing := Mailthing + s[p];
              MailThing := Trim(MailThing);
              if MailThing <> '' then
                SL.Add(MailThing);
              EmailMode := emNone;
              MailThing := '';
            end;
        else
          MailThing := MailThing + s[p]
        end
    else
      case emailMode of
        emNone : eMailMode := emDescription;
      end;
      MailThing := MailThing + s[p];
    end;

    if p >= length(s) then
    begin
      // LeftOver, Add it anyways in any mode.
      MailThing := Trim(MailThing);
      if MailThing <> '' then
         SL.Add(MailThing);
      MailThing := '';
      EmailMode := emEnd;
    end;
    inc(p);
  end;
end;

function StringListToCommataString(SL: TStringList; Decoded: Boolean): string;
var
  S: string;
  I, E: Integer;
begin
  S := '';
  E := 0;
  for I := 0 to SL.Count - 1 do
    if SL.Strings[I] <> '' then begin
      if Decoded then
        SL.Strings[I] := SetMIMEHeaderField(SL.Strings[I]);
      if E = 0 then
        S := S + SL.Strings[I]
      else
        S := S + ', ' + SL.Strings[I];
      Inc(E);
    end;
  Result := S;
end;

procedure SkipSpaces(var S: string);
begin
  while (Length(S) > 1) and ((S[1] = #32) or (S[1] = #9)) do
    Delete(S, 1, 1);
end;

function GetToken(var S: string): string;
var
  I: Integer;
begin
  SkipSpaces(S);
  Result := '';
  I := 1;
  while (I <= Length(S)) and (S[I] <> #32) and (S[I] <> #9) do begin
    Result := Result + S[I];
    Inc(I);
  end;
  Delete(S, 1, I - 1);
end;

function ApplyFilter(Msg, Filter: string; var Points: Integer): Boolean;
var
  SL: TStringList;
  S, LMsg: string;
  C: Char;
  I: Integer;
  B: Boolean;

  {   1 = normal
      2 = plus
      3 = minus
      4 = normal quoted
      5 = plus quoted
      6 = minus quoted     }

  function ExtractQuoted(var S: string): Boolean;
  begin
    Result := False;
    if S[1] = '"' then begin
      Delete(S, 1, 1);
      Filter := S + Filter;
      S := '';
      I := 1;
      while (I <= Length(Filter)) and (Filter[I] <> '"') do begin
        S := S + Filter[I];
        Inc(I);
      end;
      Delete(Filter, 1, I);
      Result := True;
    end;
  end;

begin
  Points := 0;
  if Filter = '' then begin
    Result := True;
    Exit;
  end;
  SL := TStringList.Create;
  S := GetToken(Filter);
  while S <> '' do begin
    if S[1] = '+' then begin
      Delete(S, 1, 1);
      if ExtractQuoted(S) then
        SL.Add('5' + S)
      else
        SL.Add(LowerCase('2' + S));
    end else
    if S[1] = '-' then begin
      Delete(S, 1, 1);
      if ExtractQuoted(S) then
        SL.Add('6' + S)
      else
        SL.Add(LowerCase('3' + S));
    end
    else
    begin
      if ExtractQuoted(S) then
        SL.Add('4' + S)
      else
        SL.Add(LowerCase('1' + S));
    end;
    S := GetToken(Filter);
  end;

  LMsg := LowerCase(Msg);
  B := True;
  Points := 0;
  for I := 0 to SL.Count - 1 do begin
    S := SL.Strings[I];
    C := S[1];
    Delete(S, 1, 1);
    if C = '1' then
      if Pos(S, LMsg) > 0 then
        Inc(Points);
    if C = '2' then
      if Pos(S, LMsg) = 0 then
        B := False
      else
        Inc(Points);
    if C = '3' then
      if Pos(S, LMsg) > 0 then
        B := False
      else
        Inc(Points);
    if C = '4' then
      if Pos(S, Msg) > 0 then
        Inc(Points);
    if C = '5' then
      if Pos(S, Msg) = 0 then
        B := False
      else
        Inc(Points);
    if C = '6' then
      if Pos(S, Msg) > 0 then
        B := False
      else
        Inc(Points);
  end;

  if B = False then
    Points := -1;
  Result := B;
  SL.Free;
end;

function GetUniqueMailName: string;
var
  Ho, Mi, Se, Ms: Word;
begin
  DecodeTime(Time, Ho, Mi, Se, Ms);
  Result := Chr(Random(26) + 97) + Chr(Random(26) + 97) +
    IntToStr(Mi) + IntToStr(Se) + IntToStr(Random(100));
end;

function ExtractEMailAddress(S: string): string;
var
  I, E: Integer;
begin
  Result := S;
  // AHRK13 ---
  i := pos(Uppercase('mailto:'), Uppercase(S));
  if i > 1 then
  begin
    Delete(s, i, length('mailto:'));
  end;
  I := Pos('<', S);
  E := Pos('>', S);
  if (I = 0) or (E = 0) then
    Exit;
  Result := Copy(S, I + 1, E - I - 1);
end;

function ExtractEMailName(S: string): string;
var
  I, E: Integer;
begin
  Result := '';
  I := Pos(' <', S); // firstname lastname <email@address> (default)
  if I = 0 then
    I := Pos('<', S); // firstname lastname<email@address>
  E := Pos('>', S);
  if (I = 0) or (E = 0) then
    Exit;
  Result := Copy(S, 1, I - 1);
end;

procedure GetOutcomingMailFileList(Node: TTreeNode; var SL: TStringList);

  procedure GetFiles(Dir: string);
  var
    SearchRec: TSearchRec;
    Found: Integer;
  begin
    Found := FindFirst(Dir + '*.msg', faAnyFile, SearchRec);
    while Found = 0 do begin
      SL.Add(Dir + SearchRec.Name);
      Found := FindNext(SearchRec);
    end;
    FindClose(SearchRec);
  end;

  procedure GetSubNotes(Node: TTreeNode);
  var
    I: Integer;
  begin
    for I := 0 to Node.Count - 1 do begin
      if PFolderData(Node.Item[I].Data)^.OutBox then
        GetFiles(PFolderData(Node.Item[I].Data)^.Path);
      if Node.Count > 0 then
        GetSubNotes(Node.Item[I]);
    end;
  end;

begin
  GetSubNotes(Node);
end;

function StretchString(S: string; Count: Integer): string;
begin
  Result := S;
  while Length(Result) < Count do
    Result := Result + ' ';
end;

procedure ParseMailto(const AIn: string; var AAddress, ASubject, ABody: string);
var
  p1, p2: integer;
  sTmp, nTmp: string;
begin
  sTmp := LowerCase(AIn);
  nTmp := AIn; //NormalCase!
  if Pos('mailto:', sTmp) > 0 then
    Delete(sTmp, 1, 7);
  p1 := Pos('?subject=', sTmp);
  p2 := Pos('&body=', sTmp);
  if p1 = 0 then //no subject, no body
  begin
    AAddress := Trim(Copy(sTmp, 1, Length(sTmp))); //LowerCase
    ASubject := '';
    ABody := '';
    exit;
  end;
  if p1 <> 0 then //with subject
  begin
    if p2 = 0 then //but without body
    begin
      Delete(nTmp, 1, 7); //cutoff mailto: from Normalcase
      AAddress := Trim(Copy(sTmp, 1, p1 - 1)); //LowerCase
      ASubject := Copy(nTmp, p1 + Length('?subject='), Length(nTmp)); //NormalCase
      ABody := '';
    end else
    begin //and with body, too
      AAddress := Trim(Copy(sTmp, 1, p1 - 1)); //LowerCase
      Delete(nTmp, 1, 7); //cutoff mailto: from NormalCase
      Delete(sTmp, 1, p1 - 1 + Length('?subject=')); //cutoff address from LowerCase
      Delete(nTmp, 1, p1 - 1 + Length('?subject=')); //cutoff address from NormalCase
      p2 := Pos('&body=', sTmp); //where starts the body
      ASubject := Copy(nTmp, 1, p2 - 1); //NormalCase
      Delete(nTmp, 1, p2 - 1 + Length('&body='));
      ABody := nTmp;
         //Fehler(0,ABody);
    end;
  end;
end;

function GenerateBoundary : string;
begin
  // Generate a unique
  Result := '--PMRRAH--' + FormatDateTime('ddmmyyhhnnss', Now) + '-'
    + sInfoVersion;
end;

// AHRJ02
function NumberReplies(repstring : string; astring : string) : String;
var p, num : integer;
    PreRep, number : string;
    State : (mNone, mReply, mBracketOn, mBracketOff, mSemicolon,
             mCharacter, mEnd);

    procedure DoInline;
    begin
    case State of
      mNone :
      begin
        state := mEnd;
        if repstring[1] = PreRep[1] then
        begin
          if (pos(Uppercase(Prerep + ':'), UpperCase(repstring)) = 1) or
           (Pos(UpperCase(PreRep + '['), Uppercase(repstring)) = 1) then
          begin
            State := mReply;
            Delete(repstring, 1, 1);
          end
        end;
      end;
      mReply : Delete(repstring, 1, 1);
      mBracketOn :
      begin
         number := number + repstring[1];
         Delete(repstring, 1, 1);
      end
      else
        State := mEnd;
      end; // End Case Else
    end;
begin
  PreRep := astring;
  Result := Trim(astring + ' ' + repstring);

  // Get the right replystring...
  p := Pos(':', astring);
  if p > 0 then
    PreRep := Copy(astring, 1, p - 1);

  // Make sure that no processing is done if the FWD/RE/RED is empty.
  if (astring = '') or (Length(PreRep) < 2) then exit;

  num := 0;
  State := mNone;
  while State <> mEnd do
  begin
    // Go into reply state...
    if length(repstring) = 0 then
      break;

    case repstring[1] of
      '[' :
        begin
          if State = mReply then
          begin
            State := mBracketOn;
            Delete(repstring, 1, 1);
          end
          else
            State := mEnd;
      end;
      ']' :
        begin
           if State = mBracketOn then
           begin
             State := mBracketOff;
             Delete(repString, 1, 1);
           end
           else
             State := mEnd;
        end;
      ':' :
        begin
          case State of
          mBracketOff :
          begin
            State := mNone;
            Delete(repstring, 1, 1);
          end;
          mReply :
          begin
            inc(num);
            State := mNone;
            Delete(repstring, 1, 1);
          end
          else
            State := mNone;
          end;
        end;
      ' ' :
        begin
          // Just delete..
          Delete(RepString, 1, 1);
        end;
    else
      DoInline;
    end; // End Case 1...
  end;

  p := 0;
  if number <> '' then
  begin
    p := StrToIntDef(number, 0);
    inc(p);
  end;

  num := num + p;

  if num = 0 then
    Result := PreRep + ': ' + Trim(RepString)
  else
    Result := Format(PreRep + '[%s]' + ': ' + Trim(repstring), [IntToStr(num)])
end;
// AHRJ02
// AHRJ03
function IsCharsetConversionNeeded(s : string) : boolean;
var x : integer;
begin
  Result := False;
  for x := 1 to length(s) do
  begin
    if (Ord(s[x]) > 127) then
    begin
      Result := True;
      exit;
    end;
  end;
end;
// AHRJ03
end.
