📄 idimap4server.pas
字号:
end;
LTemp := LTemp + 'RFC822.SIZE '+IntToStr(LSize)+')'; {Do not Localize}
DoSendReply(ASender.Context, LTemp);
end else if ( (LDataItems[LO] = 'BODY.PEEK[]') or (LDataItems[LO] = 'BODY[]') or (LDataItems[LO] = 'RFC822') or (LDataItems[LO] = 'RFC822.PEEK') ) then begin {Do not Localize}
//All are the same, except the return string is different...
//Get a pointer to the message rather than repetitively calculating it (or typing it in!)...
LMessage := TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord];
LMessageRaw := TIdStringList.Create;
if OnDefMechGetMessageRaw(TIdIMAP4PeerContext(ASender.Context).FLoginName,
TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
LMessage,
LMessageRaw) = False then begin
SendNoReply(ASender, 'Failed to get raw message'); {Do not Localize}
LMessageRaw.Free;
LMessageNumbers.Free;
LDataItems.Free;
Exit;
end;
LSize := 0;
for LM := 0 to LMessage.Headers.Count-1 do begin
LSize := LSize + Length(LMessageRaw.Strings[LM]) + 2; //Allow for CR+LF
end;
LSize := LSize + 3; //The message terminator '.CRLF'
LTemp := '* ' + IntToStr(LRecord+1) + ' FETCH ('; {Do not Localize}
LTemp := LTemp + 'FLAGS (' {Do not Localize}
+ Trim(MessageFlagSetToStr(TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags))
+ ') '; {Do not Localize}
if AUseUID = True then begin
LTemp := LTemp + 'UID '+LMessageNumbers[LN]+' '; {Do not Localize}
end;
LTemp := LTemp + Copy(AParams[1], 2, Length(AParams[1])-2)+' {'+IntToStr(LSize)+'}'; {Do not Localize}
DoSendReply(ASender.Context, LTemp);
for LM := 0 to LMessage.Headers.Count-1 do begin
DoSendReply(ASender.Context, LMessageRaw.Strings[LM]);
end;
DoSendReply(ASender.Context, '.'); {Do not Localize}
DoSendReply(ASender.Context, ')'); {Do not Localize}
//Free the memory...
LMessageRaw.Free;
end else if LDataItems[LO] = 'BODYSTRUCTURE' then begin {Do not Localize}
//Format:
//C49 UID FETCH 6545 (BODYSTRUCTURE)
//* 490 FETCH (UID 6545 BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "7BIT" 290 8 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "7BIT" 1125 41 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY"
//C12 OK Completed
SendBadReply(ASender, 'Parameter not supported: '+AParams[1]); {Do not Localize}
end else if ( (Copy(LDataItems[LO],1,6) = 'BODY[') or (Copy(LDataItems[LO],1,11) = 'BODY.PEEK[') ) then begin {Do not Localize}
//Format:
//C50 UID FETCH 6545 (BODY[1])
//* 490 FETCH (FLAGS (\Recent \Seen) UID 6545 BODY[1] {290}
//...
//)
//C50 OK Completed
SendBadReply(ASender, 'Parameter not supported: '+AParams[1]); {Do not Localize}
end else begin
SendBadReply(ASender, 'Parameter not supported: '+AParams[1]); {Do not Localize}
LMessageNumbers.Free;
LDataItems.Free;
Exit;
end;
end;
end;
LDataItems.Free;
LMessageNumbers.Free;
SendOkCompleted(ASender);
end;
procedure TIdIMAP4Server.ProcessSearch(AUseUID: Boolean; ASender: TIdCommand; AParams: TIdStringList);
//if AUseUID is True, return UIDs rather than relative message numbers.
var
//LParams: TIdStringList;
LSearchString: string;
LN: integer;
LM: integer;
LMessage: TIdMessage;
LHits: string;
begin
//Watch out: you could become an old man trying to implement all the IMAP
//search options, just do a subset.
//Format:
//C1065 UID SEARCH FROM "visible"
//* SEARCH 5769 5878
//C1065 OK Completed (2 msgs in 0.010 secs)
//LParams := TIdStringList.Create;
//BreakApart(ASender.UnparsedParams, ' ', LParams); {Do not Localize}
if AParams.Count < 2 then begin //The only search options we support are 2-param ones
SendIncorrectNumberOfParameters(ASender);
//LParams.Free;
Exit;
end;
if (
(UpperCase(AParams[0]) <> 'FROM') and {Do not Localize}
(UpperCase(AParams[0]) <> 'TO') and {Do not Localize}
(UpperCase(AParams[0]) <> 'CC') and {Do not Localize}
(UpperCase(AParams[0]) <> 'BCC') and {Do not Localize}
(UpperCase(AParams[0]) <> 'SUBJECT') {Do not Localize}
) then begin
SendBadReply(ASender, 'Unsupported search method'); {Do not Localize}
//LParams.Free;
Exit;
end;
//Reassemble the other params into a line, because "Ciaran Costelloe" will be params 1 & 2...
LSearchString := AParams[1];
for LN := 2 to AParams.Count-1 do begin
LSearchString := LSearchString + ' ' + AParams[LN]; {Do not Localize}
end;
if ( (LSearchString[1] = '"') and (LSearchString[Length(LSearchString)] = '"') ) then begin {Do not Localize}
LSearchString := Copy(LSearchString, 2, Length(LSearchString)-2);
end;
LMessage := TIdMessage.Create;
for LN := 0 to TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Count-1 do begin
if OnDefMechGetMessageHeader(TIdIMAP4PeerContext(ASender.Context).FLoginName,
TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN],
LMessage) = False then begin
SendNoReply(ASender, 'Failed to get message header'); {Do not Localize}
LMessage.Free;
//LParams.Free;
Exit;
end;
if UpperCase(AParams[0]) = 'FROM' then begin {Do not Localize}
if Pos(UpperCase(LSearchString), UpperCase(LMessage.From.Address)) > 0 then begin
if AUseUID = False then begin
LHits := LHits + IntToStr(LN+1) + ' '; {Do not Localize}
end else begin
LHits := LHits + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].UID + ' '; {Do not Localize}
end;
end;
end else if UpperCase(AParams[0]) = 'TO' then begin {Do not Localize}
for LM := 0 to LMessage.Recipients.Count-1 do begin
if Pos(UpperCase(LSearchString), UpperCase(LMessage.Recipients.Items[LM].Address)) > 0 then begin
if AUseUID = False then begin
LHits := LHits + IntToStr(LN+1) + ' '; {Do not Localize}
end else begin
LHits := LHits + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].UID + ' '; {Do not Localize}
end;
break; //Don't want more than 1 hit on this record
end;
end;
end else if UpperCase(AParams[0]) = 'CC' then begin {Do not Localize}
for LM := 0 to LMessage.Recipients.Count-1 do begin
if Pos(UpperCase(LSearchString), UpperCase(LMessage.CCList.Items[LM].Address)) > 0 then begin
if AUseUID = False then begin
LHits := LHits + IntToStr(LN+1) + ' '; {Do not Localize}
end else begin
LHits := LHits + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].UID + ' '; {Do not Localize}
end;
break; //Don't want more than 1 hit on this record
end;
end;
end else if UpperCase(AParams[0]) = 'BCC' then begin {Do not Localize}
for LM := 0 to LMessage.Recipients.Count-1 do begin
if Pos(UpperCase(LSearchString), UpperCase(LMessage.BCCList.Items[LM].Address)) > 0 then begin
if AUseUID = False then begin
LHits := LHits + IntToStr(LN+1) + ' '; {Do not Localize}
end else begin
LHits := LHits + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].UID + ' '; {Do not Localize}
end;
break; //Don't want more than 1 hit on this record
end;
end;
end else if UpperCase(AParams[0]) = 'SUBJECT' then begin {Do not Localize}
if Pos(UpperCase(LSearchString), UpperCase(LMessage.Subject)) > 0 then begin
if AUseUID = False then begin
LHits := LHits + IntToStr(LN+1) + ' '; {Do not Localize}
end else begin
LHits := LHits + TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LN].UID + ' '; {Do not Localize}
end;
end;
end;
end;
LMessage.Free;
//LParams.Free;
Trim(LHits);
DoSendReply(ASender.Context, '* SEARCH '+LHits); {Do not Localize}
SendOkCompleted(ASender);
end;
procedure TIdIMAP4Server.ProcessCopy(AUseUID: Boolean; ASender: TIdCommand; AParams: TIdStringList);
var
LMessageNumbers: TIdStringList;
LN: integer;
LRecord: integer;
LResult: Boolean;
begin
//Format is "C1 COPY 2:4 MEETINGFOLDER"
if OnDefMechReinterpretParamAsMailBox(AParams, 1) = False then begin
SendBadReply(ASender, 'Mailbox parameter is invalid.'); {Do not Localize}
Exit;
end;
if AParams.Count <> 2 then begin
SendIncorrectNumberOfParameters(ASender);
Exit;
end;
//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 not Assigned(OnDefMechDoesImapMailBoxExist) then begin
SendUnassignedDefaultMechanism(ASender);
LMessageNumbers.Free;
Exit;
end;
if OnDefMechDoesImapMailBoxExist(TIdIMAP4PeerContext(ASender.Context).FLoginName, AParams[1]) = False then begin
SendNoReply(ASender, 'NO Mailbox does not exist.'); {Do not Localize}
LMessageNumbers.Free;
Exit;
end;
LResult := True;
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 OnDefMechCopyMessage(TIdIMAP4PeerContext(ASender.Context).FLoginName,
TIdIMAP4PeerContext(ASender.Context).FMailBox.Name,
TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].UID,
AParams[1]) = False then begin
LResult := False;
end;
end;
if LResult = True then begin
SendOkCompleted(ASender);
end else begin
SendNoReply(ASender, 'Copy failed for one or more messages'); {Do not Localize}
end;
LMessageNumbers.Free;
end;
function TIdIMAP4Server.ProcessStore(AUseUID: Boolean; ASender: TIdCommand; AParams: TIdStringList): Boolean;
var
LMessageNumbers: TIdStringList;
LFlagList: TIdStringList;
LN: integer;
LM: integer;
LRecord: integer;
LTemp: string;
LStoreMethod: TIdIMAP4StoreDataItem;
LSilent: Boolean;
begin
//Format is:
//C53 UID STORE 6545,6544 +FLAGS.SILENT (\Deleted)
//C53 OK Completed
Result := False;
if AParams.Count < 3 then begin
SendIncorrectNumberOfParameters(ASender);
Exit;
end;
//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;
LTemp := AParams[1];
if LTemp[1] = '+' then begin {Do not Localize}
LStoreMethod := sdAdd;
LTemp := Copy(LTemp, 2, MAXINT);
end else if LTemp[1] = '-' then begin {Do not Localize}
LStoreMethod := sdRemove;
LTemp := Copy(LTemp, 2, MAXINT);
end else begin
LStoreMethod := sdReplace;
end;
if LTemp = 'FLAGS' then begin {Do not Localize}
LSilent := False;
end else if LTemp = 'FLAGS.SILENT' then begin {Do not Localize}
LSilent := True;
end else begin
SendBadReply(ASender, 'Error in synthax of FLAGS parameter'); {Do not Localize}
LMessageNumbers.Free;
Exit;
end;
LFlagList := TIdStringList.Create;
//Assemble remaining flags back into a string...
LTemp := AParams[2];
for LN := 3 to AParams.Count-1 do begin
LTemp := ' '+AParams[LN]; {Do not Localize}
end;
if FlagStringToFlagList(LFlagList, LTemp) = False then begin
SendBadReply(ASender, 'Error in synthax of flag set parameter'); {Do not Localize}
LFlagList.Free;
LMessageNumbers.Free;
Exit;
end;
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 LStoreMethod = sdReplace then begin
TIdIMAP4PeerContext(ASender.Context).FMailBox.MessageList.Messages[LRecord].Flags := [];
end;
case LStoreMethod of
sdAdd, sdReplace:
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -