demoform.pas

Documentation included in source code (mail2000.pas).

unit DemoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Mail2000;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    bConnect: TButton;
    Label1: TLabel;
    eHost: TEdit;
    Label2: TLabel;
    eUsername: TEdit;
    Label3: TLabel;
    ePassword: TEdit;
    lStatus: TLabel;
    bDisconnect: TButton;
    bRetrieve: TButton;
    eMsgNum: TEdit;
    UpDown1: TUpDown;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    PageControl2: TPageControl;
    TabSheet4: TTabSheet;
    mHeader: TMemo;
    TabSheet5: TTabSheet;
    Label7: TLabel;
    eFromName: TEdit;
    Label8: TLabel;
    eFromAddress: TEdit;
    Label10: TLabel;
    eReplyName: TEdit;
    Label11: TLabel;
    eReplyAddress: TEdit;
    TabSheet6: TTabSheet;
    mTextHtml: TMemo;
    Label6: TLabel;
    lbFiles: TListBox;
    bSave: TButton;
    bAttach: TButton;
    Label5: TLabel;
    bHtml: TButton;
    Label9: TLabel;
    mTextPlain: TMemo;
    bPlain: TButton;
    Label12: TLabel;
    eSubject: TEdit;
    Label13: TLabel;
    dtDate: TDateTimePicker;
    dtTime: TDateTimePicker;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    eLabel: TEdit;
    Label21: TLabel;
    eValue: TEdit;
    bLabel: TButton;
    bDelLabel: TButton;
    Label22: TLabel;
    mBody: TMemo;
    OpenDialog: TOpenDialog;
    bRebuild: TButton;
    bReset: TButton;
    bRefresh: TButton;
    Label23: TLabel;
    eSmtpHost: TEdit;
    bSmtpConnect: TButton;
    bSmtpDisconnect: TButton;
    bSend: TButton;
    POP: TPOP2000;
    SMTP: TSMTP2000;
    Label4: TLabel;
    Label24: TLabel;
    SaveDialog: TSaveDialog;
    bSaveMsg: TButton;
    Label25: TLabel;
    bLoadMsg: TButton;
    bRemove: TButton;
    bPlainRemove: TButton;
    bHtmlRemove: TButton;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    ProgressBar3: TProgressBar;
    Msg: TMailMessage2000;
    Label26: TLabel;
    ePort: TEdit;
    Label27: TLabel;
    eSmtpPort: TEdit;
    Label28: TLabel;
    eToName: TEdit;
    Label29: TLabel;
    eToAddress: TEdit;
    bAddTo: TButton;
    bAddCc: TButton;
    bClearTo: TButton;
    bClearCc: TButton;
    mToNames: TListBox;
    mToAddresses: TListBox;
    mCcNames: TListBox;
    mCcAddresses: TListBox;
    TabSheet7: TTabSheet;
    mHops: TMemo;
    mResponse: TMemo;
    mSmtpResponse: TMemo;
    Label31: TLabel;
    bSaveHeader1: TButton;
    cbEmbedded: TCheckBox;
    bNormalize: TButton;
    cbHeader: TCheckBox;
    bDelete: TButton;
    bUIDL: TButton;
    Label30: TLabel;
    lSmtpStatus: TLabel;
    bAbort: TButton;
    bSmtpAbort: TButton;
    bFindParts: TButton;
    procedure bConnectClick(Sender: TObject);
    procedure bDisconnectClick(Sender: TObject);
    procedure bRetrieveClick(Sender: TObject);
    procedure bRefreshClick(Sender: TObject);
    procedure bRebuildClick(Sender: TObject);
    procedure bResetClick(Sender: TObject);
    procedure bLabelClick(Sender: TObject);
    procedure bDelLabelClick(Sender: TObject);
    procedure bSaveHeaderClick(Sender: TObject);
    procedure bSaveClick(Sender: TObject);
    procedure bAttachClick(Sender: TObject);
    procedure bPlainClick(Sender: TObject);
    procedure bHtmlClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure bSaveMsgClick(Sender: TObject);
    procedure bSmtpConnectClick(Sender: TObject);
    procedure bSmtpDisconnectClick(Sender: TObject);
    procedure bSendClick(Sender: TObject);
    procedure bLoadMsgClick(Sender: TObject);
    procedure bRemoveClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure POPProgress(Sender: TObject; Total, Current: Integer);
    procedure MsgProgress(Sender: TObject; Total, Current: Integer);
    procedure SMTPProgress(Sender: TObject; Total, Current: Integer);
    procedure bPlainRemoveClick(Sender: TObject);
    procedure bHtmlRemoveClick(Sender: TObject);
    procedure bAddToClick(Sender: TObject);
    procedure bAddCcClick(Sender: TObject);
    procedure bClearToClick(Sender: TObject);
    procedure bClearCcClick(Sender: TObject);
    procedure mToNamesClick(Sender: TObject);
    procedure mToAddressesClick(Sender: TObject);
    procedure mCcNamesClick(Sender: TObject);
    procedure mCcAddressesClick(Sender: TObject);
    procedure bNormalizeClick(Sender: TObject);
    procedure bDeleteClick(Sender: TObject);
    procedure bUIDLClick(Sender: TObject);
    procedure bAbortClick(Sender: TObject);
    procedure bSmtpAbortClick(Sender: TObject);
    procedure bFindPartsClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.bConnectClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  POP.UserName := eUserName.Text;
  POP.Password := ePassword.Text;
  POP.Host := eHost.Text;
  POP.Port := StrToInt(ePort.Text);

  if POP.Connect then
  begin

    if POP.Login then
    begin

      lStatus.Caption := IntToStr(POP.SessionMessageCount)+' messages on server';
      bDisconnect.Enabled := True;
      bRetrieve.Enabled := True;
      bDelete.Enabled := True;
      bUIDL.Enabled := True;
      bConnect.Enabled := False;
      UpDown1.Max := POP.SessionMessageCount;
      mResponse.Lines.Text := POP.LastResponse;
    end
    else
    begin

      POP.Abort;
      mResponse.Lines.Text := POP.LastResponse;
      lStatus.Caption := 'Failed on login';
    end;
  end
  else
  begin

    POP.Abort;
    mResponse.Lines.Text := POP.LastResponse;
    lStatus.Caption := 'Failed on connect';
  end;

  Screen.Cursor := crDefault;
