In continuing with the email theme of my last post, I'm including one last bit of useful code: the E-mail Form. I use this form to display the details of my email files. It's not a very pretty form, but it might be a good starting point for something nicer.

One notable missing feature in this form is that the email cannot be edited and saved. I use it purely for viewing in my programs. Adding edit and save features should be easy though.

The code as written, is fairly easy to use. The main procedure to use is the "ViewEmail" procedure. Just passing it a TIdMessage will display it in a small window.

Here's the code:

Delphi Form code:


object fmViewEmail: TfmViewEmail
  Left = 445
  Top = 172
  Width = 383
  Height = 408
  Caption = 'View E-mail'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    375
    374)
  PixelsPerInch = 96
  TextHeight = 13
  object pnlButtons: TPanel
    Left = 0
    Top = 333
    Width = 375
    Height = 41
    Align = alBottom
    BevelOuter = bvNone
    TabOrder = 0
    DesignSize = (
      375
      41)
    object btnClose: TButton
      Left = 292
      Top = 8
      Width = 75
      Height = 25
      Anchors = [akRight, akBottom]
      Caption = 'Close'
      ModalResult = 1
      TabOrder = 0
    end
  end
  object edText: TMemo
    Left = 0
    Top = 129
    Width = 375
    Height = 98
    Align = alClient
    BevelInner = bvSpace
    BevelKind = bkFlat
    BevelOuter = bvRaised
    BorderStyle = bsNone
    Lines.Strings = (
      'Text')
    TabOrder = 1
  end
  object pnlAddress: TPanel
    Left = 0
    Top = 0
    Width = 375
    Height = 129
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 2
    DesignSize = (
      375
      129)
    object Label1: TLabel
      Left = 8
      Top = 8
      Width = 26
      Height = 13
      Caption = 'From:'
    end
    object Label2: TLabel
      Left = 8
      Top = 32
      Width = 16
      Height = 13
      Caption = 'To:'
    end
    object Label3: TLabel
      Left = 8
      Top = 56
      Width = 39
      Height = 13
      Caption = 'Subject:'
    end
    object Label4: TLabel
      Left = 8
      Top = 80
      Width = 43
      Height = 13
      Caption = 'Headers:'
    end
    object edFrom: TEdit
      Left = 64
      Top = 8
      Width = 304
      Height = 21
      Anchors = [akLeft, akTop, akRight]
      BevelInner = bvSpace
      BevelKind = bkFlat
      BevelOuter = bvRaised
      BorderStyle = bsNone
      ReadOnly = True
      TabOrder = 0
      Text = 'From'
    end
    object edTo: TEdit
      Left = 64
      Top = 32
      Width = 304
      Height = 21
      Anchors = [akLeft, akTop, akRight]
      BevelInner = bvSpace
      BevelKind = bkFlat
      BevelOuter = bvRaised
      BorderStyle = bsNone
      ReadOnly = True
      TabOrder = 1
      Text = 'To'
    end
    object edSubject: TEdit
      Left = 64
      Top = 56
      Width = 304
      Height = 21
      Anchors = [akLeft, akTop, akRight]
      BevelInner = bvSpace
      BevelKind = bkFlat
      BevelOuter = bvRaised
      BorderStyle = bsNone
      ReadOnly = True
      TabOrder = 2
      Text = 'Subject'
    end
    object lbHeaders: TListBox
      Left = 64
      Top = 80
      Width = 304
      Height = 41
      Anchors = [akLeft, akTop, akRight]
      BevelKind = bkSoft
      BorderStyle = bsNone
      ItemHeight = 13
      TabOrder = 3
    end
  end
  object GroupBox1: TGroupBox
    Left = 0
    Top = 227
    Width = 375
    Height = 106
    Align = alBottom
    Caption = 'Attachments'
    TabOrder = 3
    DesignSize = (
      375
      106)
    object lbAttachments: TListBox
      Left = 2
      Top = 15
      Width = 371
      Height = 66
      Align = alTop
      BevelInner = bvSpace
      BevelKind = bkSoft
      BorderStyle = bsNone
      ItemHeight = 13
      PopupMenu = pmAtt
      TabOrder = 0
      OnDblClick = lbAttachmentsDblClick
    end
    object edFolder: TJvDirectoryEdit
      Left = 1
      Top = 83
      Width = 370
      Height = 21
      DialogText = 'Select an attachment folder'
      DialogOptions = [sdAllowCreate]
      InitialDir = 'c:\'
      NumGlyphs = 1
      Anchors = [akLeft, akRight, akBottom]
      TabOrder = 1
    end
  end
  object pnlView: TPanel
    Left = 24
    Top = 8
    Width = 328
    Height = 211
    Anchors = [akLeft, akTop, akRight, akBottom]
    BevelInner = bvRaised
    BorderWidth = 3
    TabOrder = 4
    Visible = False
    object pnlViewBtn: TPanel
      Left = 5
      Top = 166
      Width = 318
      Height = 40
      Align = alBottom
      BevelOuter = bvNone
      TabOrder = 0
      object btnCloseView: TButton
        Left = 8
        Top = 8
        Width = 75
        Height = 25
        Caption = 'Close'
        TabOrder = 0
        OnClick = btnCloseViewClick
      end
    end
    object mText: TMemo
      Left = 5
      Top = 5
      Width = 318
      Height = 161
      Align = alClient
      TabOrder = 1
    end
  end
  object EmailMessage: TIdMessage
    AttachmentEncoding = 'UUE'
    BccList = <>
    CCList = <>
    Encoding = meDefault
    FromList = <
      item
      end>
    Recipients = <>
    ReplyTo = <>
    ConvertPreamble = True
    Left = 8
    Top = 338
  end
  object Zlib: TIdCompressorZLibEx
    Left = 48
    Top = 339
  end
  object pmAtt: TPopupMenu
    Left = 8
    Top = 248
    object Savetodisk1: TMenuItem
      Caption = 'Save to disk'
      OnClick = Savetodisk1Click
    end
    object Attachmentsize1: TMenuItem
      Caption = 'Attachment size'
      OnClick = Attachmentsize1Click
    end
    object ViewUncompressed1: TMenuItem
      Caption = 'View Uncompressed'
      OnClick = ViewUncompressed1Click
    end
  end
