mail2000.pas

Documentation included in source code (mail2000.pas).

  nPos: Integer;
  lAchou: Boolean;
  Casas: Integer;
  Temp: String;
  nOccor: Integer;

begin

  Casas := Length(Chave);
  lAchou := False;
  nPos := 0;
  nOccor := 0;

  try

    if Lista <> nil then
    begin

      while (not lAchou) and (nPos < Lista.Count) do
      begin

        Temp := Lista[nPos];

        if UpperCase(Copy(Temp, 1, Casas)) = UpperCase(Chave) then
        begin

          if nOccor = Occorrence then
          begin

            lAchou := True;
          end
          else
          begin

            Inc(nOccor);
          end;
        end;

        if not lAchou then
          Inc(nPos);
      end;
    end;

  finally

    if lAchou then
      result := nPos
    else
      result := -1;
  end;
end;

// Search lines into a string

procedure DataLine(var Data, Line: String; var nPos: Integer);
begin

  Line := '';

  while True do
  begin

    Line := Line + Data[nPos];
    Inc(nPos);

    if nPos > Length(Data) then
    begin

      nPos := -1;
      Break;
    end
    else
    begin

      if Length(Line) >= 2 then
      begin

        if (Line[Length(Line)-1] = #13) and (Line[Length(Line)] = #10) then
        begin

          Break;
        end;
      end;
    end;
  end;
end;

// Search lines into a string
// I need to do in this confusing way in order to improve performance

procedure DataLinePChar(const Data: PChar; const TotalLength: Integer; var LinePos, LineLen: Integer; var Line: PChar; var DataEnd: Boolean); assembler;
begin

  if LinePos >= 0 then
  begin

    Data[LinePos+LineLen] := #13;
    LinePos := LinePos+LineLen+2;
    LineLen := 0;
  end
  else
  begin

    LinePos := 0;
    LineLen := 0;
  end;

  while (LinePos+LineLen) < TotalLength do
  begin

    if Data[LinePos+LineLen] = #13 then
    begin

      if (LinePos+LineLen+1) < TotalLength then
      begin

        if Data[LinePos+LineLen+1] = #10 then
        begin

          Data[LinePos+LineLen] := #0;
          Line := @Data[LinePos];
          Exit;
        end;
      end;
    end;

    Inc(LineLen);
  end;

  if LinePos < TotalLength then
    Line := @Data[LinePos]
  else
    DataEnd := True;
end;

// Determine if string is a numeric IP or not (Thanks to Hou Yg [e-mail])

function IsIPAddress(const SS: String): Boolean;
var
  Loop: Integer;
  P: String;

begin

  Result := True;
  P := '';

  for Loop := 1 to Length(SS)+1 do
  begin

    if (Loop > Length(SS)) or (SS[Loop] = '.') then
    begin

      if StrToIntDef(P, -1) < 0 then
      begin

        Result := False;
        Break;
      end;

      P := '';
    end
    else
    begin

      P := P + SS[Loop];
    end;
  end;
end;

// Remove leading and trailing spaces from string
// Thanks to Yunarso Anang ([e-mail])

function TrimSpace(const S: string): string;
var
  I, L: Integer;

begin

  L := Length(S);
  I := 1;

  while (I <= L) and (S[I] = ' ') do
    Inc(I);

  if I > L then Result := '' else
  begin

    while S[L] = ' ' do
      Dec(L);

    Result := Copy(S, I, L - I + 1);
  end;
end;

// Remove left spaces from string
// Thanks to Yunarso Anang ([e-mail])

function TrimLeftSpace(const S: string): string;
var
  I, L: Integer;

begin

  L := Length(S);
  I := 1;

  while (I <= L) and (S[I] = ' ') do
    Inc(I);

  Result := Copy(S, I, Maxint);
end;

// Remove right spaces from string
// Thanks to Yunarso Anang ([e-mail])

function TrimRightSpace(const S: string): string;
var
  I: Integer;

begin

  I := Length(S);

  while (I > 0) and (S[I] = ' ') do
    Dec(I);

  Result := Copy(S, 1, I);
end;

// Convert date from message to Delphi format
// Returns zero in case of error

function MailDateToDelphiDate(const DateStr: String): TDateTime;
const
  Months: String = 'Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec,';

var
  Field, Loop: Integer;
  Hour, Min, Sec, Year, Month, Day: Double;
  sHour, sMin, sSec, sYear, sMonth, sDay, sTZ: String;
  HTZM, MTZM: Word;
  STZM: Integer;
  TZM: Double;
  Final: Double;

begin

  sHour := '';
  sMin := '';
  sSec := '';
  sYear := '';
  sMonth := '';
  sDay := '';
  sTZ := '';

  if DateStr <> '' then
  begin

    if DateStr[1] in ['0'..'9'] then
      Field := 1
    else
      Field := 0;

    for Loop := 1 to Length(DateStr) do
    begin

      if DateStr[Loop] in [#32, ':', '/'] then
      begin

        Inc(Field);
        if (Field = 6) and (DateStr[Loop] = #32) then Field := 7;
      end
      else
      begin

        case Field of

          1: sDay := sDay + DateStr[Loop];
          2: sMonth := sMonth + DateStr[Loop];
          3: sYear := sYear + DateStr[Loop];
          4: sHour := sHour + DateStr[Loop];
          5: sMin := sMin + DateStr[Loop];
          6: sSec := sSec + DateStr[Loop];
          7: sTZ := sTZ + DateStr[Loop];
        end;
      end;
    end;

    Hour := StrToIntDef(sHour, 0);
    Min := StrToIntDef(sMin, 0);
    Sec := StrToIntDef(sSec, 0);
    Year := StrToIntDef(sYear, 0);
    Day := StrToIntDef(sDay, 0);

    if sMonth[1] in ['0'..'9'] then
      Month := StrToIntDef(sMonth, 0)
    else
      Month := (Pos(sMonth, Months)-1) div 4 + 1;

    if Year < 100 then
    begin

      if Year < 50 then
        Year := 2000 + Year
      else
        Year := 1900 + Year;
    end;

    if (Year = 0) or (Month = 0) or (Year = 0) then
    begin

      Result := 0;
    end
    else
    begin

      if (sTZ = 'GMT') or (Length(Trim(sTZ)) <> 5) then
      begin

        STZM := 1;
        HTZM := 0;
        MTZM := 0;
      end
      else
      begin

        STZM := StrToIntDef(Copy(sTZ, 1, 1)+'1', 1);
        HTZM := StrToIntDef(Copy(sTZ, 2, 2), 0);
        MTZM := StrToIntDef(Copy(sTZ, 4, 2), 0);
      end;

      try

        TZM := EncodeTime(HTZM, MTZM, 0, 0)*STZM;
        Final := EncodeDate(Trunc(Year), Trunc(Month), Trunc(Day));
        Final := Final + Hour*(1/24) + Min*(1/24/60) + Sec*(1/24/60/60);
        Final := Final - TZM + GetTimeZoneBias;

        Result := Final;

      except

        Result := 0;
      end;
    end;
  end
  else
  begin

    Result := 0;
  end;
end;

// Convert numeric date to mail format

function DelphiDateToMailDate(const Date: TDateTime): String;
const
  Months: String = 'Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec,';
  Weeks: String = 'Sun,Mon,Tue,Wed,Thu,Fri,Sat,';

var
  TZH: Double;
  DateStr: String;
  TZStr: String;
  Day, Month, Year: Word;

begin

  TZH := GetTimeZoneBias;
  DecodeDate(Date, Year, Month, Day);

  if TZH < 0 then
  begin

    TZStr := '-'+FormatDateTime('hhmm', Abs(TZH));
  end
  else
  begin

    if TZH = 0 then
    begin

      TZStr := 'GMT'
    end
    else
    begin

      TZStr := '+'+FormatDateTime('hhmm', Abs(TZH));
    end;
  end;

  DateStr := Copy(Weeks, (DayOfWeek(Date)-1)*4+1, 3)+',';
  DateStr := DateStr + FormatDateTime(' dd ', Date);
  DateStr := DateStr + Copy(Months, (Month-1)*4+1, 3);
  DateStr := DateStr + FormatDateTime(' yyyy hh:nn:ss ', Date) + TZStr;

  Result := DateStr;
end;

// To make sure that a file name (without path!) is valid

function ValidFileName(FileName: String): String;
const
  InvChars: String = ':\/*?"<>|'#39;

var
  Loop: Integer;

begin

  FileName := Copy(TrimSpace(FileName), 1, 254);
  Result := '';

  for Loop := 1 to Length(FileName) do
  begin

    if (Ord(FileName[Loop]) < 32) or (Pos(FileName[Loop], InvChars) > 0) then
      Result := Result + '_'
    else
      Result := Result + FileName[Loop];
  end;
end;

// Wrap an entire message header

function WrapHeader(Text: String): String;
var
  Line: String;
  nPos: Integer;
  fPos: Integer;
  Quote: Char;
  Ok: Boolean;

begin

  Result := '';
  Text := AdjustLineBreaks(Text);

  while Copy(Text, Length(Text)-1, 2) = #13#10 do
    Delete(Text, Length(Text)-1, 2);

  while Text <> '' do
  begin

    nPos := Pos(#13#10, Text);

    if nPos > 0 then
    begin

      Line := Copy(Text, 1, nPos-1);
      Text := Copy(Text, nPos+2, Length(Text));
    end
    else
    begin

      Line := Text;
      Text := '';
    end;

    if Length(Line) <= _LINELEN then
    begin

      Result := Result + Line + #13#10;
    end
    else
    begin

      nPos := Length(Line);
      Quote := #0;
      Ok := False;

      if Line[1] <> #9 then
        fPos := Pos(':'#32, Line)+2
      else
        fPos := _LINELEN div 2;

      while nPos >= fPos do
      begin

        if (Qu