idimap4server.pas

photo.163.com 相册下载器 多线程下载

    LText := '*';    {Do not Localize}
  end else begin
    LText := FLastCommand.SequenceNumber;
  end;
  LText := LText + ' NO Unknown command'; {Do not Localize}
  DoSendReply(AContext, LText);
end;

function  TIdIMAP4Server.ExpungeRecords(ASender: TIdCommand): Boolean;
var
  LN: integer;
begin
  //Delete all records that have the deleted flag set...
  LN := 0;
  Result := True;
  while LN < TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Count do begin
    if mfDeleted in TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].Flags then begin
      if OnDefMechDeleteMessage(TIdIMAP4PeerContext(ASender.Context).FLoginName,
       TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
       TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN]) = False then begin
        Result := False;
      end;
      TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Delete(LN);
      TIdIMAP4PeerContext(ASender.Context).FMailBox.TotalMsgs :=
       TIdIMAP4PeerContext(ASender.Context).FMailBox.TotalMsgs - 1;
    end else begin
      Inc(LN);
    end;
  end;
end;

function  TIdIMAP4Server.MessageSetToMessageNumbers(AUseUID: Boolean; ASender: TIdCommand; var AMessageNumbers: TIdStringList; AMessageSet: string): Boolean;
{AMessageNumbers may be '7' or maybe '2:4' (2, 3 & 4) or maybe '2,4,6' (2, 4 & 6)
or maybe '1:*'}
var
  LPos: integer;
  LStart: integer;
  LN: integer;
  LEnd: integer;
  LTemp: string;
begin
  AMessageNumbers.Clear;
  //See is it a sequence like 2:4 ...
  LPos := IndyPos(':', AMessageSet);      {Do not Localize}
  if LPos > 0 then begin
    LTemp := Copy(AMessageSet, 1, LPos-1);
    LStart := StrToInt(LTemp);
    LTemp := Copy(AMessageSet, LPos+1, MAXINT);
    if LTemp = '*' then begin  {Do not Localize}
      if AUseUID = True then begin
        LEnd := StrToInt(TIdIMAP4PeerContext(ASender.Context).FMailBox.UIDNext)-1;
        for LN := LStart to LEnd do begin
          AMessageNumbers.Add(IntToStr(LN));
        end;
      end else begin
        LEnd := TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Count;
        for LN := LStart to LEnd do begin
          AMessageNumbers.Add(IntToStr(LN));
        end;
      end;
    end else begin
      LEnd := StrToInt(LTemp);
      for LN := LStart to LEnd do begin
        AMessageNumbers.Add(IntToStr(LN));
      end;
    end;
  end else begin
    //See is it a comma-separated list...
    LPos := IndyPos(',', AMessageSet);        {Do not Localize}
    if LPos = 0 then begin
      AMessageNumbers.Add(AMessageSet);
    end else begin
      BreakApart(AMessageSet, ',', AMessageNumbers); {Do not Localize}
    end;
  end;
  Result := True;
end;

function TIdIMAP4Server.GetRecordForUID(AMessageNumber: integer; AMailBox: TIdMailBox): integer;
  //Return -1 if not found
var
  LN: integer;
begin
  for LN := 0 to AMailBox.MessageList.Count-1 do begin
    if StrToInt(AMailBox.MessageList.Messages[LN].UID) = AMessageNumber then begin
      Result := LN;
      Exit;
    end;
  end;
  Result := -1;
end;

function  TIdIMAP4Server.StripQuotesIfNecessary(AName: string): string;
begin
  Result := AName;
  if Length(Result) < 1 then begin
    Exit;
  end;
  if ((Result[1] = '"') and (Result[Length(Result)] = '"')) then begin  {Do not Localize}
    Result := Copy(Result, 2, Length(Result)-2);
  end;
end;

function  TIdIMAP4Server.ReassembleParams(ASeparator: char; var AParams: TIdStringList; AParamToReassemble: integer): Boolean;
label
  GetAnotherParam;
var
  LEndSeparator: char;
  LTemp: string;
  LN: integer;
  LReassembledParam: string;