end


Delphi code:


unit ViewEmailForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdMessage, Mask, JvToolEdit,
  IdMessageParts, IdAttachmentFile, IdAttachment, IdAttachmentMemory,
  IdZLibCompressorBase, IdCompressorZLibEx, Menus, IdText;

type
  TfmViewEmail = class(TForm)
    pnlButtons: TPanel;
    edText: TMemo;
    lbAttachments: TListBox;
    pnlAddress: TPanel;
    edFrom: TEdit;
    edTo: TEdit;
    edSubject: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    GroupBox1: TGroupBox;
    btnClose: TButton;
    EmailMessage: TIdMessage;
    edFolder: TJvDirectoryEdit;
    lbHeaders: TListBox;
    Zlib: TIdCompressorZLibEx;
    pmAtt: TPopupMenu;
    Savetodisk1: TMenuItem;
    Attachmentsize1: TMenuItem;
    ViewUncompressed1: TMenuItem;
    pnlView: TPanel;
    pnlViewBtn: TPanel;
    mText: TMemo;
    btnCloseView: TButton;
    procedure lbAttachmentsDblClick(Sender: TObject);
    procedure Savetodisk1Click(Sender: TObject);
    procedure Attachmentsize1Click(Sender: TObject);
    procedure btnCloseViewClick(Sender: TObject);
    procedure ViewUncompressed1Click(Sender: TObject);
  private
    { Private declarations }
    procedure DisplayEmail;
    procedure SaveToDisk;
    procedure AttachmentSize;
    procedure ViewAttachment;
  public
    { Public declarations }
    procedure ViewEmail(var ViewEmail: TIdMessage);
  end;

var
  fmViewEmail: TfmViewEmail;

implementation

{$R *.dfm}

{ TfmViewEmail }

procedure TfmViewEmail.DisplayEmail;
var
  i: Integer;
begin
  if EmailMessage = Nil then
    Exit;
  edFrom.Text := EmailMessage.From.Address;
  edTo.Text := EmailMessage.Recipients.EMailAddresses;
  edSubject.Text := EmailMessage.Subject;
  lbHeaders.Items.Clear;
  lbHeaders.Items.Text := EmailMessage.Headers.Text;
  edText.Lines.Clear;
  edText.Lines.AddStrings(EmailMessage.Body);
  lbAttachments.Items.Clear;
  for i := 0 to EmailMessage.MessageParts.Count -1 do
    begin
      if EmailMessage.MessageParts.Items[i].PartType = mptAttachment then
        lbAttachments.Items.AddObject(TIdAttachment(EmailMessage.MessageParts.Items[i]).FileName,
            EmailMessage.MessageParts.Items[i])
      else //it's a text part
        edText.Lines.AddStrings(TIdText(EmailMessage.MessageParts.Items[i]).Body);
    end;
end;

procedure TfmViewEmail.ViewEmail(var ViewEmail: TIdMessage);
begin
  EmailMessage := ViewEmail;
  DisplayEmail;

  if (ShowModal = mrOK) then
    Exit;
end;

procedure TfmViewEmail.lbAttachmentsDblClick(Sender: TObject);
begin
  SaveToDisk;
end;

procedure TfmViewEmail.Savetodisk1Click(Sender: TObject);
begin
  SaveToDisk;
end;

procedure TfmViewEmail.SaveToDisk;
Var
  FileName: String;
  FileStream: TFileStream;
  TempStream: TMemoryStream;