end;

procedure TForm1.bDisconnectClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;

  if POP.Quit then
  begin

    lStatus.Caption := 'Disconnected';
  end
  else
  begin

    POP.Abort;
    lStatus.Caption := 'Failed on quit';
  end;

  bDisconnect.Enabled := False;
  bRetrieve.Enabled := False;
  bDelete.Enabled := False;
  bUIDL.Enabled := False;
  bConnect.Enabled := True;
  mResponse.Lines.Text := POP.LastResponse;
  Screen.Cursor := crDefault;
end;

procedure TForm1.bRetrieveClick(Sender: TObject);
var
  Result: Boolean;

begin

  Screen.Cursor := crHourglass;
  ProgressBar1.Position := 0;
  ProgressBar2.Position := 0;

  if cbHeader.Checked then
    Result := POP.RetrieveHeader(StrToInt(eMsgNum.Text))
  else
    Result := POP.RetrieveMessage(StrToInt(eMsgNum.Text));

  if Result then
  begin

    bRefreshClick(Sender);
  end
  else
  begin

    lStatus.Caption := 'Failed on retrieve';
  end;

  mResponse.Lines.Text := Copy(POP.LastResponse, 1, 10000);
  Screen.Cursor := crDefault;
end;

procedure TForm1.bRefreshClick(Sender: TObject);
var
  Loop: Integer;
  Text: String;

begin

  Screen.Cursor := crHourglass;

  SetLength(Text, Msg.Body.Size);

  if Length(Text) > 0 then
  begin

    Msg.Body.Position := 0;
    Msg.Body.ReadBuffer(Text[1], Msg.Body.Size);
  end;

  mHeader.Lines.Text := Copy(Msg.Header.Text, 1, 10000);
  mBody.Lines.Text := Copy(Text, 1, 10000);
  eFromName.Text := Msg.FromName;
  eFromAddress.Text := Msg.FromAddress;
  eReplyName.Text := Msg.ReplyToName;
  eReplyAddress.Text := Msg.ReplyToAddress;
  eSubject.Text := Msg.Subject;
  dtDate.DateTime := Msg.Date;
  dtTime.DateTime := Msg.Date;

  mToNames.Clear;
  mToAddresses.Clear;
  mCcNames.Clear;
  mCcAddresses.Clear;
  lbFiles.Clear;

  mTextPlain.Lines.Text := Msg.TextPlain.Text;
  mTextHtml.Lines.Text := Msg.TextHTML.Text;

  mToNames.Items.CommaText := Msg.ToList.AllNames;
  mToAddresses.Items.CommaText := Msg.ToList.AllAddresses;

  mCcNames.Items.CommaText := Msg.CcList.AllNames;
  mCcAddresses.Items.CommaText := Msg.CcList.AllAddresses;

  for Loop := 0 to Msg.AttachList.Count-1 do
  begin

    if Msg.AttachList[Loop].Decoded.Size = 0 then
      Msg.AttachList[Loop].Decode;

    if Msg.AttachList[Loop].Embedded then
      lbFiles.Items.Add(Msg.AttachList[Loop].FileName+#32'('+IntToStr(Msg.AttachList[Loop].Decoded.Size)+')'#32+Msg.AttachList[Loop].AttachInfo+#32'Embedded')
    else
      lbFiles.Items.Add(Msg.AttachList[Loop].FileName+#32'('+IntToStr(Msg.AttachList[Loop].Decoded.Size)+')'#32+Msg.AttachList[Loop].AttachInfo);
  end;

  if Msg.NeedFindParts then
    bFindParts.Font.Style := [fsBold]
  else
    bFindParts.Font.Style := [];

  if Msg.NeedNormalize then
    bNormalize.Font.Style := [fsBold]
  else
    bNormalize.Font.Style := [];

  if Msg.NeedRebuild then
    bRebuild.Font.Style := [fsBold]
  else
    bRebuild.Font.Style := [];

  mHops.Clear;

  for Loop := Msg.ReceivedCount-1 downto 0 do
  begin

    mHops.Lines.Add(FormatDateTime('yyyy-mm-dd hh:nn:ss', Msg.Received[Loop].Date)+
                    #32'By ('+Msg.Received[Loop].By+')'+
                    #32'From ('+Msg.Received[Loop].From+')'+
                    #32'For ('+Msg.Received[Loop].Address+')');
  end;

  Screen.Cursor := crDefault;
end;

procedure TForm1.bRebuildClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.RebuildBody;
  bRefreshClick(Sender);
  Screen.Cursor := crDefault;
end;

procedure TForm1.bResetClick(Sender: TObject);
begin

  Screen.Cursor := crHourglass;
  Msg.Reset;
  Screen.Cursor := crDefault;
  bRefreshClick(Sender);
end;

procedure TForm1.bLabelClick(Sender: TObject);
begin

  Msg.SetLabelValue(eLabel.Text, eValue.Text);