{
  Clever Internet Suite
  Copyright (C) 2013 Clever Components
  All Rights Reserved
  www.CleverComponents.com
}

unit clImapUtils;

interface

{$I clVer.inc}

uses
{$IFNDEF DELPHIXE2}
  Classes, SysUtils,
{$ELSE}
  System.Classes, System.SysUtils,
{$ENDIF}
  clUtils;

type
  TclImap4ConnectionState = (csNonAuthenticated, csAuthenticated, csSelected);

  TclMailMessageFlag = (mfAnswered, mfFlagged, mfDeleted, mfSeen, mfDraft, mfRecent);
  TclMailMessageFlags = set of TclMailMessageFlag;

  TclSetFlagsMethod = (fmReplace, fmAdd, fmRemove);

  TclImap4MailBoxInfo = class
  private
    FName: string;
    FRecentMessages: Integer;
    FFirstUnseen: Integer;
    FExistsMessages: Integer;
    FReadOnly: Boolean;
    FFlags: TclMailMessageFlags;
    FChangeableFlags: TclMailMessageFlags;
    FUIDValidity: string;
    FUIDNext: Integer;
  public
    constructor Create;

    procedure Clear; virtual;
    procedure Assign(ASource: TclImap4MailBoxInfo); virtual;

    property Name: string read FName write FName;
    property ExistsMessages: Integer read FExistsMessages write FExistsMessages;
    property RecentMessages: Integer read FRecentMessages write FRecentMessages;
    property FirstUnseen: Integer read FFirstUnseen write FFirstUnseen;
    property ReadOnly: Boolean read FReadOnly write FReadOnly;
    property Flags: TclMailMessageFlags read FFlags write FFlags;
    property ChangeableFlags: TclMailMessageFlags read FChangeableFlags write FChangeableFlags;
    property UIDValidity: string read FUIDValidity write FUIDValidity;
    property UIDNext: Integer read FUIDNext write FUIDNext;
  end;

  TclImapUtf7Encoder = class
  private
    class function EncodeBase64Imap(const AValue: TclByteArray; ALength: Integer): string;
    class function DecodeBase64Imap(const AValue: string): string;
  public
    class function Encode(const AValue: string): string;
    class function Decode(const AValue: string): string;
  end;

function GetStrByImapMessageFlags(AFlags: TclMailMessageFlags): string;
function GetImapMessageFlagsByStr(const AText: string): TclMailMessageFlags;
function ExtractMessageSize(const ASource: string): Int64;
procedure ParseMailboxInfo(const AMailBoxInfo: string; var ASeparator: Char; var AName: string);
function DateTimeToImapTime(ADate: TDateTime): string;
function IsInState(ACurrentState: TclImap4ConnectionState;
  ACheckStates: array of TclImap4ConnectionState): Boolean;

implementation

uses
  clEncoder, clTranslator;
  
function GetStrByImapMessageFlags(AFlags: TclMailMessageFlags): string;
const
  flagLexems: array[TclMailMessageFlag] of string =
    ('\Answered', '\Flagged', '\Deleted', '\Seen', '\Draft', '\Recent');
var
  flag: TclMailMessageFlag;
begin
  Result := '';
  for flag := Low(TclMailMessageFlag) to High(TclMailMessageFlag) do
  begin
    if (flag in AFlags) then
    begin
      Result := Result + ' ' + flagLexems[flag];
    end;
  end;
  Result := Trim(Result);
end;

function GetImapMessageFlagsByStr(const AText: string): TclMailMessageFlags;
begin
  Result := [];
  if (System.Pos('\ANSWERED', AText) > 0) then
    Result := Result + [mfAnswered];
  if (System.Pos('\FLAGGED', AText) > 0) then
    Result := Result + [mfFlagged];
  if (System.Pos('\DELETED', AText) > 0) then
    Result := Result + [mfDeleted];
  if (System.Pos('\SEEN', AText) > 0) then
    Result := Result + [mfSeen];
  if (System.Pos('\DRAFT', AText) > 0) then
    Result := Result + [mfDraft];
  if (System.Pos('\RECENT', AText) > 0) then
    Result := Result + [mfRecent];
