E-mail replying / forwarding

Download source code

procedure TForm1.MakeTextReply(ABody: TclTextBody; AText: TStrings);
var
  i: Integer;
begin
  AText.Add('Reply follows here');
  AText.Add('');
  AText.Add('');
 
  for i := 0 to ABody.Strings.Count - 1 do
  begin
    AText.Add('> ' + ABody.Strings[i]);
  end;
end;
 
procedure TForm1.MakeHtmlReply(ABody: TclTextBody; AHtml: TStrings);
const
  BLOCKQUOTEStart = '<BLOCKQUOTE + style="PADDING-RIGHT: 0px; PADDING-LEFT: 5px; MARGIN-LEFT: 5px; BORDER-LEFT: #000000 2px solid; MARGIN-RIGHT: 0px">';
  BLOCKQUOTEEnd = '</BLOCKQUOTE>';
var
  tag: TclHtmlTag;
  s, reply: string;
  id: Integer;
begin
  reply := '<DIV>Reply follows here</DIV>';
  s := ABody.Strings.Text;
 
  clHtmlParser1.Parse(s);
 
  tag := clHtmlParser1.Tags.TagByName('BODY');
  Insert(reply + BLOCKQUOTEStart, s, tag.InnerTextPos);
 
  id := clHtmlParser1.Tags.IndexOf(clHtmlParser1.Tags.TagByName('BODY', tag.NextTag));
  tag := clHtmlParser1.Tags[id - 1];
  Insert(BLOCKQUOTEEnd, s, tag.InnerTextPos + Length(reply + BLOCKQUOTEStart));
 
  AHtml.Text := s;
end;
 
function TForm1.SendEmailMessage(const AToAddress, ASubject: string): Boolean;
var
  dlg: TMessageForm;
  text: string;
begin
  dlg := TMessageForm.Create(nil);
  try
    dlg.edtTo.Text := AToAddress;
    dlg.edtSubject.Text := ASubject;
 
    if (clMailMessage1.Html <> nil) then
    begin
      MakeHtmlReply(clMailMessage1.Html, dlg.memText.Lines);
    end else
    if (clMailMessage1.Text <> nil) then
    begin
      MakeTextReply(clMailMessage1.Text, dlg.memText.Lines);
    end;
 
    Result := (dlg.ShowModal() = mrOK);
     
    if Result then
    begin
      clMailMessage1.BuildMessage(dlg.memText.Lines.Text, '');
 
      clMailMessage1.From.FullAddress := dlg.edtFrom.Text;
      clMailMessage1.ToList.EmailAddresses := dlg.edtTo.Text;
      clMailMessage1.Subject := dlg.edtSubject.Text;
 
      clSmtp1.Send(clMailMessage1);
    end;
  finally
    dlg.Free();
  end;
end;
 
procedure TForm1.btnForwardClick(Sender: TObject);
begin
  clPop31.Retrieve(ListBox1.ItemIndex + 1, clMailMessage1);
  SendEmailMessage('', 'Fw: ' + clMailMessage1.Subject);
end;
 
procedure TForm1.btnReplyClick(Sender: TObject);
begin
  clPop31.Retrieve(ListBox1.ItemIndex + 1, clMailMessage1);
  SendEmailMessage(clMailMessage1.From.FullAddress, 'Re: ' + clMailMessage1.Subject);
end;

Add Feedback