climap4filehandler.pas

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

    end else
    begin
      Result := msBad;
    end;
  except
    Result := msNo;
  end;
end;

procedure TclImap4FileHandler.FillTargetList(AConnection: TclImap4CommandConnection;
  const AMessageSet: string; AUseUID: Boolean; ATargetList: TStrings);
var
  i: Integer;
  msgList, msgFileList: TStrings;
begin
  msgList := TStringList.Create();
  try
    msgFileList := GetMessageList(AConnection);
    if AUseUID then
    begin                        
      for i := 0 to msgFileList.Count - 1 do
      begin
        msgList.Add(GetMessageUID(AConnection, msgFileList[i]));
      end;
    end else
    begin
      for i := 0 to msgFileList.Count - 1 do
      begin
        msgList.Add(IntToStr(i + 1));
      end;
    end;

    ParseMessageSet(AMessageSet, msgList, ATargetList);

    if AUseUID then
    begin
      for i := 0 to ATargetList.Count - 1 do
      begin
        ATargetList[i] := GetMsgFileByUID(msgFileList, StrToInt(ATargetList[i]));
      end;
    end else
    begin
      for i := 0 to ATargetList.Count - 1 do
      begin
        ATargetList[i] := msgFileList[StrToInt(ATargetList[i]) - 1];
      end;
    end;
  finally
    msgList.Free();
  end;
end;

function TclImap4FileHandler.GenMessageFileName(AConnection: TclImap4CommandConnection): string;
begin
  Result := GetUniqueFileName(Format('MAIL%.8d.MSG', [GetNextCounter(AConnection)]));
end;

procedure TclImap4FileHandler.DoCopyMessages(Sender: TObject; AConnection: TclImap4CommandConnection;
  const AMessageSet, AMailBox: string; AUseUID: Boolean; var Result: TclImap4MailBoxResult);
var
  i: Integer;
  s, currentPath, targetPath: string;
  targetList: TStrings;
begin
  currentPath := GetMailBoxPath(AConnection.UserName) + AddTrailingBackSlash(MailBoxToPath(AConnection.CurrentMailBox.Name));
  targetPath := GetMailBoxPath(AConnection.UserName) + AddTrailingBackSlash(MailBoxToPath(AMailBox));

  if not DirectoryExists(targetPath) then
  begin
    Result := mrNotFound;
    Exit;
  end;

  try
    targetList := TStringList.Create();
    try
      FillTargetList(AConnection, AMessageSet, AUseUID, targetList);

      for i := 0 to targetList.Count - 1 do
      begin
        s := targetPath + targetList[i];
        while not CopyFile(PChar(currentPath + targetList[i]), PChar(s), True) do
        begin
          s := targetPath + GenMessageFileName(AConnection);
        end;
      end;
    finally
      targetList.Free();
    end;
    Result := mrSuccess;
  except
    Result := mrAccessDenied;
  end;
end;

function TclImap4FileHandler.GetLocalFileSize(const AFileName: string): Integer;
var
  h: THandle;