end;

function ExtractMessageSize(const ASource: string): Int64;
var
  indEnd, indStart: Integer;
begin
  Result := 0;

  indEnd := RTextPos('}', ASource);
  if (indEnd = 0) then Exit;

  indStart := RTextPos('{', ASource, indEnd);
  if (indStart = 0) then Exit;

  Result := StrToInt64Def(system.Copy(ASource, indStart + 1, indEnd - indStart - 1), 0);
end;

procedure ParseMailboxInfo(const AMailBoxInfo: string; var ASeparator: Char; var AName: string);
var
  ind: Integer;
begin
  ASeparator := #0;
  AName := '';

  ind := System.Pos(')', AMailBoxInfo);
  if (ind > 0) then
  begin
    AName := Trim(System.Copy(AMailBoxInfo, ind + 1, MaxInt));
    if (AName <> '') and (AName[1] = '"') then
    begin
      if ((AName[2] = '\') and (Length(AName) > 2) and (AName[3] <> '"')) then
      begin
        ASeparator := AName[3];
      end else
      begin
        ASeparator := AName[2];
      end;
    end;

    ind := System.Pos(' ', AName);
    if (ind > 0) then
    begin
      AName := Trim(System.Copy(AName, ind + 1, MaxInt));
    end;

    AName := ExtractQuotedString(AName, '"');

    AName := TclImapUtf7Encoder.Decode(AName);
  end;
end;

function DateTimeToImapTime(ADate: TDateTime): string;
var
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  MonthName: String;
begin
  DecodeDate(ADate, Year, Month, Day);
  DecodeTime(ADate, Hour, Min, Sec, MSec);
  MonthName := cMonths[Month];
  Result := Format('%d-%s-%d %d:%.2d:%.2d %s', [Day, MonthName, Year, Hour, Min, Sec, TimeZoneBiasString]);
end;

function IsInState(ACurrentState: TclImap4ConnectionState;
  ACheckStates: array of TclImap4ConnectionState): Boolean;
var
  i: Integer;
begin
  for i := Low(ACheckStates) to High(ACheckStates) do
  begin
    Result := (ACurrentState = ACheckStates[i]);
    if Result then Exit;
  end;
  Result := False;
end;

{ TclImap4MailBoxInfo }

procedure TclImap4MailBoxInfo.Assign(ASource: TclImap4MailBoxInfo);
begin
  Assert(ASource <> nil);
  
  FName := ASource.Name;
  FRecentMessages := ASource.RecentMessages;
  FFirstUnseen := ASource.FirstUnseen;
  FExistsMessages := ASource.ExistsMessages;
  FReadOnly := ASource.ReadOnly;
  FFlags := ASource.Flags;
  FChangeableFlags := ASource.ChangeableFlags;
  FUIDValidity := ASource.UIDValidity;
  FUIDNext := ASource.UIDNext;
end;

procedure TclImap4MailBoxInfo.Clear;
begin
  FName := '';
  FRecentMessages := 0;
  FFirstUnseen := 0;
  FExistsMessages := 0;
  FReadOnly := False;
  FFlags := [];
  FChangeableFlags := [];
  FUIDValidity := '';
  FUIDNext := 0;
end;

constructor TclImap4MailBoxInfo.Create;
begin
  inherited Create();
  Clear();
end;

{ TclImapUtf7Encoder }

class function TclImapUtf7Encoder.Decode(const AValue: string): string;
var
  n, h, t, k: Integer;
begin
  Result := '';
  n := Length(AValue);
  h := 1;

  while (h <= n) do
  begin
    t := TextPos('&', AValue, h);

    if (t <= 0) then
    begin
      t := n + 1;
    end;

    Result := Result + System.Copy(AValue, h, t - h);
    h := t + 1;
    if (h > n) then Break;

    t := TextPos('-', AValue, h);
    if (t <= 0) then
    begin
      t := n + 1;
    end;

    k := t - h;
    if (k = 0) then
    begin
      Result := Result + '&';
    end else
    begin
      Result := Result + DecodeBase64Imap(System.Copy(AValue, h, k));
    end;
    h := t + 1;
  end;
end;

class function TclImapUtf7Encoder.DecodeBase64Imap(const AValue: string): string;
var
  enc: TclEncoder;
  b: TclByteArray;
begin
  enc := TclEncoder.Create(nil);
  try
    enc.EncodeMethod := cmBase64;
    enc.CharSet := 'UTF-7';
    b := enc.DecodeToBytes(StringReplace(AValue, ',', '/', [rfReplaceAll]));
    Result := TclTranslator.GetString(b, 'UTF-16BE');
  finally
    enc.Free();
  end;
end;

class function TclImapUtf7Encoder.Encode(const AValue: string): string;
var
  s, buf: TclByteArray;
  i, n, x, r, w, k, bufIndex: Integer;
begin
  s := TclTranslator.GetBytes(AValue, 'UTF-8');

  n := Length(s);
  SetLength(buf, n);
  bufIndex := 0;
  Result := '';

  i := 0;
  while (i < n) do
  begin
    x := s[i];
    Inc(i);

    if ((x and $80) = $00) then
    begin
      r := x;
      w := 0;
    end else
    if ((x and $E0) = $C0) then
    begin
      w := 1;
      r := x and $1F;
    end else
    if ((x and $F0) = $E0) then
    begin
      w := 2;
      r := x and $0F;
    end else
    if ((x and $F8) = $F0) then
    begin
      w := 3;
      r := x and $07;
    end else
    if ((x and $FC) = $F8) then
    begin
      w := 4;
      r := x and $03;
    end else
    if ((x and $FE) = $FC) then
    begin
      w := 5;
      r := x and $01;
    end else
    if ((x and $C0) = $80) then
    begin
      w := 0;
      r := -1;
    end else
    begin
      w := 0;
      r :=-2;
    end;

    k := 0;
    while (k < w) and (i <= n) do
    begin
      x := s[i];
      Inc(i);

      r :=(r shl 6) or (x and $3F);

      Inc(k);
    end;

    if (r < $20) or (r > $7E) then
    begin
      if (bufIndex + 2 >= Length(buf)) then
      begin
        SetLength(buf, Length(buf) * 2);
      end;

      buf[bufIndex] := (r shr 8) and $FF;
      Inc(bufIndex);
      buf[bufIndex] := r and $FF;
      Inc(bufIndex);
    end else
    begin
      if (bufIndex > 0) then
      begin
        Result := Result + '&' + EncodeBase64Imap(buf, bufIndex) + '-';
        bufIndex := 0;
      end;

      if (r = $26) then
      begin
        Result := Result + '&-';
      end else
      begin
        Result := Result + Chr(r);
      end;
    end;
  end;

  if (bufIndex > 0) then
  begin
    Result := Result + '&' + EncodeBase64Imap(buf, bufIndex) + '-';
  end;
end;

class function TclImapUtf7Encoder.EncodeBase64Imap(const AValue: TclByteArray; ALength: Integer): string;
var
  enc: TclEncoder;
begin
  enc := TclEncoder.Create(nil);
  try
    enc.SuppressCrlf := True;
    enc.CharSet := 'UTF-7';
    Result := enc.Encode(AValue, 0, ALength);
    Result := StringReplace(Result, '/', ',', [rfReplaceAll]);
    Result := TextTrimRight(Result, ['=']);
  finally
    enc.Free();
  end;
end;

end.