begin
  case ASeparator of
   '(': LEndSeparator := ')';           {Do not Localize}
   '[': LEndSeparator := ']';           {Do not Localize}
   else LEndSeparator := ASeparator;
  end;
  LTemp := AParams[AParamToReassemble];
  if LTemp[1] <> ASeparator then begin
    Result := False;
    Exit;
  end;
  if LTemp[Length(LTemp)] = LEndSeparator then begin
    AParams[AParamToReassemble] := Copy(LTemp, 2, Length(LTemp)-2);
    Result := True;
    Exit;
  end;
  LReassembledParam := Copy(LTemp, 2, MAXINT);
  LN := AParamToReassemble + 1;
 GetAnotherParam:
  if LN >= AParams.Count - 1 then begin
    Result := False;
    Exit;  //Error
  end;
  LTemp := AParams[LN];
  AParams.Delete(LN);
  if LTemp[Length(LTemp)] = LEndSeparator then begin
    AParams[AParamToReassemble] := LReassembledParam + ' ' + Copy(LTemp, 1, Length(LTemp)-1);  {Do not Localize}
    Result := True;
    Exit;  //This is example 1
  end;
  LReassembledParam := LReassembledParam + ' ' + LTemp;  {Do not Localize}
  goto GetAnotherParam;
end;

function  TIdIMAP4Server.ReinterpretParamAsMailBox(var AParams: TIdStringList; AMailBoxParam: integer): Boolean;
var
  LTemp: string;
begin
  //This reorganises the parameter list on the basis that AMailBoxParam is a
  //mailbox name, which may (if enclosed in quotes) be in more than one param.
  //Example 1: '43' '"My' 'Documents"' '5' -> '43' 'My Documents' '5'
  //Example 2: '43' '"MyDocs"' '5'         -> '43' 'MyDocs' '5'
  //Example 3: '43' 'MyDocs' '5'           -> '43' 'MyDocs' '5'
  if AMailBoxParam > AParams.Count - 1 then begin
    Result := False;
    Exit;  //Error
  end;
  if AParams[AMailBoxParam] = '' then begin
    Result := False;
    Exit;  //Error
  end;
  LTemp := AParams[AMailBoxParam];
  if LTemp[1] <> '"' then begin   {Do not Localize}
    Result := True;
    Exit;  //This is example 3, no change.
  end;
  Result := ReassembleParams('"', AParams, AMailBoxParam);  {Do not Localize}
end;

function  TIdIMAP4Server.ReinterpretParamAsFlags(var AParams: TIdStringList; AFlagsParam: integer): Boolean;
begin
  Result := ReassembleParams('(', AParams, AFlagsParam);  {Do not Localize}
end;

function  TIdIMAP4Server.ReinterpretParamAsDataItems(var AParams: TIdStringList; AFlagsParam: integer): Boolean;
begin
  Result := ReassembleParams('(', AParams, AFlagsParam);  {Do not Localize}
end;

function  TIdIMAP4Server.FlagStringToFlagList(var AFlagList: TIdStringList; AFlagString: string): Boolean;
var
  LTemp: string;
begin
  Result := False;
  LTemp := AFlagString;
  if ( (LTemp[1] <> '(') or (LTemp[Length(LTemp)] <> ')') ) then begin  {Do not Localize}
    Exit;
  end;
  LTemp := Copy(LTemp, 2, Length(LTemp)-2);
  AFlagList.Clear;
  BreakApart(LTemp, ' ', AFlagList); {Do not Localize}
  Result := True;
end;

procedure TIdIMAP4Server.ProcessFetch(AUseUID: Boolean; ASender: TIdCommand; AParams: TIdStringList);
//There are a pile of options for this.
var
  LMessageNumbers: TIdStringList;
  LDataItems: TIdStringList;
  LM: integer;
  LN: integer;
  LO: integer;
  LRecord: integer;
  LSize: integer;
  LMessage: TIdMessage;
  LMessageRaw: TIdStringList;
  LTemp: string;
