"Anthoni Gardner" <nonononon@nononon.com> wrote in message
news:442070ac@newsgroups.borland.com...
> What I was thinking here, was I could just delete this entire messge
> safely and alert the user that an attachment has been found and the
> entire message has been discarded.
>
> In the other section, I just use that to output the actual email content
> (hopefully).
The TIdText items will usually (but not always) appear before the
TIdAttachment items in the collection. So you shouldn't process the text as
soon as you encounter it in the loop. You should delay processing of it
until after you have determined that there are no attachments present. For
example (untested):
function TForm1.GetNextSiblingPart(AParts: TIdMessageParts; APart:
TIdText): TIdText;
var
I: Integer:
begin
Result := nil;
if APart = nil then Exit;
for I := APart.Index+1 to Pred(AParts.Count) do
begin
if AParts[I].ParentPart = APart.ParentPart then
begin
Result := AParts[I] as TIdText;
Exit;
end;
if AParts[I].ParentPart < APart.Index then Exit;
end;
end;
function TForm1.GetPrevSiblingPart(AParts: TIdMessageParts; APart:
TIdText): TIdText;
var
I: Integer:
begin
Result := nil;
if APart = nil then Exit;
for I := Pred(APart.Index) downto 0 do
begin
if AParts[I].ParentPart = APart.ParentPart then
begin
Result := AParts[I] as TIdText;
Exit;
end;
if AParts[I].ParentPart < APart.Index then Exit;
end;
end;
function TForm1.GetFirstChildPart(AParts: TIdMessageParts; AParentPart:
TIdText): TIdText;
var
I: Integer:
txtPart: TIdText;
begin
if AParentPart = nil then begin
Result := AParts[0] as TIdText;
Exit;
end;
if AParentPart.Index < Pred(AParts.Count) then begin
txtPart := AParts[AParentPart.Index+1] as TIdText;
if txtPart.ParentPart = AParentPart.Index then begin
Result := txtPart;
Exit;
end;
end;
Result := nil;
end;
function TForm1.GetLastChildPart(AParts: TIdMessageParts; AParentPart:
TIdText): TIdText;
var
txtPart: TIdText;
begin
Result := nil;
txtPart := GetFirstChildPart(AParts, AParentPart);
while txtPart <> nil do begin
Result := txtPart;
txtPart = GetNextSiblingPart(AParts, txtPart);
end;
end;
function TForm1.CheckTextPart(APart: TIdText): TStrings;
begin
if (APart.ContentType is a type you support) then begin
Result := APart.Body;
end else begin
Result := nil;
end;
end;
function TForm1.FindMultipartMessageBody(const AType: String; AParts:
TIdMessageParts; AParentPart: TIdText = nil): TStrings;
var
txtPart: TIdText;
bIsAlternative: Boolean;
begin
Result := nil;
bIsAlternative: := TextIsSame(AType, 'multipart/alternative');
if bIsAlternative then begin
txtPart := GetLastChildPart(AParts, AParentPart);
end else begin
txtPart := GetFirstChildPart(AParts, AParentPart);
end;
while txtPart <> nil do
begin
if TextIsSame(Copy(txtPart.ContentType, 1, 10), 'multipart/')
then begin
Result := FindMultipartMessageBody(txtPart.ContentType,
AParts, txtPart);
end else begin
Result := CheckTextPart(txtPart);
end;
if Result <> nil then Exit;
if bIsAlternative then begin
txtPart := GetPrevSiblingPart(AParts, txtPart);
end else begin
txtPart := GetNextSiblingPart(AParts, txtPart);
end;
end;
end;
function TForm1.FindMessageBody(AParts: TIdMessageParts): TStrings;
var
I: Integer;
txtPart: TIdText;
begin
for I := 0 to Pred(Parts.Count) do
begin
txtPart = Msg.MessageParts[I] as TIdText;
if TextIsSame(Copy(txtPart.ContentType, 1, 10), 'multipart/')
then begin
Result := FindMultipartMessageBody(txtPart.ContentType,
AParts, txtPart);
end else begin
Result := CheckTextPart(txtPart);
end;
if Result <> nil then Exit;
end;
Result := nil;
end;
function TForm1.ProcessMessage(AMsg: TIdMessage): Boolean;
var
strBody: TStrings;
begin
Result := False;
strBody := nil;
if AMsg.MessageParts.Count > 0 then
begin
AMsg.MessageParts.CountParts;
if AMsg.MessageParts.AttachmentCount <> 0 then begin
Exit;
end;
if TextIsSame(Copy(AMsg.ContentType, 1, 10), 'multipart/') then
begin
strBody := FindMultipartMessageBody(AMsg.ContentType,
AMsg.MessageParts);
end else begin
strBody := FindMessageBody(AMsg.MessageParts);
end;
end
else if (AMsg.ContentType is a type you support) then begin
strBody := AMsg.Body;
end;
if strBody = nil then Exit;
// use strBody as needed ...
Result := True;
end;
procedure TForm1.DoSomething;
begin
//...
if not ProcessMessage(IdMessage) then
begin
// discard the message ...
end;
//...
end;
Gambit
