idimap4server.pas

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

          for LM := 0 to LFlagList.Count-1 do begin
            //Support \Answered \Flagged \Draft \Deleted \Seen
            if LFlagList[LM] = '\Answered' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags +
               [mfAnswered];
            end else if LFlagList[LM] = '\Flagged' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags +
               [mfFlagged];
            end else if LFlagList[LM] = '\Draft' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags +
               [mfDraft];
            end else if LFlagList[LM] = '\Deleted' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags +
               [mfDeleted];
            end else if LFlagList[LM] = '\Seen' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags +
               [mfSeen];
            end;
          end;
        end;
      sdRemove:
        begin
          for LM := 0 to LFlagList.Count-1 do begin
            //Support \Answered \Flagged \Draft \Deleted \Seen
            if LFlagList[LM] = '\Answered' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags -
               [mfAnswered];
            end else if LFlagList[LM] = '\Flagged' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags -
               [mfFlagged];
            end else if LFlagList[LM] = '\Draft' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags -
               [mfDraft];
            end else if LFlagList[LM] = '\Deleted' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags -
               [mfDeleted];
            end else if LFlagList[LM] = '\Seen' then begin  {Do not Localize}
              TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags :=
               TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags -
               [mfSeen];
            end;
          end;
        end;
    end;
    if LSilent = False then begin
      //In this case, send to the client the current flags.
      //The response is '* 43 FETCH (FLAGS (\Seen))' with the UID version
      //being '* 43 FETCH (FLAGS (\Seen) UID 1234)'.  Note the first number is the
      //relative message number in BOTH cases.
      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;
  end;
  DoSendReply(ASender.Context, FLastCommand.SequenceNumber + ' OK STORE Completed'); {Do not Localize}
  LFlagList.Free;
  LMessageNumbers.Free;
  Result := True;
end;

procedure TIdIMAP4Server.InitializeCommandHandlers;
begin
  with CommandHandlers.Add do begin
    Command := 'CAPABILITY';  {do not localize}
    OnCommand := DoCommandCAPABILITY;
  end;
  with CommandHandlers.Add do begin
    Command := 'NOOP';  {do not localize}
    OnCommand := DoCommandNOOP;
  end;
  with CommandHandlers.Add do begin
    Command := 'LOGOUT';  {do not localize}
    OnCommand := DoCommandLOGOUT;
  end;
  with CommandHandlers.Add do begin
    Command := 'AUTHENTICATE';  {do not localize}
    OnCommand := DoCommandAUTHENTICATE;
  end;
  with CommandHandlers.Add do begin
    Command := 'LOGIN'; {do not localize}
    OnCommand := DoCommandLOGIN;
  end;
  with CommandHandlers.Add do begin
    Command := 'SELECT';  {do not localize}
    OnCommand := DoCommandSELECT;
  end;
  with CommandHandlers.Add do begin
    Command := 'EXAMINE'; {do not localize}
    OnCommand := DoCommandEXAMINE;
  end;
  with CommandHandlers.Add do begin
    Command := 'CREATE';  {do not localize}
    OnCommand := DoCommandCREATE;
  end;
  with CommandHandlers.Add do begin
    Command := 'DELETE';  {do not localize}
    OnCommand := DoCommandDELETE;
  end;
  with CommandHandlers.Add do begin
    Command := 'RENAME';  {do not localize}
    OnCommand := DoCommandRENAME;
  end;
  with CommandHandlers.Add do begin
    Command := 'SUBSCRIBE'; {do not localize}
    OnCommand := DoCommandSUBSCRIBE;
  end;
  with CommandHandlers.Add do begin
    Command := 'UNSUBSCRIBE'; {do not localize}
    OnCommand := DoCommandUNSUBSCRIBE;
  end;
  with CommandHandlers.Add do begin
    Command := 'LIST';  {do not localize}
    OnCommand := DoCommandLIST;
  end;
  with CommandHandlers.Add do begin
    Command := 'LSUB';  {do not localize}
    OnCommand := DoCommandLSUB;
  end;
  with CommandHandlers.Add do begin
    Command := 'STATUS';  {do not localize}
    OnCommand := DoCommandSTATUS;
  end;
  with CommandHandlers.Add do begin
    Command := 'APPEND';  {do not localize}
    OnCommand := DoCommandAPPEND;
  end;
  with CommandHandlers.Add do begin
    Command := 'CHECK'; {do not localize}
    OnCommand := DoCommandCHECK;
  end;
  with CommandHandlers.Add do begin
    Command := 'CLOSE'; {do not localize}
    OnCommand := DoCommandCLOSE;
  end;
  with CommandHandlers.Add do begin
    Command := 'EXPUNGE'; {do not localize}
    OnCommand := DoCommandEXPUNGE;
  end;
  with CommandHandlers.Add do begin
    Command := 'SEARCH';  {do not localize}
    OnCommand := DoCommandSEARCH;
  end;
  with CommandHandlers.Add do begin
    Command := 'FETCH'; {do not localize}
    OnCommand := DoCommandFETCH;
  end;
  with CommandHandlers.Add do begin
    Command := 'STORE'; {do not localize}
    OnCommand := DoCommandSTORE;
  end;
  with CommandHandlers.Add do begin
    Command := 'COPY';  {do not localize}
    OnCommand := DoCommandCOPY;
  end;
  with CommandHandlers.Add do begin
    Command := 'UID'; {do not localize}
    OnCommand := DoCommandUID;
  end;
  with CommandHandlers.Add do begin
    Command := 'X'; {do not localize}
    OnCommand := DoCommandX;
  end;
  with CommandHandlers.Add do begin
    Command := 'STARTTLS';  {do not localize}
    OnCommand := DoCommandSTARTTLS;
  end;

  with FCommandHandlers do begin
    OnBeforeCommandHandler := DoBeforeCmd;
    OnCommandHandlersException := DoCmdHandlersException;
  end;