begin
  if not DirectoryExists(edFolder.Text) then
    begin
      MessageDlg('You need to enter a valid folder before attempting to detach a '+#13+#10+'file.  Select a valid folder (in the select box below) and try again.', mtError, [mbOK], 0);
      Exit;
    end;
  FileName := edFolder.Text + '\' + lbAttachments.Items.Strings[lbAttachments.ItemIndex];
  if FileExists(FileName) then
    begin
      if MessageDlg('Overwrite the existing file?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
        begin
          if not DeleteFile(FileName) then
            begin
              MessageDlg('I couldn''t delete the file.  You try to do it manually, then try this '+#13+#10+'again.', mtError, [mbOK], 0);
              Exit;
            end;
        end
      else
        Exit;
    end;
  FileStream := TFileStream.Create(FileName,fmCreate);
  TempStream := TMemoryStream.Create;
  TIdAttachmentMemory(lbAttachments.Items.Objects[lbAttachments.ItemIndex]).SaveToStream(TempStream);
  TempStream.Position := 0;
  Zlib.InflateStream(TempStream,FileStream);
  FileStream.Free;
  TempStream.Free;
  //TIdAttachmentMemory(lbAttachments.Items.Objects[lbAttachments.ItemIndex]).SaveToFile(FileName);
  MessageDlg('File saved to: ' + FileName, mtInformation, [mbOK], 0);
end;

procedure TfmViewEmail.AttachmentSize;
var
  TempStream: TMemoryStream;
  FileSize: String;
begin
  TempStream := TMemoryStream.Create;
  TIdAttachment(lbAttachments.Items.Objects[lbAttachments.ItemIndex]).SaveToStream(TempStream);
  if TempStream.Size < 1024 then
    FileSize := IntToStr(TempStream.Size) + ' bytes'
  else if TempStream.Size < 1048576 then
    FileSize := IntToStr(TempStream.Size div 1024) + ' kilobytes'
  else
    FileSize := IntToStr(TempStream.Size div 1048576) + ' megabytes';

  MessageDlg('The attachment is ' + FileSize + '.', mtInformation, [mbOK], 0);
  TempStream.Free;
end;

procedure TfmViewEmail.ViewAttachment;
var
  Compressed, Uncompressed: TMemoryStream;
begin
  Compressed := TMemoryStream.Create;
  Uncompressed := TMemoryStream.Create;
  TIdAttachment(lbAttachments.Items.Objects[lbAttachments.ItemIndex]).SaveToStream(Compressed);
  Compressed.Position := 0;
  Zlib.InflateStream(Compressed,Uncompressed);
  Compressed.Free;
  Uncompressed.Position := 0;
  mText.Lines.LoadFromStream(Uncompressed);
  Uncompressed.Free;
  pnlView.Show;
end;

procedure TfmViewEmail.Attachmentsize1Click(Sender: TObject);
begin
  AttachmentSize;
end;

procedure TfmViewEmail.btnCloseViewClick(Sender: TObject);
begin
  mText.Clear;
  pnlView.Hide;
end;

procedure TfmViewEmail.ViewUncompressed1Click(Sender: TObject);
begin
  ViewAttachment;
end;

end.

Popular posts from this blog

Another Delphi tool that I've been working with has been the Indy components. I've been using them for doing e-mail directly in my apps. I currently use the latest snapshot of the components (the web-site has instructions how to install the components) and make sure you use the OpenSSL libs (older versions need a special set of OpenSSL libs, but the newer version uses the regular libs). The problem I'm trying to solve with this is that there are offices in various states which need to send partial employee information to the organization headquarters on a monthly basis. In turn, on occasion, the headquarters might send an update to one or more of the offices. Integrating e-mail has the advantage of reducing the number of steps required to complete the task. Of course, doing this increases the complexity of the application and this increases the risk that the program will produce errors (and discourage end users). The features that this code has are as follows: 1. Conf...
Read more
OpenOffice.org Macro Over the next couple of posts, I'll be posting the portions of a script I used to Generate a listing of personnel from a database table in OpenOffice.org Writer using the Basic language interface. What tasks are performed: 1. Styles are made and modified 2. Data is read and inserted into pre-formatted tables 3. The tables are modified (cells are merged and split) 4. New pages are entered 5. Names are Indexed and Headings added to the table of contents 6. Table of contents and an index are generated 7. The Table of Contents is modified to include hyperlinks around the name of the table of contents entry In my work on this script, I got a lot of help from various public support sites reading previous posts and finding the answers I needed. As well, once I figured out how to use the documentation, I used that a lot to help figure out the parts that I couldn't find sample code for. Part 1: Changing styles. I made a procedure to change all the styles that I wa...
Read more
Here's the problem that I was facing: I'm lazy. Solution: Create a script that will work in a number of situations (potentially bad in some situations). I've written a couple of programs in Delphi which use MySQL as the back end database. One of the programs is deployed in a couple of places already and in one case, a far off location. I was having a challenge with database schema updates: maintaining a list of changes, keeping the installation process seamless, and having a manageable update process. I decided to take a break from Delphi coding and made a script in Python. I then used the script to exe utility and made my script into an executable which I now distribute with my small Delphi app. I'll warn you now, I'm a messy coder and I've just started to learn Python, but you might get some good ideas from the script below for your own coding. There are 4 functions: 1. Save the schema to a pickle file 2. Restore/update a schema from a pickle file 3. Backup...
Read more