climap4filehandler.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    SetLength(s, Length(s) - 1);
  end;
  Handle := FindFirstFile(PChar(s), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, pTime);
    if FileTimeToDosDateTime(pTime, LongRec(Result).Hi, LongRec(Result).Lo) then
    begin
      Exit;
    end;
  end;
  Result := 0;
end;

function TclImap4FileHandler.GetMessageInternalDate(const AMessagePath: string): TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  s: string;
begin
  Result := 0;
  s := AMessagePath;
  if (s <> '') and (s[Length(s)] = '\') then
  begin
    SetLength(s, Length(s) - 1);
  end;
  Handle := FindFirstFile(PChar(s), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    Result := ConvertFileTimeToDateTime(FindData.ftLastWriteTime);
  end;
end;

function TclImap4FileHandler.GetMessageEnvelope(AMessage: TStrings): string;

  function Normalize(const ASource: string): string;
  begin
    if (ASource = '') then
    begin
      Result := 'NIL';
    end else
    begin
      Result := '"' + ASource + '"';
    end;
  end;

  function GetField(ASource, AFieldList: TStrings; const AName: string): string;
  begin
    Result := GetHeaderFieldValue(ASource, AFieldList, AName);
    Result := Normalize(Result);
  end;

  function GetMBName(const AEmail: string): string;
  var
    ind: Integer;
  begin
    Result := '';
    ind := system.Pos('@', AEmail);
    if (ind > 0) then
    begin
      Result := system.Copy(AEmail, 1, ind - 1);
    end;
  end;

  function GetDName(const AEmail: string): string;
  var
    ind: Integer;
  begin
    Result := AEmail;
    ind := system.Pos('@', AEmail);
    if (ind > 0) then
    begin
      Result := system.Copy(AEmail, ind + 1, Length(AEmail));
    end;
  end;

  function GetMails(ASource, AFieldList: TStrings; const AName: string): string;
  var
    i: Integer;
    list: TStrings;
    name, email: string;
  begin
    Result := '';

    list := TStringList.Create();
    try
      list.Text := StringReplace(GetHeaderFieldValue(ASource, AFieldList, AName), ',', #13#10, [rfReplaceAll]);

      for i := 0 to list.Count - 1 do
      begin
        GetEmailAddressParts(list[i], name, email);
        Result := Result + '(' + Normalize(name) + #32'NIL'#32 + Normalize(GetMBName(email)) + #32
           + Normalize(GetDName(email)) + ')';
      end;
    finally
      list.Free();
    end;

    if (Result = '') then
    begin
      Result := 'NIL';
    end else
    begin
      Result := '(' + Result + ')';
    end;
  end;
  
var
  fieldList: TStrings;
  from, sender: string;
begin
  fieldList := nil;
  try
    fieldList := TStringList.Create();
    GetHeaderFieldList(0, AMessage, fieldList);

    Result := Result + GetField(AMessage, fieldList, 'Date') + #32;
    Result := Result + GetField(AMessage, fieldList, 'Subject') + #32;

    from := GetMails(AMessage, fieldList, 'From');
    Result := Result + from + #32;

    sender := GetMails(AMessage, fieldList, 'Sender');
    if (sender = 'NIL') then
    begin
      sender := from;
    end;
    Result := Result + sender + #32;

    Result := Result + GetMails(AMessage, fieldList, 'Reply-To') + #32;
    Result := Result + GetMails(AMessage, fieldList, 'To') + #32;
    Result := Result + GetMails(AMessage, fieldList, 'Cc') + #32;
    Result := Result + GetMails(AMessage, fieldList, 'Bcc') + #32;
    Result := Result + 'NIL'#32;
    Result := Result + GetField(AMessage, fieldList, 'Message-ID');
  finally
    fieldList.Free();
  end;
end;

procedure TclImap4FileHandler.DoLoadMessage(AConnection: TclImap4CommandConnection;
  const AMailBoxPath, AMessageFile: string; var ACanLoad: Boolean);
begin
  if Assigned(OnLoadMessage) then
  begin
    OnLoadMessage(Self, AConnection, AMailBoxPath, AMessageFile, ACanLoad);
  end;
end;

procedure TclImap4FileHandler.FillMessageList(AConnection: TclImap4CommandConnection;
  const AMailBoxPath: string; AList: TStrings);
var
  searchRec: TSearchRec;
  canLoad: Boolean;
begin
  AList.Clear();
  if SysUtils.FindFirst(AMailBoxPath + '*.*', 0, searchRec) = 0 then
  begin
    repeat
      canLoad := not SameText(MailBoxInfoFile, searchRec.Name);
      DoLoadMessage(AConnection, AMailBoxPath, searchRec.Name, canLoad);

      if canLoad then
      begin
        AList.Add(searchRec.Name);
      end;
    until (SysUtils.FindNext(searchRec) <> 0);
    SysUtils.FindClose(searchRec);
  end;
end;

procedure TclImap4FileHandler.ParseMessageInfo(const ASource: string; var AUid: string;
  var AFlags: TclMailMessageFlags);
var
  ind: Integer;
  s: string;
begin
  ind := system.Pos(':', ASource);

  if (ind > 0) then
  begin
    AUid := Trim(system.Copy(ASource, 1, ind - 1));
    s := Trim(system.Copy(ASource, ind + 1, MaxInt));
  end;
  AFlags := GetImapMessageFlagsByStr(UpperCase(s));
end;

function TclImap4FileHandler.BuildMessageInfo(const AUid: string; AFlags: TclMailMessageFlags): string;
begin
  Result := AUid + ':' + GetStrByImapMessageFlags(AFlags);
end;

function CompareMessageUIDs(List: TStringList; Index1, Index2: Integer): Integer;
var
  uid1, uid2: Integer;
begin
  uid1 := Integer(List.Objects[Index1]);
  uid2 := Integer(List.Objects[Index2]);

  if (uid1 < uid2) then
  begin
    Result := -1;
  end else
  if (uid1 > uid2) then
  begin
    Result := 1;
  end else
  begin
    Result := 0;
  end;
end;

procedure TclImap4FileHandler.UpdateMailBoxInfo(AConnection: TclImap4CommandConnection;
  const AMailBoxPath: string; AMessageList: TStringList; IsSelectMailBox: Boolean;
  var ARecentCount, AUnseenMessages, AFirstUnseen: Integer);
var
  i: Integer;
  ini: TIniFile;
  list: TStrings;
  uid: string;
  flags: TclMailMessageFlags;
begin
  FAccessor.Enter();
  try
    ARecentCount := 0;
    AUnseenMessages := 0;
    AFirstUnseen := 0;

    ini := nil;
    list := nil;
    try
      ini := TIniFile.Create(AMailBoxPath + MailBoxInfoFile);
      list := TStringList.Create();

      ini.ReadSection(cMessagesSection, list);

      for i := 0 to list.Count - 1 do
      begin
        if (AMessageList.IndexOf(list[i]) < 0) then
        begin
          ini.DeleteKey(cMessagesSection, list[i]);
        end;
      end;

      for i := 0 to AMessageList.Count - 1 do
      begin
        uid := '';
        flags := [];
        ParseMessageInfo(ini.ReadString(cMessagesSection, AMessageList[i], ''), uid, flags);
        if (uid = '') then
        begin
          uid := IntToStr(GetNextCounter(AConnection));
          flags := flags + [mfRecent];
        end else
        if IsSelectMailBox then
        begin
          flags := flags - [mfRecent];
        end;
        ini.WriteString(cMessagesSection, AMessageList[i], BuildMessageInfo(uid, flags));
        
        AMessageList.Objects[i] := TObject(Integer(StrToInt(uid)));
      end;

      AMessageList.CustomSort(CompareMessageUIDs);

      for i := 0 to AMessageList.Count - 1 do
      begin
        uid := '';
        flags := [];
        ParseMessageInfo(ini.ReadString(cMessagesSection, AMessageList[i], ''), uid, flags);

        if not (mfSeen in flags) then
        begin
          Inc(AUnseenMessages);
          if (AFirstUnseen = 0) then
          begin
            AFirstUnseen := i + 1;
          end;
        end;

        if (mfRecent in flags) then
        begin
          Inc(ARecentCount);
        end;
      end;
    finally
      list.Free();
      ini.Free();
    end;
  finally
    FAccessor.Leave();
  end;
end;

function TclImap4FileHandler.GetMessageList(AConnection: TclImap4CommandConnection): TStringList;
begin
  Result := (AConnection as TclImap4FileCommandConnection).Messages;
end;

function TclImap4FileHandler.GetMessageUID(AConnection: TclImap4CommandConnection;
  const AMessageFile: string): string;
var
  ind: Integer;
  list: TStringList;
begin
  list := GetMessageList(AConnection);
  ind := list.IndexOf(AMessageFile);
  Result := IntToStr(Integer(list.Objects[ind]));
end;

function TclImap4FileHandler.GetMsgFileByUID(AList: TStrings; AUID: Integer): string;
var
  i: Integer;
begin
  for i := 0 to AList.Count - 1 do
  begin
    if (Integer(AList.Objects[i]) = AUID) then
    begin
      Result := AList[i];
      Exit;
    end;
  end;
  Result := '';
  Assert(False);
end;

procedure TclImap4FileHandler.RefreshMailBoxInfo(AConnection: TclImap4CommandConnection);
var
  mailboxInfo: TclImap4MailBoxInfo;
  result: TclImap4MailBoxResult;
begin
  //TODO
  mailboxInfo := TclImap4MailBoxInfo.Create();
  try
    result := GetMailBoxInfo(AConnection, AConnection.CurrentMailBox.Name,
      False, mailboxInfo, GetMessageList(AConnection));
    if (result = mrSuccess) then
    begin
      AConnection.CurrentMailBox.Assign(mailboxInfo);
    end;
  finally
    mailboxInfo.Free();
  end;
end;

function TclImap4FileHandler.GetMailBoxInfo(AConnection: TclImap4CommandConnection;
  const AMailBox: string; IsSelectMailBox: Boolean;
  AMailBoxInfo: TclImap4MailBoxInfo; AMessageList: TStringList): TclImap4MailBoxResult;
var
  path: string;
  recentCount, unseenCount, firstUnseen: Integer;
begin
  path := GetMailBoxPath(AConnection.UserName) + AddTrailingBackSlash(MailBoxToPath(AMailBox));
  if DirectoryExists(path) then
  begin
    try
      AMailBoxInfo.Clear();
      AMailBoxInfo.Name := AMailBox;

      AMailBoxInfo.Flags := [mfAnswered, mfFlagged, mfDeleted, mfSeen, mfDraft, mfRecent];
      AMailBoxInfo.ChangeableFlags := [mfAnswered, mfFlagged, mfDeleted, mfSeen, mfDraft];

      FillMessageList(AConnection, path, AMessageList);
      recentCount := 0;
      unseenCount := 0;
      firstUnseen := 0;
      UpdateMailBoxInfo(AConnection, path, AMessageList, IsSelectMailBox, recentCount, unseenCount, firstUnseen);

      AMailBoxInfo.ExistsMessages := AMessageList.Count;
      AMailBoxInfo.RecentMessages := recentCount;
      AMailBoxInfo.UnseenMessages := unseenCount;
      AMailBoxInfo.FirstUnseen := firstUnseen;

      AMailBoxInfo.UIDValidity := IntToStr(GetFileTimeStamp(path));
      AMailBoxInfo.UIDNext := IntToStr(GetCurrentCounter(AConnection));

      Result := mrSuccess;
    except
      Result := mrAccessDenied;
    end;
  end else
  begin
    Result := mrNotFound;
  end;
end;

procedure TclImap4FileHandler.DoGetMailBoxInfo(Sender: TObject; AConnection: TclImap4CommandConnection;
  const AMailBox: string; IsSelectMailBox: Boolean; AMailBoxInfo: TclImap4MailBoxInfo;
  var Result: TclImap4MailBoxResult);
var
  list, messageList: TStringList;
begin
  list := nil;
  try
    if IsSelectMailBox then
    begin
      messageList := GetMessageList(AConnection);
    end else
    begin
      list := TStringList.Create();
      messageList := list;
    end;
    Result := GetMailBoxInfo(AConnection, AMailBox, IsSelectMailBox, AMailBoxInfo, messageList);
  finally
    list.Free();
  end;
end;

procedure TclImap4FileHandler.SearchAllMessages(AConnection: TclImap4CommandConnection;
  AUseUID: Boolean; AMessageIDs: TStrings);
var
  i: Integer;
  msgList: TStrings;
begin
  msgList := GetMessageList(AConnection);
  for i := 0 to msgList.Count - 1 do
  begin
    if AUseUID then
    begin
      AMessageIDs.Add(GetMessageUID(AConnection, msgList[i]));
    end else
    begin
      AMessageIDs.Add(IntToStr(i + 1));
    end;
  end;
end;

procedure TclImap4FileHandler.SearchMessages(AConnection: TclImap4CommandConnection;
  const AKey, AParam: string; AUseUID: Boolean; AMessageIDs: TStrings);
var
  i: Integer;
  msgList, msgSrc, fieldList: TStrings;
  path: string;
begin
  path := GetMailBoxPath(AConnection.UserName) + AddTrailingBackSlash(MailBoxToPath(AConnection.CurrentMailBox.Name));
  msgList := GetMessageList(AConnection);

  fieldList := TStringList.Create();
  msgSrc := TStringList.Create();
  try
    for i := 0 to msgList.Count - 1 do
    begin
      if FileExists(path + msgList[i]) then
      begin
        msgSrc.LoadFromFile(path + msgList[i]);
        GetHeaderFieldList(0, msgSrc, fieldList);
        if (system.Pos(UpperCase(AParam), UpperCase(GetHeaderFieldValue(msgSrc, fieldList, AKey))) > 0) then
        begin
          if AUseUID then
          begin
            AMessageIDs.Add(GetMessageUID(AConnection, msgList[i]));
          end else
          begin
            AMessageIDs.Add(IntToStr(i + 1));
          end;
        end;
      end;
    end;
  finally
    msgSrc.Free();
    fieldList.Free();
  end;
end;

procedure TclImap4FileHandler.DoSearchMessages(Sender: TObject; AConnection: TclImap4CommandConnection;
  const ASearchCriteria: string; AUseUID: Boolean; AMessageIDs: TStrings; var Result: TclImap4MessageResult);
var
  ind: Integer;
  key, param: string;
begin
  RefreshMailBoxInfo(AConnection);

  ind := Pos(#32, ASearchCriteria);
  if (ind > 0) then
  begin
    key := UpperCase(system.Copy(ASearchCriteria, 1, ind - 1));
    param := system.Copy(ASearchCriteria, ind + 1, Length(ASearchCriteria));
  end else
  begin
    key := UpperCase(ASearchCriteria);
    param := '';
  end;

  AMessageIDs.Clear();
  Result := msOk;
  try
    if (key = 'ALL') then
    begin
      SearchAllMessages(AConnection, AUseUID, AMessageIDs);
    end else
    if (key = 'FROM') or (key = 'TO') or (key = 'SUBJECT') then
    begin
      SearchMessages(AConnection, key, param, AUseUID, AMessageIDs);