begin
  //First param is a message set, e.g. 41 or 2:5 (which is 2, 3, 4 & 5)
  LMessageNumbers := TIdStringList.Create;
  if MessageSetToMessageNumbers(AUseUID, ASender, LMessageNumbers, AParams[0]) = False then begin
    SendBadReply(ASender, 'Error in synthax of message set parameter'); {Do not Localize}
    LMessageNumbers.Free;
    Exit;
  end;
  if ReinterpretParamAsDataItems(AParams, 1) = False then begin
    SendBadReply(ASender, 'Fetch data items parameter is invalid.'); {Do not Localize}
    Exit;
  end;
  LDataItems := TIdStringList.Create;
  BreakApart(AParams[1], ' ', LDataItems);
  for LN := 0 to LMessageNumbers.Count-1 do begin
    if AUseUID = False then begin
      LRecord := StrToInt(LMessageNumbers[LN])-1;
    end else begin
      LRecord := GetRecordForUID(StrToInt(LMessageNumbers[LN]), TIdIMAP4PeerContext(ASender.Context).FMailBox);
      if LRecord = -1 then continue; //It is OK to skip non-existent UID records
    end;
    if ( (LRecord < 0) or (LRecord > TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Count) ) then begin
      SendBadReply(ASender, 'Message number '+IntToStr(LRecord+1)+' does not exist'); {Do not Localize}
      LMessageNumbers.Free;
      LDataItems.Free;
      Exit;
    end;
    for LO := 0 to LDataItems.Count-1 do begin
      if LDataItems[LO] = 'UID' then begin  {Do not Localize}
        //Format:
        //C9 FETCH 490 (UID)
        //* 490 FETCH (UID 6545)
        //C9 OK Completed
        DoSendReply(ASender.Context, '* FETCH (UID ' + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].UID + ')'); {Do not Localize}
      end else if LDataItems[LO] = 'FLAGS' then begin  {Do not Localize}
        //Format:
        //C10 UID FETCH 6545 (FLAGS)
        //* 490 FETCH (FLAGS (\Recent) UID 6545)
        //C10 OK Completed
        LTemp := '* ' + IntToStr(LRecord+1) + ' FETCH (FLAGS ('  {Do not Localize}
         +Trim(MessageFlagSetToStr(TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags));
        if AUseUID = False then begin
          LTemp := LTemp + '))';  {Do not Localize}
        end else begin
          LTemp := LTemp + ') UID '+LMessageNumbers[LN]+')';  {Do not Localize}
        end;
        DoSendReply(ASender.Context, LTemp);
      end else if LDataItems[LO] = 'RFC822.HEADER' then begin  {Do not Localize}
        //Format:
        //C11 UID FETCH 6545 (RFC822.HEADER)
        //* 490 FETCH (UID 6545 RFC822.HEADER {1654}
        //Return-Path: <[e-mail]>
        //...
        //Content-Type: multipart/alternative;
        //	boundary="----=_NextPart_000_70BE_C8606D03.F4EA24EE"
        //C10 OK Completed
        //We don't want to thrash UIDs and flags in MailBox message, so load into LMessage
        LMessage := TIdMessage.Create;
        if OnDefMechGetMessageHeader(TIdIMAP4PeerContext(ASender.Context).FLoginName,
         TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
         TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord],
         LMessage) = False then begin
          SendNoReply(ASender, 'Failed to get message header'); {Do not Localize}
          LMessage.Free;
          LMessageNumbers.Free;
          LDataItems.Free;
          Exit;
        end;
        //Need to calculate the size of the headers...
        LSize := 0;
        for LM := 0 to LMessage.Headers.Count-1 do begin
          LSize := LSize + Length(LMessage.Headers.Strings[LM]) + 2; //Allow for CR+LF
        end;
        LTemp := '* ' + IntToStr(LRecord+1) + ' FETCH (';  {Do not Localize}
        if AUseUID = True then begin
          LTemp := LTemp + 'UID '+LMessageNumbers[LN]+' ';  {Do not Localize}
        end;
        LTemp := LTemp + 'RFC822.HEADER {'+IntToStr(LSize)+'}';  {Do not Localize}
        DoSendReply(ASender.Context, LTemp);
        for LM := 0 to LMessage.Headers.Count-1 do begin
          DoSendReply(ASender.Context, LMessage.Headers.Strings[LM]);
        end;
        DoSendReply(ASender.Context, ')');  {Do not Localize}
        //Finished with the headers, free the memory...
        LMessage.Free;
      end else if LDataItems[LO] = 'RFC822.SIZE' then begin  {Do not Localize}
        //Format:
        //C12 UID FETCH 6545 (RFC822.SIZE)
        //* 490 FETCH (UID 6545 RFC822.SIZE 3447)
        //C12 OK Completed
        LSize := OnDefMechGetMessageSize(TIdIMAP4PeerContext(ASender.Context).FLoginName,
         TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
         TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord]);
        if LSize = -1 then begin
          SendNoReply(ASender, 'Failed to get message size'); {Do not Localize}
          LMessageNumbers.Free;
          LDataItems.Free;
          Exit;
        end;
        LTemp := '* ' + IntToStr(LRecord+1) + ' FETCH (';  {Do not Localize}
        if AUseUID = True then begin
          LTemp := LTemp + 'UID '+LMessageNumbers[LN]+' ';  {Do not Localize}