main.pas

这是一套全面的网络组件

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, clMailMessage, msgfrm,
  clTcpClient, clHttpMail, ComCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    edtServer: TEdit;
    Label2: TLabel;
    edtUser: TEdit;
    Label3: TLabel;
    edtPassword: TEdit;
    clMailMessage1: TclMailMessage;
    btnComposeMail: TButton;
    btnCheckMail: TButton;
    Label4: TLabel;
    clHttpMail1: TclHttpMail;
    lvMessages: TListView;
    procedure btnCheckMailClick(Sender: TObject);
    procedure btnComposeMailClick(Sender: TObject);
    procedure lbMessagesDblClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnCheckMailClick(Sender: TObject);
var
  i, count: Integer;
  item: TListItem;
begin
  if clHttpMail1.Active then Exit;

  clHttpMail1.Server := edtServer.Text;
  clHttpMail1.UserName := edtUser.Text;
  clHttpMail1.Password := edtPassword.Text;

  clHttpMail1.GetFolders();
  clHttpMail1.SelectFolder(clHttpMail1.Inbox);

  lvMessages.Items.Clear();

  count := clHttpMail1.Messages.Count;
  for i := 0 to count - 1 do
  begin
    item := lvMessages.Items.Add();

    item.Caption := clHttpMail1.Messages[i].Subject;
    item.SubItems.Add(clHttpMail1.Messages[i].From);
    item.SubItems.Add(clHttpMail1.Messages[i].Date);
    item.SubItems.Add(IntToStr(clHttpMail1.Messages[i].ContentLength));

    item.SubItems.Add(clHttpMail1.Messages[i].Href);
  end;

  ShowMessage(Format('Collecting completed, %d messages in the mailbox', [count]));
end;

procedure TForm1.btnComposeMailClick(Sender: TObject);
var
  dlg: TMessageForm;
begin
  if clHttpMail1.Active then Exit;

  dlg := TMessageForm.Create(nil);
  try
    dlg.edtFrom.Text := edtUser.Text;
    if dlg.ShowModal() = mrOK then
    begin
      clMailMessage1.BuildMessage(dlg.memBody.Lines.Text, '');
      clMailMessage1.From := dlg.edtFrom.Text;
      clMailMessage1.ToList.Text := dlg.edtTo.Text;
      clMailMessage1.Subject := dlg.edtSubject.Text;

      dlg.btnSend.Enabled := True;

      clHttpMail1.Server := edtServer.Text;
      clHttpMail1.UserName := edtUser.Text;
      clHttpMail1.Password := edtPassword.Text;

      clHttpMail1.Send(clMailMessage1);

      ShowMessage('The message was sent successfully');
    end;
  finally
    dlg.Free();
  end;
end;

procedure TForm1.lbMessagesDblClick(Sender: TObject);
var
  dlg: TMessageForm;
begin
  if clHttpMail1.Active or (lvMessages.ItemIndex < 0) then Exit;

  clHttpMail1.Server := edtServer.Text;
  clHttpMail1.UserName := edtUser.Text;
  clHttpMail1.Password := edtPassword.Text;

  dlg := TMessageForm.Create(nil);
  try
    clHttpMail1.Retrieve(lvMessages.Items[lvMessages.ItemIndex].SubItems[3], clMailMessage1);

    dlg.edtFrom.Text := clMailMessage1.From;
    dlg.edtTo.Text := Trim(clMailMessage1.ToList.Text);
    dlg.edtSubject.Text := clMailMessage1.Subject;

    clMailMessage1.GetBodyText(dlg.memBody.Lines);

    dlg.edtFrom.ReadOnly := True;
    dlg.edtTo.ReadOnly := True;
    dlg.edtSubject.ReadOnly := True;
    dlg.memBody.ReadOnly := True;
    dlg.btnSend.Enabled := False;

    dlg.ShowModal();
  finally
    dlg.Free();
  end;
end;

end.