begin
  h := CreateFile(PChar(AFileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if (h <> INVALID_HANDLE_VALUE) then
  begin
    Result := GetFileSize(h, nil);
    CloseHandle(h);
  end else
  begin
    Result := -1;
  end;
end;

function TclImap4FileHandler.GetMessageFlags(AConnection: TclImap4CommandConnection;
  const AMailBoxPath, AMessageFile: string): string;
var
  ini: TIniFile;
  uid: string;
  flags: TclMailMessageFlags;
begin
  Result := '';
  if not FileExists(AMailBoxPath + MailBoxInfoFile) then Exit;

  ini := TIniFile.Create(AMailBoxPath + MailBoxInfoFile);
  try
    Result := ini.ReadString(cMessagesSection, AMessageFile, '');
    ParseMessageInfo(Result, uid, flags);
    Result := GetStrByImapMessageFlags(flags);
  finally
    ini.Free();
  end;
end;

function TclImap4FileHandler.SetMessageFlags(AConnection: TclImap4CommandConnection;
  const AMailBoxPath, AMessageFile: string; AFlagsMethod: TclSetFlagsMethod;
  ANewFlags: TclMailMessageFlags): string;
var
  ini: TIniFile;
  uid: string;
  flags: TclMailMessageFlags;
begin
  Result := '';
  ini := nil;
  try
    ini := TIniFile.Create(AMailBoxPath + MailBoxInfoFile);
    Result := ini.ReadString(cMessagesSection, AMessageFile, '');
    ParseMessageInfo(Result, uid, flags);

    case AFlagsMethod of
      fmReplace: flags := ANewFlags;
      fmAdd: flags := flags + ANewFlags;
      fmRemove: flags := flags - ANewFlags;
    end;

    ini.WriteString(cMessagesSection, AMessageFile, BuildMessageInfo(uid, flags));

    Result := GetStrByImapMessageFlags(flags);
  finally
    ini.Free();
  end;
end;

procedure TclImap4FileHandler.ParseHeaderFieldParams(const ASource: string; AFields: TStrings);
var
  i, ind: Integer;
  s: string;
begin
  s := ASource;
  ind := system.Pos('(', s);
  if (ind > 0) then
  begin
    s := system.Copy(s, ind + 1, Length(s));
  end;

  ind := system.Pos(')', s);
  if (ind > 0) then
  begin
    SetLength(s, ind - 1);
  end;

  AFields.Text := StringReplace(s, #32, #13#10, [rfReplaceAll]);

  for i := 0 to AFields.Count - 1 do
  begin
    AFields[i] := LowerCase(Trim(AFields[i]));
  end;
end;

procedure TclImap4FileHandler.GetBodyIDs(const AParams: string; var ABodyIDs: array of Integer);
var
  i, ind: Integer;
begin
  for i := 0 to High(ABodyIDs) do
  begin
    ABodyIDs[i] := 0;
  end;

  ind := 0;
  for i := 1 to Length(AParams) do
  begin
    if(AParams[i] in [#$30..#$39]) then
    begin
      ABodyIDs[ind] := StrToInt(AParams[i]);
    end else
    if(AParams[i] = '.') then
    begin
      Inc(ind);
      if (ind > High(ABodyIDs)) then
      begin
        Break;
      end;
    end else
    begin
      Break;
    end;
  end;
end;

procedure TclImap4FileHandler.FetchHeaderFields(const AMessagePath, ACommand, AParams: string;
  AResponseItem: TclImap4FetchResponseItem);

  function GetHeaderFieldsStr(AHeader: TStrings; const AParams: string): string;
  var
    i, ind: Integer;
    reqFields, fieldList: TStrings;
  begin
    Result := '';

    reqFields := nil;
    fieldList := nil;
    try
      reqFields := TStringList.Create();
      ParseHeaderFieldParams(AParams, reqFields);

      fieldList := TStringList.Create();
      GetHeaderFieldList(0, AHeader, fieldList);

      for i := 0 to reqFields.Count - 1 do
      begin
        ind := fieldList.IndexOf(reqFields[i]);
        if (ind > - 1) then
        begin
          Result := Result + system.Copy(AHeader[Integer(fieldList.Objects[ind])], 1, Length(fieldList[ind]));
          Result := Result + ': '+ GetHeaderFieldValue(AHeader, fieldList, ind) + #13#10;
        end;
      end;
      if (Result <> '') then
      begin
        Result := Result + #13#10;
      end;
    finally
      fieldList.Free();
      reqFields.Free();
    end;
  end;

var
  msg: TclMailMessage;
  src: TStrings;
  s: string;
  bodyIDs: TclMessageBodyIDs;
  body: TclMessageBody;
begin
  GetBodyIDs(AParams, bodyIDs);

  msg := nil;
  src := nil;
  try
    msg := TclMailMessage.Create(nil);
    src := TStringList.Create();

    src.LoadFromFile(AMessagePath);
    msg.MessageSource := src;

    s := '';
    if (bodyIDs[0] = 0) then
    begin
      s := GetHeaderFieldsStr(msg.RawHeader, AParams);
    end else
    begin
      body := GetBodyByIndex(bodyIDs, 0, msg.Bodies);
      if (body <> nil) then
      begin
        s := GetHeaderFieldsStr(body.RawHeader, AParams);
      end;
    end;

    AResponseItem.MessageData := AResponseItem.MessageData
      + Format('%s {%d}'#13#10, [ACommand, Length(s)]) + s;
  finally
    src.Free();
    msg.Free();
  end;
end;

procedure TclImap4FileHandler.FetchHeader(const AMessagePath, ACommand, AParams: string;
  AResponseItem: TclImap4FetchResponseItem);
var
  msg: TclMailMessage;
  src: TStrings;
  s: string;
  bodyIDs: TclMessageBodyIDs;
  body: TclMessageBody;
begin
  GetBodyIDs(AParams, bodyIDs);

  msg := nil;
  src := nil;
  try
    msg := TclMailMessage.Create(nil);
    src := TStringList.Create();

    src.LoadFromFile(AMessagePath);
    msg.MessageSource := src;

    s := '';
    if (bodyIDs[0] = 0) then
    begin
      s := msg.RawHeader.Text + #13#10;
    end else
    begin
      body := GetBodyByIndex(bodyIDs, 0, msg.Bodies);
      if (body <> nil) then
      begin
        s := body.RawHeader.Text + #13#10;
      end;
    end;

    AResponseItem.MessageData := AResponseItem.MessageData
      + Format('%s {%d}'#13#10, [ACommand, Length(s)]) + s;
  finally
    src.Free();
    msg.Free();
  end;
end;

function TclImap4FileHandler.GetBodyByIndex(var ABodyIDs: array of Integer;
  AIndex: Integer; ABodies: TclMessageBodies): TclMessageBody;
var
  ind: Integer;
begin
  Result := nil;
  if (AIndex > High(ABodyIDs)) then Exit;
  
  ind := ABodyIDs[AIndex] - 1;
  if (ind < 0) or (ind > ABodies.Count - 1) then Exit;

  if (ABodies[ind] is TclMultipartBody) then
  begin
    if (AIndex < High(ABodyIDs)) and (ABodyIDs[AIndex + 1] > 0) then
    begin
      Result := GetBodyByIndex(ABodyIDs, AIndex + 1, TclMultipartBody(ABodies[ind]).Bodies);
    end else
    begin
      Result := ABodies[ind];
    end;
  end else
  if (AIndex < High(ABodyIDs)) and (ABodyIDs[AIndex + 1] = 0) then
  begin
    Result := ABodies[ind];
  end;
end;

procedure TclImap4FileHandler.FetchBodyText(const AMessagePath, ACommand, AParams: string;
  AResponseItem: TclImap4FetchResponseItem);
var
  msg: TclMailMessage;
  src: TStrings;
  s: string;
  bodyIDs: TclMessageBodyIDs;
  body: TclMessageBody;
begin
  GetBodyIDs(AParams, bodyIDs);

  msg := nil;
  src := nil;
  try
    msg := TclMailMessage.Create(nil);
    src := TStringList.Create();

    src.LoadFromFile(AMessagePath);
    msg.MessageSource := src;

    s := '';
    if (bodyIDs[0] = 0) then
    begin
      s := GetTextStr(src, msg.RawBodyStart, src.Count);
    end else
    begin
      body := GetBodyByIndex(bodyIDs, 0, msg.Bodies);
      if (body <> nil) then
      begin
        s := GetTextStr(src, body.RawBodyStart, body.EncodedLines);
      end;
    end;

    AResponseItem.MessageData := AResponseItem.MessageData
      + Format('%s {%d}'#13#10, [ACommand, Length(s)]) + s;
  finally
    src.Free();
    msg.Free();
  end;
end;

procedure TclImap4FileHandler.FetchBody(const AMessagePath, ACommand, AParams: string;
  AResponseItem: TclImap4FetchResponseItem);
var
  stream: TStream;
  s: string;
  bodyIDs: TclMessageBodyIDs;
begin
  GetBodyIDs(AParams, bodyIDs);

  if (bodyIDs[0] = 0) then
  begin
    stream := TFileStream.Create(AMessagePath, fmOpenRead or fmShareDenyWrite);
    try
      SetString(s, nil, stream.Size);
      stream.Read(PChar(s)^, stream.Size);
      AResponseItem.MessageData := AResponseItem.MessageData
          + Format('%s {%d}'#13#10, [ACommand, Length(s)]) + s;
    finally
      stream.Free();
    end;
  end else
  begin
    FetchBodyText(AMessagePath, ACommand, AParams, AResponseItem);
  end;
end;

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

procedure TclImap4FileHandler.FetchMessage(AConnection: TclImap4CommandConnection;
  const AMessageFile: string; ARequest: TclImap4FetchRequestList;
  AUseUID: Boolean; AResponseItem: TclImap4FetchResponseItem);
var
  i, k: Integer;
  path, s: string;
begin
  AResponseItem.MessageID := GetMessageList(AConnection).IndexOf(AMessageFile) + 1;
  Assert(AResponseItem.MessageID > 0);

  path := GetMailBoxPath(AConnection.UserName) + AddTrailingBackSlash(MailBoxToPath(AConnection.CurrentMailBox.Name));

  for i := 0 to ARequest.Count - 1 do
  begin
    if ('UID' = ARequest[i].Name) then
    begin
      if not AUseUID and (Length(AResponseItem.MessageData) > 0) then
      begin
        AResponseItem.MessageData := AResponseItem.MessageData + #32;
      end;
    end else
    if (Length(AResponseItem.MessageData) > 0) then
    begin
      AResponseItem.MessageData := AResponseItem.MessageData + #32;
    end;

    if ('BODY' = ARequest[i].Name) or ('BODY.PEEK' = ARequest[i].Name) then
    begin
      s := UpperCase(ARequest[i].Params);
      if (system.Pos('HEADER.FIELDS', s) > 0) then
      begin
        FetchHeaderFields(path + AMessageFile, 'BODY[' + s + ']', s, AResponseItem);
      end else
      if (system.Pos('HEADER', s) > 0) then
      begin
        FetchHeader(path + AMessageFile, 'BODY[' + s + ']', s, AResponseItem);
      end else
      if (system.Pos('MIME', s) > 0) then
      begin
        FetchHeader(path + AMessageFile, 'BODY[' + s + ']', s, AResponseItem);
      end else
      if (system.Pos('TEXT', s) > 0) then
      begin
        FetchBodyText(path + AMessageFile, 'BODY[' + s + ']', s, AResponseItem);
      end else
      begin
        FetchBody(path + AMessageFile, 'BODY[' + s + ']', s, AResponseItem);
      end;

      if ('BODY' = ARequest[i].Name) then
      begin
        SetMessageFlags(AConnection, path, AMessageFile, fmRemove, [mfSeen]);
      end;
    end else
    if ('RFC822' = ARequest[i].Name) then