unit PMmatcher;

interface

uses Windows, Messages, SysUtils, Classes;

  type TFileSpecific = record
     fsize : integer;
     clabel : byte;
  end;


  const
   csAttachments = 'Content-type: application/';

function MatchStrings(anitem : string; anaction : integer; atext : string) : boolean;
function MatchNumbers(anint : integer; anaction : integer; anumber : integer) : boolean;
function MatchDouble(adouble : double; anaction : integer; adate : double) : boolean;
function MatchAttachments(anint : integer; anaction : integer; astring : string) : boolean;
function ReFieldValue(afield : string; AStringlist : TStringlist) : string;
function GetSearchedString(anaction : integer; SL : TstringList) : string;



implementation

uses
  ParserSup;

// Match Functions, your introduction to the divine comedy of matching pairs.
function MatchStrings(anitem : string; anaction : integer; atext : string) : boolean;
var CaseSens : Boolean;
begin
  // For matching strings, like heads, bodies and other human parts, closely associated
  // with E-mails.
  Result := False;
  CaseSens := False;
  // AH16... Watch out!

  if anitem <> '' then
  begin
    CaseSens := ((anitem[1] = '"')  and (anitem[length(anitem)] = '"'))
                or
                ((anitem[1] = '''') and (anitem[length(anitem)] = ''''));
  end;

  if CaseSens then
  begin
    Delete(anitem, length(anitem), 1);
    Delete(anitem, 1, 1);
  end;

  case anaction of
  0 : begin
        // Contains....
        if CaseSens then
        begin
          if AnsiPos(anitem, atext) > 0 then Result := true;
        end
        else
        begin
          if AnsiPos(lowercase(anitem), lowercase(atext)) > 0 then
            Result := true;
        end;
      end;
  1 : begin
        // Does not contain...
        if CaseSens then
        begin
          if AnsiPos(anitem, atext) = 0 then Result := true;
        end
        else
        begin
          if AnsiPos(lowercase(anitem), lowercase(atext)) = 0 then
            Result := true;
        end;
      end;
  2 : begin
        // is...
        if CaseSens then
        begin
          if CompareStr(anitem, atext) = 0 then Result := true;
        end
        else
        begin
          if CompareText(anitem, atext) = 0 then Result := True;
        end
      end;
  3 : begin
        // is not...
        if CaseSens then
        begin
          if CompareStr(anitem, atext) <> 0 then Result := true;
        end
        else
        begin
          if CompareText(anitem, atext) <> 0 then Result := True;
        end;
      end;
  end;
end;

function MatchNumbers(anint : integer; anaction : integer; anumber : integer) : boolean;
begin
  // for matching integer sounding pairs, like labels, size and other related ho-hum things.
  Result := False;
  case anaction of
  0 : begin
        // is...
        if anint = anumber then Result := true;
      end;
  1 : begin
        // is not
        if anint <> anumber then Result := true;
      end;
  2 : begin
        // is greater
        if anumber > anint then Result := True;
      end;
  3 : begin
        // is smaller or
        if anumber < anint then Result := True;
      end;
  end;
end;

function MatchDouble(adouble : double; anaction : integer; adate : double) : boolean;
begin
  // For matching dates and other double-trouble-couples.
  Result := False;
  case anaction of
  0 : begin
        // is...
        // Make sure we get the integral part: we just want *days*, dude.
        if Int(adouble) = Int(adate) then Result := True;
      end;
  1 : begin
        // is not
        if Int(adouble) <> Int(adate) then Result := True;
      end;
  2 : begin
        // is greater or equals...
        // AAAAAAAAAAAARGH... compare *adate* with adouble...
        if Int(adate) > Int(adouble) then Result := True;
      end;
  3 : begin
        // is smaller or
        if Int(adate) < Int(adouble) then Result := True;
      end;
  end;
end;

function MatchAttachments(anint : integer; anaction : integer; astring : string) : boolean;
var ent, cnt : integer;
begin
  cnt := 0;
  ent := pos(lowercase(csAttachments), lowercase(astring));
  while ent <> 0 do
  begin
    inc(cnt);
    Delete(astring, 1, ent + length(csAttachments));
    ent := pos(lowercase(csAttachments), lowercase(astring));
  end;
  Result := MatchNumbers(anint, anaction, cnt);
end;

function ReFieldValue(afield : string; AStringlist : TStringlist) : string;
var  x : integer;
    Fld, Fldvl : string;
begin
  // This function Refields the values. Whatever that may be.
  result := '';
  for x := 0 to AstringList.count -1 do
  begin
    // AH16 Pfew, talking about bugfix <G>. Rewrite recommended.
    // (It doesn't make sense to loop through all of the text.
    // since the headers are only in the headers...
    if astringlist[x] = '' then exit;
    GetFieldArguments(astringlist[x], Fld, Fldvl);
    if CompareText(Fld, afield) = 0 then
    begin
      Result := Fldvl;
      exit;
    end;
  end;
end;

function GetSearchedString(anaction : integer; SL : TstringList) : string;
begin
  // This function finds the Searched String in the string's list and returns
  // the result as a string. Sounds difficult, but isn't. Really.
  Result := '';
  case anaction of
  0 : begin
        // anywhere
        Result := sl.text;
      end;
  1 : begin
        // Headers -- Headers are closed off with 2 CRLFs.
        Result := Copy(sl.text, 1, Pos(#13#10#13#10, sl.text));
      end;
  2 : begin
        // Body --
        Result := Trim(Copy(sl.Text, Pos(#13#10#13#10, sl.text), Length(sl.text)));
      end;
  3 : begin
        // to
        Result := RefieldValue('to', sl);
      end;
  4 : begin
        // From
        Result := RefieldValue('from', sl);
      end;
  5 : begin
        // CC
        Result := RefieldValue('cc', sl);
      end;
  6 : begin
        Result := RefieldValue('bcc', sl);
      end;
  7 : begin
        // Subject
        Result := RefieldValue('subject', sl);
      end;
  8 : begin
        // Date
        Result := RefieldValue('date', sl);
      end;
  end;
end;
// End of Functions


end.
 