end;

//Command handlers

procedure TIdIMAP4Server.DoBeforeCmd(ASender: TIdCommandHandlers; var AData: string;
  AContext: TIdContext);
var
  LTmp: String;
begin
  FLastCommand.ParseRequest(AData);  //Main purpose is to get sequence number, like C11 from 'C11 CAPABILITY'
  LTmp := Fetch(AData, #32);
  AData := Trim(AData);
  TIdIMAP4PeerContext(AContext).TagData.IMAP4Tag := LTmp;
  if Assigned(fOnBeforeCmd) then begin
    fOnBeforeCmd(ASender, AData, AContext);
  end;
end;

procedure TIdIMAP4Server.DoSendReply(AContext: TIdContext; AData: string);
begin
  if Assigned(fOnBeforeSend) then begin
    fOnBeforeSend(AContext, AData);
  end;
  AContext.Connection.IOHandler.WriteLn(AData);
end;

procedure TIdIMAP4Server.DoCmdHandlersException(ACommand: String; AContext: TIdContext);
var
  LTag, LCmd: String;
begin
  if Assigned(fOnCommandError) then begin
    LTag := Fetch(ACommand, #32);
    LCmd := Fetch(ACommand, #32);
    OnCommandError(AContext, LTag, LCmd);
  end;
end;

procedure TIdIMAP4Server.DoCommandCAPABILITY(ASender: TIdCommand);
begin
  if Assigned(fOnCommandCAPABILITY) then begin
    OnCommandCAPABILITY(ASender.Context, TIdIMAP4PeerContext(ASender.Context).TagData.IMAP4Tag, ASender.UnparsedParams);
  end else if FUseDefaultMechanismsForUnassignedCommands then begin
    {Tell the client our capabilities...}
    DoSendReply(ASender.Context, FLastCommand.SequenceNumber + ' OK IMAP4rev1 AUTH=PLAIN'); {Do not Localize}
  end;
end;

procedure TIdIMAP4Server.DoCommandNOOP(ASender: TIdCommand);
begin
  if Assigned(fOnCommandNOOP) then begin
    OnCommandNOOP(ASender.Context, TIdIMAP4PeerContext(ASender.Context).TagData.IMAP4Tag, ASender.UnparsedParams);
  end else if FUseDefaultMechanismsForUnassignedCommands then begin
    {On most servers, this does nothing (they use a timeout to disconnect users,
     irrespective of NOOP commands, so they always return OK.  If you really
     want to implement it, use a countdown timer to force disconnects but reset
     the counter if ANY command received, including NOOP.}
    SendOkCompleted(ASender);
  end;
end;

procedure TIdIMAP4Server.DoCommandLOGOUT(ASender: TIdCommand);
begin
  if Assigned(fOnCommandLOGOUT) then begin
    OnCommandLOGOUT(ASender.Context, TIdIMAP4PeerContext(ASender.Context).TagData.IMAP4Tag, ASender.UnparsedParams);
  end else if FUseDefaultMechanismsForUnassignedCommands then begin
    {Be nice and say ByeBye first...}
    DoSendReply(ASender.Context, '* BYE May your God go with you.'); {Do not Localize}
    SendOkCompleted(ASender);
    ASender.Context.Connection.IOHandler.Close;
    TIdIMAP4PeerContext(ASender.Context).FMailBox.Free;
    ASender.Context.RemoveFromList;
  end;
end;

procedure TIdIMAP4Server.DoCommandAUTHENTICATE(ASender: TIdCommand);
begin
  if Assigned(fOnCommandAUTHENTICATE) then begin
    {
    Important, when usng TLS and FUseTLS=utUseRequireTLS, do not accept any authentication
    information until TLS negotiation is completed.  This insistance is a security feature.

    Some networks should choose security over interoperability while other places may
    sacrafice interoperability over security.  It comes down to sensible administrative
    judgement.
    }
    if (FUseTLS =utUseRequireTLS) and ((ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough=True) then begin
      MustUseTLS(ASender);
    end else begin
      OnCommandAUTHENTICATE(ASender.Context,TIdIMAP4PeerContext(ASender.Context).TagData.IMAP4Tag,
        ASender.UnparsedParams);
    end;
  end;
end;

procedure TIdIMAP4Server.MustUseTLS(ASender: TIdCommand);
begin
  DoSendReply(ASender.Context, 'NO '+RSSMTPSvrReqSTARTTLS); {Do not Localize}
  ASender.Disconnect := True;
end;

procedure TIdIMAP4Server.DoCommandLOGIN(ASender: TIdCommand);
var
  LParams: TIdStringList;
begin
  if Assigned(fOnCommandLOGIN) then begin
    {
    Important, when usng TLS and FUseTLS=utUseRequireTLS, do not accept any authentication
    information until TLS negotiation is completed.  This insistance is a security feature.

    Some networks should choose security over interoperability while other places may
    sacrafice interoperability over security.  It comes down to sensible administrative
    judgement.
    }
    if (FUseTLS =utUseRequireTLS) and ((ASender.Context.Connection.IOHandler as TIdSSLIOHandlerSocketBase).PassThrough=True) then begin
      MustUseTLS(ASender);
    end else begin
      OnCommandLOGIN(ASender.Context, TIdIMAP4PeerContext(ASender.Context).TagData.IMAP4Tag, ASender.UnparsedParams);
    end;
  end else if FUseDefaultMechanismsForUnassignedCommands then begin
    LParams := TIdStringList.Create;
    BreakApart(ASender.UnparsedParams, ' ', LParams); {Do not Lo