Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project GETMAIL

Project Structure


GETMAIL.DPR

program GetMail;

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

{$R *.RES}

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

GETMAILF.PAS

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.

GETMAILF.DFM

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