Home: Code Repository: Mastering Delphi 5

Project GETMAIL

Project Structure

GETMAIL.DPR
GETMAILF.PAS
GETMAILF.DFM

program GetMail;

uses
  Forms,
  GetMailF in 'GetMailF.pas' {NewFmForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TNewFmForm, NewFmForm);
  Application.Run;
end.

unit GetMailF;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPi, Psock, NMpop3;

type
  TNewFmForm = class(TForm)
    BtnGetMail: TButton;
    ListBoxMail: TListBox;
    Memo1: TMemo;
    BtnSave: TButton;
    PopMail: TNMPOP3;
    SaveDialog1: TSaveDialog;
    Label1: TLabel;
    procedure BtnGetMailClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
  private
    { Private declarations }
  end;

var
  NewFmForm: TNewFmForm;

implementation

{$R *.DFM}

procedure TNewFmForm.BtnGetMailClick(Sender: TObject);
var
  I, nPos: Integer;
begin
  Screen.Cursor := crHourglass;
  PopMail.Connect;
  try
    Label1.Caption := 'Messages: ' + IntToStr (PopMail.MailCount);
    for I := PopMail.MailCount downto 1 do
    begin
      PopMail.GetMailMessage (I);
      nPos := Pos ('Subscribe', PopMail.MailMessage.Subject);
      if nPos > 0 then
      begin
        ListBoxMail.Items.Add (PopMail.MailMessage.From);
        // remove the mail message
        PopMail.DeleteMailMessage (I);
      end
      else
        // error
        Memo1.Lines.Add (PopMail.MailMessage.Subject);
    end;
  finally
    Screen.Cursor := crDefault;
    PopMail.Disconnect;
  end;
end;

procedure TNewFmForm.BtnSaveClick(Sender: TObject);
begin
  if SaveDialog1.Execute then
    ListBoxMail.Items.SaveToFile (SaveDialog1.FileName);
end;

end.

object NewFmForm: TNewFmForm
  Left = 229
  Top = 106
  Width = 507
  Height = 422
  Caption = 'New From Mail'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 176
    Top = 16
    Width = 3
    Height = 13
  end
  object BtnGetMail: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Get Mail'
    TabOrder = 0
    OnClick = BtnGetMailClick
  end
  object ListBoxMail: TListBox
    Left = 8
    Top = 40
    Width = 321
    Height = 345
    ItemHeight = 13
    TabOrder = 1
  end
  object Memo1: TMemo
    Left = 336
    Top = 40
    Width = 153
    Height = 345
    Lines.Strings = (
      'Errors:')
    TabOrder = 2
  end
  object BtnSave: TButton
    Left = 88
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Save to File'
    TabOrder = 3
    OnClick = BtnSaveClick
  end
  object PopMail: TNMPOP3
    Host = 'AST'
    Port = 110
    ReportLevel = 0
    UserID = 'marco'
    Parse = False
    Password = 'marco'
    DeleteOnRead = False
    Left = 184
    Top = 8
  end
  object SaveDialog1: TSaveDialog
    Left = 232
    Top = 8
  end
end