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. Configure SMTP (outgoing) email settings.
2. Configure POP3 (incoming) email settings.
3. Create new email (with zlib compressed attachment and pre-written body text).
4. Send email.
5. Download email (with the attempt to delete the email after download).
6. Process received email (detach attachments and decompress).

What I did in my code was to create my email form with virtual procedures for creating, downloading and processing emails, then I sub-classed the form in my two apps.

Note that I use a Form to display the details of the email to the user (which I use in the LoadEmail procedure). I'll post this form at a later date. Also, I use the backup restore routine in my code which I had posted earlier.

I'll warn you now that a lot of this code is very messy and I haven't bothered (and won't for a while) to clean it up. It took me a while to figure out what settings worked for connecting and what I needed to do to create a new email, but I got most of it working. That being said, some parts aren't working so well, like the progress meter. But I'm able to send and receive with gmail and other secure mail servers.

Delphi DFM


object fmEmail: TfmEmail
  Left = 522
  Top = 175
  Width = 566
  Height = 423
  Caption = 'Email'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object pcEmail: TPageControl
    Left = 0
    Top = 0
    Width = 558
    Height = 389
    ActivePage = tsInEmail
    Align = alClient
    TabOrder = 0
    object tsSendData: TTabSheet
      Caption = 'Send E-mails'
      object gbUnsentEmails: TGroupBox
        Left = 0
        Top = 41
        Width = 550
        Height = 199
        Align = alClient
        Caption = 'Unsent E-mails'
        TabOrder = 0
        object pnlUnsentBtns: TPanel
          Left = 400
          Top = 15
          Width = 148
          Height = 182
          Align = alRight
          BevelOuter = bvNone
          TabOrder = 0
          object btnSend: TButton
            Left = 8
            Top = 8
            Width = 89
            Height = 25
            Caption = 'Send selected'
            TabOrder = 0
            OnClick = btnSendClick
          end
          object btnDeleteUnsent: TButton
            Left = 8
            Top = 40
            Width = 89
            Height = 25
            Caption = 'Delete selected'
            TabOrder = 1
            OnClick = btnDeleteUnsentClick
          end
        end
        object lbUnsentEmails: TListBox
          Left = 2
          Top = 15
          Width = 398
          Height = 182
          Align = alClient
          ItemHeight = 13
          TabOrder = 1
          OnDblClick = lbUnsentEmailsDblClick
        end
      end
      object gbSentEmails: TGroupBox
        Left = 0
        Top = 240
        Width = 550
        Height = 121
        Align = alBottom
        Caption = 'Sent E-mails'
        TabOrder = 1
        object lbSentEmails: TListBox
          Left = 2
          Top = 15
          Width = 398
          Height = 104
          Align = alClient
          ItemHeight = 13
          TabOrder = 0
          OnDblClick = lbSentEmailsDblClick
        end
        object pnlSentBtns: TPanel
          Left = 400
          Top = 15
          Width = 148
          Height = 104
          Align = alRight
          BevelOuter = bvNone
          TabOrder = 1
          object btnDeleteSent: TButton
            Left = 8
            Top = 40
            Width = 89
            Height = 25
            Caption = 'Delete selected'
            TabOrder = 0
            OnClick = btnDeleteSentClick
          end
          object btnResend: TButton
            Left = 8
            Top = 8
            Width = 89
            Height = 25
            Caption = 'Resend selected'
            TabOrder = 1
            OnClick = btnResendClick
          end
        end
      end
      object pnlSendBtns: TPanel
        Left = 0
        Top = 0
        Width = 550
        Height = 41
        Align = alTop
        BevelInner = bvLowered
        BevelOuter = bvNone
        TabOrder = 2
        DesignSize = (
          550
          41)
        object btnNewEmail: TButton
          Left = 8
          Top = 8
          Width = 113
          Height = 25
          Caption = 'Create New E-mail'
          TabOrder = 0
          OnClick = btnNewEmailClick
        end
        object btnRefresh: TButton
          Left = 448
          Top = 8
          Width = 91
          Height = 25
          Anchors = [akTop, akRight]
          Caption = 'Refresh listings'
          TabOrder = 1
          OnClick = btnRefreshClick
        end
      end
    end
    object tsGetUpdates: TTabSheet
      Caption = 'Get E-mails'
      ImageIndex = 1
      object gbNew: TGroupBox
        Left = 0
        Top = 41
        Width = 550
        Height = 199
        Align = alClient
        Caption = 'New E-mails'
        TabOrder = 0
        object pnlNewEmailBtns: TPanel
          Left = 400
          Top = 15
          Width = 148
          Height = 182
          Align = alRight
          BevelOuter = bvNone
          TabOrder = 0
          object btnProcessNew: TButton
            Left = 8
            Top = 8
            Width = 89
            Height = 25
            Caption = 'Process selected'
            TabOrder = 0
            OnClick = btnProcessNewClick
          end
          object btnDeleteNew: TButton
            Left = 8
            Top = 40
            Width = 89
            Height = 25
            Caption = 'Delete selected'
            TabOrder = 1
            OnClick = btnDeleteNewClick
          end
        end
        object lbNewEmail: TListBox
          Left = 2
          Top = 15
          Width = 398
          Height = 182
          Align = alClient
          BevelInner = bvNone
          ItemHeight = 13
          TabOrder = 1
          OnDblClick = lbNewEmailDblClick
        end
      end
      object Panel1: TPanel
        Left = 0
        Top = 0
        Width = 550
        Height = 41
        Align = alTop
        BevelInner = bvLowered
        BevelOuter = bvNone
        TabOrder = 1
        DesignSize = (
          550
          41)
        object btnDownload: TButton
          Left = 8
          Top = 8
          Width = 113
          Height = 25
          Caption = 'Download E-mails'
          TabOrder = 0
          OnClick = btnDownloadClick
        end
        object btnRefresh2: TButton
          Left = 448
          Top = 8
          Width = 91
          Height = 25
          Anchors = [akTop, akRight]
          Caption = 'Refresh listings'
          TabOrder = 1
          OnClick = btnRefresh2Click
        end
      end
      object gbArchive: TGroupBox
        Left = 0
        Top = 240
        Width = 550
        Height = 121
        Align = alBottom
        Caption = 'Archive'
        TabOrder = 2
        object lbArchiveEmail: TListBox
          Left = 2
          Top = 15
          Width = 398
          Height = 104
          Align = alClient
          ItemHeight = 13
          TabOrder = 0
          OnDblClick = lbArchiveEmailDblClick
        end
        object pnlArchiveEmailBtns: TPanel
          Left = 400
          Top = 15
          Width = 148
          Height = 104
          Align = alRight
          BevelOuter = bvNone
          TabOrder = 1
          object btnProcessArchive: TButton
            Left = 8
            Top = 8
            Width = 89
            Height = 25
            Caption = 'Process selected'
            TabOrder = 0
            OnClick = btnProcessArchiveClick
          end
          object btnDeleteArchive: TButton
            Left = 8
            Top = 40
            Width = 89
            Height = 25
            Caption = 'Delete selected'
            TabOrder = 1
            OnClick = btnDeleteArchiveClick
          end
        end
      end
    end
    object tsOutEmail: TTabSheet
      Caption = 'Send E-mail Settings'
      ImageIndex = 2
      object gbSMTPServer: TGroupBox
        Left = 0
        Top = 41
        Width = 550
        Height = 320
        Align = alClient
        Caption = 'Server Settings'
        TabOrder = 0
        object Label8: TLabel
          Left = 8
          Top = 76
          Width = 54
          Height = 13
          Caption = 'User name:'
        end
        object Label9: TLabel
          Left = 8
          Top = 100
          Width = 49
          Height = 13
          Caption = 'Password:'
        end
        object Label7: TLabel
          Left = 251
          Top = 24
          Width = 22
          Height = 13
          Caption = 'Port:'
        end
        object Label6: TLabel
          Left = 8
          Top = 24
          Width = 25
          Height = 13
          Caption = 'Host:'
        end
        object Label22: TLabel
          Left = 248
          Top = 52
          Width = 79
          Height = 13
          Caption = 'Secure Protocol:'
        end
        object edSMTPPassword: TEdit
          Left = 64
          Top = 100
          Width = 177
          Height = 21
          Enabled = False
          PasswordChar = '*'
          TabOrder = 4
        end
        object edSMTPUser: TEdit
          Left = 64
          Top = 76
          Width = 177
          Height = 21
          Enabled = False
          TabOrder = 3
          Text = 'username'
        end
        object edSMTPPort: TEdit
          Left = 288
          Top = 24
          Width = 33
          Height = 21
          TabOrder = 1
          Text = '25'
        end
        object edSMTPHost: TEdit
          Left = 64
          Top = 24
          Width = 177
          Height = 21
          TabOrder = 0
          Text = 'smtp.host.org'
        end
        object chkSMTPAuth: TCheckBox
          Left = 8
          Top = 56
          Width = 233
          Height = 17
          Caption = 'Host requires user name and password'
          TabOrder = 2
          OnClick = chkSMTPAuthClick
        end
        object btnTestOutEmail: TButton
          Left = 8
          Top = 128
          Width = 89
          Height = 25
          Caption = 'Test Connection'
          TabOrder = 6
          OnClick = btnTestOutEmailClick
        end
        object cbOutSSLType: TComboBox
          Left = 248
          Top = 76
          Width = 73
          Height = 21
          ItemHeight = 13
          TabOrder = 5
          Text = 'SSLv3'
          Items.Strings = (
            'None'
            'SSLv2'
            'SSLv23'
            'SSLv3'
            'TLSv1'
            'TLS_2')
        end
        object cbOutSSLselect: TComboBox
          Left = 248
          Top = 100
          Width = 73
          Height = 21
          ItemHeight = 13
          ItemIndex = 1
          TabOrder = 7
          Text = 'Implicit'
          Items.Strings = (
            'Explicit'
            'Implicit')
        end
        object btnSaveSettings2: TButton
          Left = 104
          Top = 128
          Width = 81
          Height = 25
          Caption = 'Save Settings'
          TabOrder = 8
          OnClick = btnSaveSettings2Click
        end
      end
      object pnlSentto: TPanel
        Left = 0
        Top = 0
        Width = 550
        Height = 41
        Align = alTop
        BevelOuter = bvNone
        TabOrder = 1
        object Label5: TLabel
          Left = 8
          Top = 16
          Width = 110
          Height = 13
          Caption = 'Send to e-mail address:'
        end
        object edSendToEmail: TEdit
          Left = 128
          Top = 16
          Width = 289
          Height = 21
          TabOrder = 0
          Text = '"Person Name" '
        end
      end
    end
    object tsInEmail: TTabSheet
      Caption = 'Receive E-mail Settings'
      ImageIndex = 3
      object GroupBox1: TGroupBox
        Left = 0
        Top = 41
        Width = 550
        Height = 320
        Align = alClient
        Caption = 'Server Settings'
        TabOrder = 0
        object Label11: TLabel
          Left = 8
          Top = 52
          Width = 54
          Height = 13
          Caption = 'User name:'
        end
        object Label12: TLabel
          Left = 8
          Top = 76
          Width = 49
          Height = 13
          Caption = 'Password:'
        end
        object Label13: TLabel
          Left = 251
          Top = 24
          Width = 22
          Height = 13
          Caption = 'Port:'
        end
        object Label14: TLabel
          Left = 8
          Top = 24
          Width = 25
          Height = 13
          Caption = 'Host:'
        end
        object Label15: TLabel
          Left = 8
          Top = 104
          Width = 48
          Height = 13
          Caption = 'Host type:'
        end
        object Label16: TLabel
          Left = 248
          Top = 52
          Width = 79
          Height = 13
          Caption = 'Secure Protocol:'
        end
        object edOutPassword: TEdit
          Left = 64
          Top = 76
          Width = 177
          Height = 21
          PasswordChar = '*'
          TabOrder = 3
          Text = 'password'
        end
        object edOutUser: TEdit
          Left = 64
          Top = 52
          Width = 177
          Height = 21
          TabOrder = 2
          Text = 'username'
        end
        object edOutPort: TEdit
          Left = 288
          Top = 24
          Width = 33
          Height = 21
          TabOrder = 1
          Text = '110'
        end
        object edOutHost: TEdit
          Left = 64
          Top = 24
          Width = 177
          Height = 21
          TabOrder = 0
          Text = 'pop.host.org'
        end
        object cbOutHostType: TComboBox
          Left = 64
          Top = 104
          Width = 89
          Height = 21
          ItemHeight = 13
          ItemIndex = 0
          TabOrder = 4
          Text = 'POP3'
          OnSelect = cbOutHostTypeSelect
          Items.Strings = (
            'POP3'
            'IMAP4')
        end
        object btnTestInEmail: TButton
          Left = 8
          Top = 136
          Width = 89
          Height = 25
          Caption = 'Test Connection'
          TabOrder = 6
          OnClick = btnTestInEmailClick
        end
        object edDefaultPort: TEdit
          Left = 152
          Top = 104
          Width = 33
          Height = 21
          BevelInner = bvLowered
          BevelKind = bkSoft
          BevelOuter = bvRaised
          BorderStyle = bsNone
          Color = clScrollBar
          ReadOnly = True
          TabOrder = 7
          Text = '110'
        end
        object cbInSSLType: TComboBox
          Left = 248
          Top = 76
          Width = 73
          Height = 21
          ItemHeight = 13
          TabOrder = 5
          Text = 'SSLv3'
          Items.Strings = (
            'None'
            'SSLv2'
            'SSLv23'
            'SSLv3'
            'TLSv1'
            'TLS_2')
        end
        object cbInSSLselect: TComboBox
          Left = 248
          Top = 104
          Width = 73
          Height = 21
          ItemHeight = 13
          ItemIndex = 1
          TabOrder = 8
          Text = 'Implicit'
          Items.Strings = (
            'Explicit'
            'Implicit')
        end
        object btnSaveSettings1: TButton
          Left = 104
          Top = 136
          Width = 81
          Height = 25
          Caption = 'Save Settings'
          TabOrder = 9
          OnClick = btnSaveSettings1Click
        end
      end
      object pnlAccount: TPanel
        Left = 0
        Top = 0
        Width = 550
        Height = 41
        Align = alTop
        BevelOuter = bvNone
        TabOrder = 1
        object Label10: TLabel
          Left = 8
          Top = 16
          Width = 74
          Height = 13
          Caption = 'Account E-mail:'
        end
        object edAcctEmail: TEdit
          Left = 88
          Top = 16
          Width = 329
          Height = 21
          TabOrder = 0
          Text = '"My Name" '
        end
      end
    end
    object tsSecurity: TTabSheet
      Caption = 'Other Settings'
      ImageIndex = 4
      TabVisible = False
      object GroupBox2: TGroupBox
        Left = 0
        Top = 121
        Width = 550
        Height = 240
        Align = alBottom
        Caption = 'Connect through Proxy Server'
        TabOrder = 1
        Visible = False
        object Label17: TLabel
          Left = 8
          Top = 76
          Width = 54
          Height = 13
          Caption = 'User name:'
        end
        object Label18: TLabel
          Left = 8
          Top = 100
          Width = 49
          Height = 13
          Caption = 'Password:'
        end
        object Label19: TLabel
          Left = 8
          Top = 24
          Width = 25
          Height = 13
          Caption = 'Host:'
        end
        object Label20: TLabel
          Left = 251
          Top = 24
          Width = 22
          Height = 13
          Caption = 'Port:'
        end
        object chkProxyAuth: TCheckBox
          Left = 8
          Top = 56
          Width = 233
          Height = 17
          Caption = 'Host requires user name and password'
          Enabled = False
          TabOrder = 2
        end
        object edProxyUser: TEdit
          Left = 64
          Top = 76
          Width = 177
          Height = 21
          Enabled = False
          TabOrder = 3
          Text = 'username'
        end
        object edProxyPassword: TEdit
          Left = 64
          Top = 100
          Width = 177
          Height = 21
          Enabled = False
          PasswordChar = '*'
          TabOrder = 4
          Text = 'password'
        end
        object edProxyServer: TEdit
          Left = 64
          Top = 24
          Width = 177
          Height = 21
          Enabled = False
          TabOrder = 0
          Text = 'proxy.host.org'
        end
        object edProxyPort: TEdit
          Left = 288
          Top = 24
          Width = 33
          Height = 21
          Enabled = False
          TabOrder = 1
          Text = '8080'
        end
        object btnTestSocks: TButton
          Left = 8
          Top = 130
          Width = 89
          Height = 25
          Caption = 'Test Connection'
          TabOrder = 5
        end
      end
      object chkUseProxy: TCheckBox
        Left = 24
        Top = 8
        Width = 113
        Height = 17
        Caption = 'Use Proxy Server'
        TabOrder = 0
        Visible = False
        OnClick = chkUseProxyClick
      end
    end
  end
  object pnlProcessing: TPanel
    Left = 144
    Top = 168
    Width = 289
    Height = 65
    BorderStyle = bsSingle
    Caption = 'Processing'
    TabOrder = 1
    Visible = False
    object lblBytes: TLabel
      Left = 8
      Top = 8
      Width = 6
      Height = 13
      Caption = '0'
    end
    object meter: TProgressBar
      Left = 1
      Top = 43
      Width = 283
      Height = 17
      Align = alBottom
      TabOrder = 0
    end
  end
  object OutOpenSSL: TIdSSLIOHandlerSocketOpenSSL
    Destination = ':25'
    MaxLineAction = maException
    Port = 25
    DefaultPort = 0
    SSLOptions.Method = sslvTLSv1
    SSLOptions.Mode = sslmUnassigned
    SSLOptions.VerifyMode = []
    SSLOptions.VerifyDepth = 0
    Left = 456
    Top = 184
  end
  object InOpenSSL: TIdSSLIOHandlerSocketOpenSSL
    Destination = ':995'
    MaxLineAction = maException
    Port = 995
    DefaultPort = 0
    SSLOptions.Method = sslvTLSv1
    SSLOptions.Mode = sslmUnassigned
    SSLOptions.VerifyMode = []
    SSLOptions.VerifyDepth = 0
    Left = 496
    Top = 184
  end
  object SMTP: TIdSMTP
    OnStatus = SMTPStatus
    IOHandler = OutOpenSSL
    OnDisconnected = SMTPDisconnected
    OnWork = SMTPWork
    OnConnected = SMTPConnected
    MailAgent = 'IndyDelphiComponent'
    HeloName = 'IndiaPayroll'
    SASLMechanisms = <
      item
      end>
    Left = 456
    Top = 152
  end
  object EmailMessage: TIdMessage
    AttachmentEncoding = 'UUE'
    BccList = <>
    CCList = <>
    Encoding = meDefault
    FromList = <
      item
      end>
    Recipients = <>
    ReplyTo = <>
    ConvertPreamble = True
    Left = 496
    Top = 120
  end
  object Zlib: TIdCompressorZLibEx
    Left = 360
    Top = 32
  end
  object IpWatch: TIdIPWatch
    Active = False
    HistoryEnabled = False
    HistoryFilename = 'iphist.dat'
    Left = 456
    Top = 120
  end
  object ComponentState: TOvcComponentState
    Active = False
    Section = 'TfmBackupRestore'
    Storage = EmailSettingsFile
    StoredProperties.Strings = (
      'cbOutHostType.ItemIndex'
      'chkProxyAuth.Checked'
      'chkSMTPAuth.Checked'
      'chkUseProxy.Checked'
      'edAcctEmail.Text'
      'edDefaultPort.Text'
      'edOutHost.Text'
      'edOutPassword.Text'
      'edOutPort.Text'
      'edOutUser.Text'
      'edProxyPassword.Text'
      'edProxyPort.Text'
      'edProxyServer.Text'
      'edProxyUser.Text'
      'edSendToEmail.Text'
      'edSMTPHost.Text'
      'edSMTPPassword.Text'
      'edSMTPPort.Text'
      'edSMTPUser.Text'
      'cbOutHostType.Enabled'
      'chkProxyAuth.Enabled'
      'chkSMTPAuth.Enabled'
      'chkUseProxy.Enabled'
      'edAcctEmail.Enabled'
      'edDefaultPort.Enabled'
      'edOutHost.Enabled'
      'edOutPassword.Enabled'
      'edOutPort.Enabled'
      'edOutUser.Enabled'
      'edProxyPassword.Enabled'
      'edProxyPort.Enabled'
      'edProxyServer.Enabled'
      'edProxyUser.Enabled'
      'edSendToEmail.Enabled'
      'edSMTPHost.Enabled'
      'edSMTPPassword.Enabled'
      'edSMTPPort.Enabled'
      'edSMTPUser.Enabled'
      'cbInSSLType.ItemIndex'
      'cbInSSLType.Enabled'
      'cbOutSSLType.Enabled'
      'cbOutSSLType.ItemIndex')
    Left = 392
    Top = 32
  end
  object EmailSettingsFile: TOvcIniFileStore
    IniFileName = 'EmailSettings.data'
    UseExeDir = True
    Left = 456
    Top = 72
  end
  object vsEmailSettings: TOvcVirtualStore
    Left = 496
    Top = 72
  end
  object POP3: TIdPOP3
    OnStatus = POP3Status
    IOHandler = InOpenSSL
    OnDisconnected = POP3Disconnected
    OnWork = POP3Work
    OnConnected = POP3Connected
    AutoLogin = True
    UseTLS = utUseImplicitTLS
    Port = 995
    SASLMechanisms = <>
    Left = 496
    Top = 152
  end
  object HttpProxy: TIdConnectThroughHttpProxy
    Enabled = False
    Port = 0
    Left = 328
    Top = 32
  end
end



Delphi Source


unit FormEmail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ovcstore, ovcfiler, ovcbase, ovcstate, IdIPWatch,
  IdZLibCompressorBase, IdCompressorZLibEx, IdMessage, IdTCPConnection,
  IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase,
  IdSMTP, IdBaseComponent, IdComponent, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, StdCtrls, CheckLst, Grids,
  DBGrids, ExtCtrls, ComCtrls, IdPOP3, IdCustomTransparentProxy,
  IdConnectThroughHttpProxy, IdAttachmentMemory, StrUtils, IdMessageParts,
  IdException, IdAttachmentFile, IdAttachment, IdMessageCoder,
  IdMessageCoderMIME, IdText, IdReplySMTP;

type
  TfmEmail = class(TForm)
    pcEmail: TPageControl;
    tsSendData: TTabSheet;
    tsGetUpdates: TTabSheet;
    tsOutEmail: TTabSheet;
    Label5: TLabel;
    edSendToEmail: TEdit;
    gbSMTPServer: TGroupBox;
    Label8: TLabel;
    Label9: TLabel;
    Label7: TLabel;
    Label6: TLabel;
    Label22: TLabel;
    edSMTPPassword: TEdit;
    edSMTPUser: TEdit;
    edSMTPPort: TEdit;
    edSMTPHost: TEdit;
    chkSMTPAuth: TCheckBox;
    btnTestOutEmail: TButton;
    cbOutSSLType: TComboBox;
    cbOutSSLselect: TComboBox;
    tsInEmail: TTabSheet;
    Label10: TLabel;
    edAcctEmail: TEdit;
    GroupBox1: TGroupBox;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    edOutPassword: TEdit;
    edOutUser: TEdit;
    edOutPort: TEdit;
    edOutHost: TEdit;
    cbOutHostType: TComboBox;
    btnTestInEmail: TButton;
    edDefaultPort: TEdit;
    cbInSSLType: TComboBox;
    cbInSSLselect: TComboBox;
    tsSecurity: TTabSheet;
    GroupBox2: TGroupBox;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    chkProxyAuth: TCheckBox;
    edProxyUser: TEdit;
    edProxyPassword: TEdit;
    edProxyServer: TEdit;
    edProxyPort: TEdit;
    btnTestSocks: TButton;
    chkUseProxy: TCheckBox;
    OutOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
    InOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
    SMTP: TIdSMTP;
    EmailMessage: TIdMessage;
    Zlib: TIdCompressorZLibEx;
    IpWatch: TIdIPWatch;
    ComponentState: TOvcComponentState;
    EmailSettingsFile: TOvcIniFileStore;
    vsEmailSettings: TOvcVirtualStore;
    gbNew: TGroupBox;
    Panel1: TPanel;
    gbArchive: TGroupBox;
    pnlNewEmailBtns: TPanel;
    lbNewEmail: TListBox;
    lbArchiveEmail: TListBox;
    pnlArchiveEmailBtns: TPanel;
    gbUnsentEmails: TGroupBox;
    pnlUnsentBtns: TPanel;
    lbUnsentEmails: TListBox;
    gbSentEmails: TGroupBox;
    lbSentEmails: TListBox;
    pnlSentBtns: TPanel;
    pnlSendBtns: TPanel;
    btnNewEmail: TButton;
    btnSend: TButton;
    btnDeleteSent: TButton;
    btnResend: TButton;
    btnDeleteUnsent: TButton;
    btnDownload: TButton;
    btnProcessNew: TButton;
    btnDeleteNew: TButton;
    btnProcessArchive: TButton;
    btnDeleteArchive: TButton;
    btnRefresh: TButton;
    btnRefresh2: TButton;
    POP3: TIdPOP3;
    HttpProxy: TIdConnectThroughHttpProxy;
    pnlProcessing: TPanel;
    meter: TProgressBar;
    btnSaveSettings1: TButton;
    btnSaveSettings2: TButton;
    lblBytes: TLabel;
    pnlSentto: TPanel;
    pnlAccount: TPanel;
    procedure btnSaveSettings2Click(Sender: TObject);
    procedure btnSaveSettings1Click(Sender: TObject);
    procedure btnTestInEmailClick(Sender: TObject);
    procedure btnTestOutEmailClick(Sender: TObject);
    procedure chkSMTPAuthClick(Sender: TObject);
    procedure chkUseProxyClick(Sender: TObject);
    procedure cbOutHostTypeSelect(Sender: TObject);
    procedure btnNewEmailClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure btnDeleteUnsentClick(Sender: TObject);
    procedure btnDeleteSentClick(Sender: TObject);
    procedure btnResendClick(Sender: TObject);
    procedure btnDownloadClick(Sender: TObject);
    procedure btnRefresh2Click(Sender: TObject);
    procedure btnProcessNewClick(Sender: TObject);
    procedure btnDeleteNewClick(Sender: TObject);
    procedure btnDeleteArchiveClick(Sender: TObject);
    procedure btnProcessArchiveClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lbUnsentEmailsDblClick(Sender: TObject);
    procedure lbSentEmailsDblClick(Sender: TObject);
    procedure lbNewEmailDblClick(Sender: TObject);
    procedure lbArchiveEmailDblClick(Sender: TObject);
    procedure SMTPConnected(Sender: TObject);
    procedure SMTPDisconnected(Sender: TObject);
    procedure SMTPWork(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure POP3Connected(Sender: TObject);
    procedure POP3Disconnected(Sender: TObject);
    procedure POP3Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure POP3Status(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
    procedure SMTPStatus(ASender: TObject; const AStatus: TIdStatus;
      const AStatusText: String);
  protected
    fldr_email: String;
    fldr_archive: String;
    fldr_new: String;
    fldr_unsent: String;
    fldr_sent: String;
    fldr_temp: String;
    cur_file_size: Int64;
    procedure StartMeter(max: Integer = 100);
    procedure EndMeter;
    procedure IncMeter(num: Integer);
    procedure MeterText(text: String);
    procedure ConnectIncomingMailServer;
    procedure ConnectOutgoingMailServer;
    procedure ConnectProxyServer;
    procedure InitFirstUse;
    procedure InitVars;
    procedure SaveEmailSettingsToINI;
    procedure LoadEmailSettings;
    procedure SetupIncomingMailServer;
    procedure SetupOutgoingMailServer;
    procedure SetupProxyServer;
    procedure SendEmailFile(filename: String);
    procedure SendEmail;
    procedure ResendEmail;
    procedure ProcessEmail(filename: String); virtual; abstract;
    procedure ProcessNewEmail;
    procedure ProcessArchiveEmail;
    procedure LoadEmail(filename: String);
    procedure SaveEmail(filename: String);
    procedure DeleteEmail(filename: String);
    procedure MoveEmail(filename, to_folder: String);
    procedure ListEmails(lb: TListBox; folder: String);
    procedure ListSentEmails;
    procedure ListUnsentEmails;
    procedure ListNewEmails;
    procedure ListArchiveEmails;
    procedure CreateNewMail; virtual; abstract;
    procedure DownloadMail; virtual; abstract;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CreateNewTextMail(Att: TStringList; From, SendTo, Subject, filename, dbName: String);
  end;

var
  fmEmail: TfmEmail;

implementation

uses FormMySQLBackup, ViewEmailForm;

{$R *.dfm}

{ TfmEmail }

{
  Setup the folders for email management
}
procedure TfmEmail.InitFirstUse;
var
  fldr_exe: String;
begin
  fldr_exe := ExtractFilePath(Application.ExeName);
  fldr_email := fldr_exe+'email\';
  fldr_archive := fldr_email+'archive\';
  fldr_new := fldr_email+'new\';
  fldr_unsent := fldr_email+'unsent\';
  fldr_sent := fldr_email+'sent\';
  fldr_temp := fldr_email+'temp\';
  if not DirectoryExists(fldr_email) then
    begin
      if not CreateDir(fldr_email) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
  if not DirectoryExists(fldr_archive) then
    begin
      if not CreateDir(fldr_archive) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
  if not DirectoryExists(fldr_new) then
    begin
      if not CreateDir(fldr_new) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
  if not DirectoryExists(fldr_sent) then
    begin
      if not CreateDir(fldr_sent) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
  if not DirectoryExists(fldr_unsent) then
    begin
      if not CreateDir(fldr_unsent) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
  if not DirectoryExists(fldr_temp) then
    begin
      if not CreateDir(fldr_temp) then
        begin
          MessageDlg('Error Initializing Email for the program.  I could not create a '+#13+#10+'directory.  Check your permissions for the program folder.  '+#13+#10+'Exiting...', mtError, [mbOK], 0);
          Exit;
        end;
    end;
end;

{
  When the program is first opened, initialize our form.
}
procedure TfmEmail.InitVars;
begin
  //Initialize paths and make sure that they exist
  InitFirstUse;
  //Load our settings;
  LoadEmailSettings;
  //Load our lists
  ListSentEmails;
  ListUnsentEmails;
  ListArchiveEmails;
  ListNewEmails;
end;

procedure TfmEmail.SaveEmailSettingsToINI;
var
  inFile, outFile: TFileStream;
  inFileName, outFileName: String;
begin
  EmailSettingsFile.Open;
  ComponentState.Active := True;
  ComponentState.SaveState;
  EmailSettingsFile.Close;
  ComponentState.Active := False;
  inFileName := ExtractFilePath(Application.ExeName) + EmailSettingsFile.IniFileName;
  outFileName := inFileName + 'lock';
  if FileExists(inFileName) then
    begin
      inFile := TFileStream.Create(inFileName,fmOpenRead);
      outFile := TFileStream.Create(outFileName,fmCreate);
      Zlib.DeflateStream(inFile,outFile,1);
      inFile.Free;
      outFile.Free;
      if not DeleteFile(inFileName) then
        begin
          inFile := TFileStream.Create(inFileName,fmOpenWrite);
          inFile.Free;
        end;
    end;
end;

{
  Setup the pop related components based on the current
  settings.
}
procedure TfmEmail.SetupIncomingMailServer;
begin
  if POP3.Connected then
    POP3.Disconnect;
  if InOpenSSL.Connected then
    InOpenSSL.Close;
  //Fix this if then else sometime
  if cbInSSLselect.ItemIndex = 0 then
    begin
      POP3.UseTLS := utUseExplicitTLS;
    end
  else
    begin
      POP3.UseTLS := utUseImplicitTLS;
    end;
  if cbInSSLType.ItemIndex = 0 then //No ssl
    begin
      InOpenSSL.PassThrough := True;
      POP3.UseTLS := utNoTLSSupport;
    end
  else if cbInSSLType.ItemIndex = 1 then //SSLv2
    begin
      InOpenSSL.PassThrough := False;
      InOpenSSL.SSLOptions.Method := sslvSSLv2;
    end
  else if cbInSSLType.ItemIndex = 2 then //SSLv23
    begin
      InOpenSSL.PassThrough := False;
      InOpenSSL.SSLOptions.Method := sslvSSLv23;
    end
  else if cbInSSLType.ItemIndex = 3 then //SSLv3
    begin
      InOpenSSL.PassThrough := False;
      InOpenSSL.SSLOptions.Method := sslvSSLv3;
   end
  else if cbOutSSLType.ItemIndex = 4 then
    begin
      OutOpenSSL.PassThrough := False;
      OutOpenSSL.SSLOptions.Method := sslvTLSv1;
    end
  else //TLS
    begin
      InOpenSSL.PassThrough := False;
      InOpenSSL.SSLOptions.Method := sslvTLSv1;
    end;
  IpWatch.Active := True;

  if not IpWatch.ForceCheck then
    begin
      MessageDlg('Cannot configure the incoming mail settings until you''re '+#13+#10+'connected to the Internet and no connection was detected.  '+#13+#10+'Connect first, then try again.', mtError, [mbOK], 0);
      Exit;
    end;
  InOpenSSL.BoundIP := IpWatch.CurrentIP;
  if cbOutHostType.ItemIndex = 0 then //POP3 account
    begin
      POP3.Username := edOutUser.Text;
      POP3.Password := edOutPassword.Text;
      POP3.Host := edOutHost.Text;
      POP3.Port := StrToInt(edOutPort.Text);
      InOpenSSL.Host := edOutHost.Text;
      InOpenSSL.Destination := edOutHost.Text + ':' + edOutPort.Text;
    end;
  {if not InOpenSSL.Opened then
    InOpenSSL.Open;}
end;

{
  Setup the smtp related components based on the current
  settings.
}
procedure TfmEmail.SetupOutgoingMailServer;
begin
  if SMTP.Connected then
    SMTP.Disconnect;
  if OutOpenSSL.Connected then
    OutOpenSSL.Close;
  if cbOutSSLselect.ItemIndex = 0 then
    SMTP.UseTLS := utUseExplicitTLS
  else
    SMTP.UseTLS := utUseImplicitTLS;
  if cbOutSSLType.ItemIndex = 0 then //No ssl
    begin
      OutOpenSSL.PassThrough := True;
      SMTP.UseTLS := utNoTLSSupport;
    end
  else if cbOutSSLType.ItemIndex = 1 then //SSLv2
    begin
      OutOpenSSL.PassThrough := False;
      OutOpenSSL.SSLOptions.Method := sslvSSLv2;
    end
  else if cbOutSSLType.ItemIndex = 2 then //SSLv23
    begin
      OutOpenSSL.PassThrough := False;
      OutOpenSSL.SSLOptions.Method := sslvSSLv23;
    end
  else if cbOutSSLType.ItemIndex = 3 then //SSLv3
    begin
      OutOpenSSL.PassThrough := False;
      //OutOpenSSL.Port := SMTP.Port;
      OutOpenSSL.SSLOptions.Method := sslvSSLv3;
   end
  else if cbOutSSLType.ItemIndex = 4 then
    begin
      OutOpenSSL.PassThrough := False;
      OutOpenSSL.SSLOptions.Method := sslvTLSv1;
    end
  else //TLS
    begin
      OutOpenSSL.PassThrough := False;
      OutOpenSSL.SSLOptions.Method := sslvTLSv1;
    end;
  IpWatch.Active := True;
  if not IpWatch.ForceCheck then
    begin
      MessageDlg('Cannot configure the outgoing mail settings until you''re '+#13+#10+'connected to the Internet and no connection was detected.  '+#13+#10+'Connect first, then try again.', mtError, [mbOK], 0);
      Exit;
    end;
  OutOpenSSL.BoundIP := IpWatch.CurrentIP;
  SMTP.Host := edSMTPHost.Text;
  SMTP.Port := StrToInt(edSMTPPort.Text);
  OutOpenSSL.Host := edSMTPHost.Text;
  OutOpenSSL.Destination := edSMTPHost.Text + ':' + edSMTPPort.Text;
  if chkSMTPAuth.Checked then
    begin
      SMTP.AuthType := atDefault;
      SMTP.Username := edSMTPUser.Text;
      SMTP.Password := edSMTPPassword.Text;
    end
  else
    begin
      SMTP.AuthType := atNone;
      SMTP.Username := '';
      SMTP.Password := '';
    end;
//  if not SMTP.IOHandler.Opened then
//    SMTP.IOHandler.Open;
end;

{
  Not currently used!!
}
procedure TfmEmail.SetupProxyServer;
begin
  if chkUseProxy.Checked then
    begin
      InOpenSSL.TransparentProxy := HttpProxy;
      OutOpenSSL.TransparentProxy := HttpProxy;
      HttpProxy.Host := edProxyServer.Text;
      HttpProxy.Port := StrToInt(edProxyPort.Text);
      if chkProxyAuth.Checked then
        begin
          HttpProxy.Username := edProxyUser.Text;
          HttpProxy.Password := edProxyPassword.Text;
        end
      else
        begin
          HttpProxy.Username := '';
          HttpProxy.Password := '';
        end;
    end
  else
    begin
      InOpenSSL.TransparentProxy := Nil;
      OutOpenSSL.TransparentProxy := Nil;
    end;
end;

{
  Not currently used.
}
procedure TfmEmail.ConnectProxyServer;
begin
  if chkUseProxy.Checked then
    HttpProxy.Enabled;
end;

{
  Make a POP connection
}
procedure TfmEmail.ConnectIncomingMailServer;
begin
  SetupProxyServer;
  ConnectProxyServer;
  self.SetupIncomingMailServer;
  POP3.Connect;
end;

{
  Make a SMTP connection
}
procedure TfmEmail.ConnectOutgoingMailServer;
begin
  SetupProxyServer;
  ConnectProxyServer;
  self.SetupOutgoingMailServer;
  SMTP.ConnectTimeout := 1000;
  SMTP.Connect;
  if chkSMTPAuth.Checked AND (not SMTP.Authenticate) then
    MessageDlg('I Could not authenticate with the SMTP server (but I did connect '+#13+#10+'to it).', mtError, [mbOK], 0);
end;

{
  Customize this procedure for making your Emails
  This implementation:
  1. Open fmMySQLBackup
  2. Create a backup file
  3. Compress the file
  4. Make a New email
  5. Set the Headers
  6. Attach the compressed backup.

procedure TfmEmail.CreateNewMail;
var
  Attachment: TidAttachmentMemory;
  UncompressedFile, EmailFile: TFileStream;
  AttachBuffer: TMemoryStream;
  backup_file, compressed_file: String;
  Body: TIdText;
  BodyText: TStringList;
begin
{  //Create The backup
  if fmMySQLBackup = Nil then
    fmMySQLBackup := TfmMySQLBackup.Create(self);
  fmMySQLBackup.Backup('',dm.db.Database,dm.db.User,
    dm.db.Password, dm.db.HostName,IntToStr(dm.db.Port),'');
  backup_file := fmMySQLBackup.GetBackupFileName;
  // Create a new blank message
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  EmailMessage.Clear;
  if edSendToEmail.Text <> '' then
    EmailMessage.Recipients.EMailAddresses := edSendToEmail.Text
  else
    Exit;
  if edAcctEmail.Text <> '' then
    EmailMessage.From.Address := edAcctEmail.Text;
  { Create the attachment }
{  //Compress the File in the memory buffer
  compressed_file := ExtractFilePath(backup_file) + LeftStr(ExtractFileName(backup_file),
    length(ExtractFileName(backup_file))-length(ExtractFileExt(backup_file))) + '.zipdat';
  UncompressedFile := TFileStream.Create(backup_file,fmOpenRead);
  AttachBuffer := TMemoryStream.Create;
  Zlib.DeflateStream(UncompressedFile,AttachBuffer,9);
  UncompressedFile.Free;
  AttachBuffer.Seek(0,soFromBeginning);
  Attachment := TidAttachmentMemory.Create(EmailMessage.MessageParts, AttachBuffer);
  AttachBuffer.Free;
  Attachment.FileName := ExtractFileName(compressed_file);
  Attachment.ContentTransfer := 'base64';
  Attachment.ContentID := 'SingleAttachment';
  //HEADERS
  EmailMessage.Subject := 'THE SUBJECT OF THE EMAIL';
  BodyText := TStringList.Create;
  BodyText.Append('TITLE LINE IN THE EMAIL');  //0
  BodyText.Append(FormatDateTime('yyyymmddhhnnss', Now));//1
  BodyText.Append(ExtractFileName(backup_file));         //3
  BodyText.Append(ExtractFileName(compressed_file));     //4
  Body := TIdText.Create(EmailMessage.MessageParts, BodyText);
   //Save EmailMessage to the unsent folder
  EmailMessage.GenerateHeader;
  EmailFile := TFileStream.Create(fldr_unsent+EmailMessage.Subject+'.email',fmCreate);
  EmailMessage.SaveToStream(EmailFile,False);
  EmailFile.Free;
  //Refresh our listing
  ListUnsentEmails;
end;}

{
  Delete the specified file
}
procedure TfmEmail.DeleteEmail(filename: String);
begin
  if not DeleteFile(filename) then
    MessageDlg('Could not delete the file ' + filename, mtError, [mbOK], 0);
end;

{
  Customize this to filter the emails you want to download
  Download E-mails from our account using POP

procedure TfmEmail.DownloadMail;
Var
  Filter: String;
  i, MsgCount, curMsgSize: Integer;
  EmailFile: TFileStream;
begin
  ConnectIncomingMailServer;
  //Download the mail
  if cbOutHostType.ItemIndex = 0 then //POP3
    begin
      //Verify that we're connected.
      if not POP3.Connected then
        begin
          MessageDlg('The POP3 client could not connect to the server.  Some setting '+#13+#10+'must be wrong.  Fix the settings and try again.', mtError, [mbOK], 0);
          self.EndMeter;
          Exit;
        end;
      MsgCount := POP3.CheckMessages;
      //Go through all the messages on the server, downloading the ones we need
      for i := 1 to MsgCount do
        begin
          self.StartMeter(100);
          MeterText('Checking ' + IntToStr(i) + ' of ' + IntToStr(MsgCount) + ' messages');
          if EmailMessage = Nil then
            EmailMessage := TIdMessage.Create(self);
          POP3.RetrieveHeader(i, EmailMessage);
          if (EmailMessage.SUbject = 'FILTER STRING') OR
              (EmailMessage.Subject = '2ND FILTER STRING') then
            begin
              curMsgSize := POP3.RetrieveMsgSize(i);
              self.StartMeter(curMsgSize);
              MeterText('Downloading ' + IntToStr(i) + ' of ' + IntToStr(MsgCount) + ' messages');
              //Download the entire message
              POP3.Retrieve(i, EmailMessage);
              //Add a new header for filename
              EmailMessage.Headers.Append(fldr_new+EmailMessage.Subject+'.email');
              //Save the mail to the email\new folder
              EmailFile := TFileStream.Create(fldr_new+EmailMessage.Subject+'.email',fmCreate);
              EmailMessage.SaveToStream(EmailFile,False);
              EmailFile.Free;
              EmailMessage.Free;
              if EmailMessage = Nil then
                EmailMessage := TIdMessage.Create(self);
              POP3.Delete(i);//Remove the message from the server.
            end;//end of downloading email
        end;//end of for loop
      EndMeter;
      POP3.Disconnect;
      if POP3.IOHandler.Opened then
        POP3.IOHandler.Close;
    end;
  ListNewEmails;
end;            }

procedure TfmEmail.ListArchiveEmails;
begin
  self.ListEmails(lbArchiveEmail,fldr_archive);
end;

procedure TfmEmail.ListNewEmails;
begin
  ListEmails(lbNewEmail,fldr_new);
end;

procedure TfmEmail.ListSentEmails;
begin
  ListEmails(lbSentEmails,fldr_sent);
end;

procedure TfmEmail.ListUnsentEmails;
begin
  ListEmails(lbUnsentEmails,fldr_unsent);
end;

{
  Display the email message using my email form
}
procedure TfmEmail.LoadEmail(filename: String);
begin
  if not FileExists(filename) then
    Exit;
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  try
    EmailMessage.LoadFromFile(filename, False);
  except
    MessageDlg('Error opening the selected e-mail.', mtError, [mbOK], 0);
    Exit;
  end;
  if fmViewEmail = Nil then
    fmViewEmail := TfmViewEmail.Create(self);
  fmViewEmail.ViewEmail(EmailMessage);
end;

{
  Move a file from one location to another
  filename - Full path and file name
  to_folder - the folder to move the file to (no file renaming allowed).
}
procedure TfmEmail.MoveEmail(filename, to_folder: String);
Var
  to_filename: String;
  EmailFile, NewFile: TFileStream;
begin
  if RightStr(to_folder,1) <> '\' then
    to_folder := to_folder + '\';
  if not DirectoryExists(to_folder) then
    begin
      MessageDlg('Destination folder doesn''t exist', mtError, [mbOK], 0);
      Exit;
    end;
  if not FileExists(filename) then
    begin
      MessageDlg('File doesn''t exist.', mtError, [mbOK], 0);
      Exit;
    end;
  to_filename := to_folder+ExtractFileName(filename);
  //Copy the file to the new location
  EmailFile := TFileStream.Create(filename,fmOpenRead);
  NewFile := TFileStream.Create(to_filename,fmCreate);
  NewFile.CopyFrom(EmailFile, EmailFile.Size);
  EmailFile.Free;
  NewFile.Free;
  //Delete the original
  if not DeleteFile(filename) then
    MessageDlg('File copied to new location, but the original was not deleted.  '+#13+#10+'Try deleting the file manually ('+filename+').', mtError, [mbOK], 0);
end;

{
  CUSTOMIZE THIS
  Process the email.
  1. Load the email
  2. Confirm that it is an update email
  3. Copy the stream to a string
  4. Run the SQL

procedure TfmEmail.ProcessEmail(filename: String);
var
  j: Integer;
  CompressedAtt, TextAtt: TMemoryStream;
  CommandString: TStringList;
begin
  //Load the email message
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  EmailMessage.LoadFromFile(filename,False);
  //Check the subject
  if EmailMessage.Subject <> 'FILTER STRING' then
    begin
      MessageDlg('The selected email is not an update email.', mtWarning, [mbOK], 0);
      Exit;
    end;
  //Get the attachment
  if EmailMessage.MessageParts.Count > 0 then
    begin
      //Go through all the message parts
      for j := 0 to EmailMessage.MessageParts.Count - 1 do
        begin
          //if the message part is an attachment, then check it out
          if EmailMessage.MessageParts.Items[j].PartType = mptAttachment then
            begin
              //Decompress the attachment
              CompressedAtt := TMemoryStream.Create;
              TextAtt := TMemoryStream.Create;
              TidAttachmentMemory(EmailMessage.MessageParts.Items[j]).SaveToStream(CompressedAtt);
              CompressedAtt.Position := 0;
              Try
                Zlib.InflateStream(CompressedAtt, TextAtt);
              Except
                MessageDlg('The attachment is in the wrong format.', mtError, [mbOK], 0);
                Exit;
              end;
              //Copy the attachment to a string
              TextAtt.Position := 0;
              if CommandString = Nil then
                CommandString := TStringList.Create
              else
                CommandString.Clear;
              CommandString.LoadFromStream(TextAtt);
              //Execute the attachment
              try
                dm.ExecSQL(CommandString.Text);
              Except
                MessageDlg('Error executing command!', mtError, [mbOK], 0);
              end;
           end;
        end;//of for loop (j)
    end//If there are message parts
  else
    MessageDlg('No attachments found to process!', mtWarning, [mbOK], 0);
end;}

{
  The currently selected item in the Archive list will be processed
}
procedure TfmEmail.ProcessArchiveEmail;
Var
  filename: String;
begin
  if lbArchiveEmail.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbArchiveEmail.Items.Objects[lbArchiveEmail.ItemIndex]);
  //Construct our filename
  filename := fldr_archive+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.ProcessEmail(filename);
end;

procedure TfmEmail.ProcessNewEmail;
Var
  filename: String;
begin
  if lbNewEmail.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbNewEmail.Items.Objects[lbNewEmail.ItemIndex]);
  //Construct our filename
  filename := fldr_new+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.ProcessEmail(filename);
  //Move our processed email to the archive folder
  MoveEmail(filename,fldr_archive);
  //Update the list boxes
  ListNewEmails;
  ListArchiveEmails;
end;

{
  Load and send the email file
}
procedure TfmEmail.SendEmailFile(filename: String);
Var
  EmailFile: TFileStream;
begin
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  EmailFile := TFileStream.Create(filename, fmOpenRead);
  EmailMessage.LoadFromStream(EmailFile, False);
  self.cur_file_size := EmailFile.Size;
  EmailFile.Free;
  try
    ConnectOutgoingMailServer;
    SMTP.Send(EmailMessage);
  finally
    EndMeter;
    if SMTP.Connected then
      begin
        try
          SMTP.Disconnect;
        except
        end;
      end;
  end;
end;

procedure TfmEmail.ResendEmail;
Var
  filename: String;
begin
  if lbSentEmails.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbSentEmails.Items.Objects[lbSentEmails.ItemIndex]);
  //Construct our filename
  filename := fldr_sent+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.SendEmailFile(filename);
end;

procedure TfmEmail.SendEmail;
Var
  filename: String;
  DoMove: Boolean;
begin
  if lbUnsentEmails.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbUnsentEmails.Items.Objects[lbUnsentEmails.ItemIndex]);
  //Construct our filename
  filename := fldr_unsent+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    begin
      DoMove := True;
      try
        SendEmailFile(filename);
      except
        on EIdSMTPReplyError do DoMove := False;
        else
          DoMove := True;
      end;
    end
  else
    DoMove := False;
  //Move our sent email to the sent folder
  if DoMove then
    MoveEmail(filename,fldr_sent);
  //Update the list boxes
  ListUnsentEmails;
  ListSentEmails;
end;

procedure TfmEmail.EndMeter;
begin
  pnlProcessing.Visible := False;
end;

procedure TfmEmail.IncMeter(num: Integer);
begin
  if num < 1 then
    num := 1;
   meter.Position := meter.Position + num;
  lblBytes.Caption := IntToStr(StrToInt(lblBytes.Caption) + num);
  self.pnlProcessing.Repaint;
end;

procedure TfmEmail.StartMeter(Max: Integer = 100);
begin
  meter.Min := 0;
  meter.Max := Max;
  meter.Step := 1;
  meter.Position := 0;
  pnlProcessing.Caption := 'Processing';
  pnlProcessing.Visible := True;
  lblBytes.Caption := '0';
  self.pnlProcessing.Repaint;
end;

procedure TfmEmail.MeterText(text: String);
begin
  pnlProcessing.Caption := Text;
  pnlProcessing.Repaint;
end;

{
  Read the headers of emails in the folder into the specified list box
}
procedure TfmEmail.ListEmails(lb: TListBox; folder: String);
Var
  Email: TIdMessage;
  sr: TSearchRec;
  display: String;
  width: Integer;
begin
  lb.Clear;
  width := lb.Width;
  //Use FindFirst, FindNext and FindClose to do a directory listing
  if FindFirst(folder+'*.email',faAnyFile,sr) = 0 then
    begin
      repeat
        Email := TIdMessage.Create(nil);
        Email.LoadFromFile(folder+sr.Name,True);
        display := FormatDateTime('YYYY-mm-dd',Email.Date) +
              ' From: ' + Email.From.Address + ' To: ' + Email.Recipients.EMailAddresses +
              ' [' +EmailMessage.Subject + ']';
        if length(display)*10 > width then
          begin
            width := length(display);
            lb.ScrollWidth := width;
          end;
        lb.Items.AddObject(display,Email);
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
end;

procedure TfmEmail.LoadEmailSettings;
var
  inFile, outFile: TFileStream;
  inFileName, outFileName: String;
  procedure TruncateInFile;
    begin
      if inFile <> Nil then
        inFile.Free;
      if outFile <> Nil then
        outFile.Free;
      if FileExists(inFileName) then
        DeleteFile(inFileName);
      if FileExists(outFileName) then
        DeleteFile(outFileName);
    end;
begin
  EmailSettingsFile.Close;
  outFileName := ExtractFilePath(Application.ExeName) + EmailSettingsFile.IniFileName;
  inFileName := outFileName + 'lock';
  if FileExists(inFileName) then
    begin
      inFile := TFileStream.Create(inFileName,fmOpenRead);
      if FileExists(outFileName) then
        outFile := TFileStream.Create(outFileName,fmOpenWrite)
      else
        outFile := TFileStream.Create(outFileName,fmCreate);
      if (inFile <> Nil) AND (inFile.Size > 0) AND (outFile <> Nil) then
        begin
          try
            Zlib.InflateStream(inFile,outFile);
          except
            on EIdException do  TruncateInFile;
            on EIdCompressionException do  TruncateInFile;
            on EIdDecompressorInitFailure do  TruncateInFile;
            on EIdCompressionError do  TruncateInFile;
            on EIdDecompressionError do  TruncateInFile;
          end;//of try statement
        end;//of if inFile and outFile are valid
      if inFile <> Nil then
        inFile.Free;
      if outFile <> Nil then
        outFile.Free;
    end;
  EmailSettingsFile.Open;
  ComponentState.Active := True;
  ComponentState.RestoreState;
  ComponentState.Active := False;
  EmailSettingsFile.Close;
  if FileExists(inFileName) then
    begin
      if not DeleteFile(outFileName) then
        begin
          outFile := TFileStream.Create(outFileName, fmOpenWrite);
          outFile.Free;
        end;
    end
  else if FileExists(outFileName) then
    begin
      inFile := TFileStream.Create(inFileName,fmCreate);
      outFile := TFileStream.Create(outFileName,fmOpenRead);
      Zlib.DeflateStream(outFile,inFile,1);
      inFile.Free;
      outFile.Free;
      if not DeleteFile(outFileName) then
        begin
          outFile := TFileStream.Create(outFileName,fmOpenWrite);
          outFile.Free;
        end;
    end;
end;

procedure TfmEmail.btnSaveSettings2Click(Sender: TObject);
begin
  self.SaveEmailSettingsToINI;
end;

procedure TfmEmail.btnSaveSettings1Click(Sender: TObject);
begin
  self.SaveEmailSettingsToINI;
end;

procedure TfmEmail.btnTestInEmailClick(Sender: TObject);
begin
  self.SaveEmailSettingsToINI;
  ConnectIncomingMailServer;
  { Currently only POP3 is supported }
  if POP3.Connected then
    begin
      MessageDlg('Connected!', mtInformation, [mbOK], 0);
      POP3.Disconnect;
    end
  else
    MessageDlg('Failed to connect.', mtInformation, [mbOK], 0);
end;

procedure TfmEmail.btnTestOutEmailClick(Sender: TObject);
begin
  SaveEmailSettingsToINI;
  ConnectOutgoingMailServer;
  if SMTP.Connected then
    begin
      MessageDlg('Successful connection!', mtInformation, [mbOK], 0);
      try
        SMTP.Disconnect(True);
      finally
        EndMeter;
      end;
    end
  else
    MessageDlg('Failed to connect.', mtInformation, [mbOK], 0);
end;

procedure TfmEmail.chkSMTPAuthClick(Sender: TObject);
begin
  if chkSMTPAuth.Checked then
    begin
      edSMTPUser.Enabled := True;
      edSMTPPassword.Enabled := True;
    end
  else
    begin
      edSMTPUser.Enabled := False;
      edSMTPPassword.Enabled := False;
    end;
end;

procedure TfmEmail.chkUseProxyClick(Sender: TObject);
begin
  if chkUseProxy.Checked then
    begin
      edProxyServer.Enabled := True;
      edProxyPort.Enabled := True;
      chkProxyAuth.Enabled := True;
      if chkProxyAuth.Checked then
        begin
          edProxyUser.Enabled := True;
          edProxyPassword.Enabled := True;
        end;
    end
  else
    begin
      edProxyServer.Enabled := False;
      edProxyPort.Enabled := False;
      chkProxyAuth.Enabled := False;
      edProxyUser.Enabled := False;
      edProxyPassword.Enabled := False;
    end;
end;

procedure TfmEmail.cbOutHostTypeSelect(Sender: TObject);
begin
  MessageDlg('Currently, only POP3 is supported.  Sorry.', mtWarning, [mbOK], 0);
end;

procedure TfmEmail.btnNewEmailClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to create a new email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    CreateNewMail;
end;

procedure TfmEmail.btnRefreshClick(Sender: TObject);
begin
  ListUnsentEmails;
  ListSentEmails;
end;

procedure TfmEmail.btnSendClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to send the email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    self.SendEmail;
end;

procedure TfmEmail.btnDeleteUnsentClick(Sender: TObject);
Var
  filename: String;
begin
  if MessageDlg('Are you sure you want to delete the un-sent email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      if lbUnsentEmails.ItemIndex < 0 then
        Exit;
      //Get the email header information
      EmailMessage := TidMessage(lbUnsentEmails.Items.Objects[lbUnsentEmails.ItemIndex]);
      //Construct our filename
      filename := fldr_unsent+EmailMessage.Subject+'.email';
      if FileExists(filename) then
        self.DeleteEmail(filename);
      self.ListUnsentEmails;
    end;
end;

procedure TfmEmail.btnDeleteSentClick(Sender: TObject);
Var
  filename: String;
begin
  if MessageDlg('Are you sure you want to delete the sent email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      if lbSentEmails.ItemIndex < 0 then
        Exit;
      //Get the email header information
      EmailMessage := TidMessage(lbSentEmails.Items.Objects[lbSentEmails.ItemIndex]);
      //Construct our filename
      filename := fldr_sent+EmailMessage.Subject+'.email';
      if FileExists(filename) then
        self.DeleteEmail(filename);
      self.ListSentEmails;
    end;
end;

procedure TfmEmail.btnResendClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to resend this email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    self.ResendEmail;
end;

procedure TfmEmail.btnDownloadClick(Sender: TObject);
begin
  DownloadMail;
end;

procedure TfmEmail.btnRefresh2Click(Sender: TObject);
begin
  ListNewEmails;
  ListArchiveEmails;
end;

procedure TfmEmail.btnProcessNewClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to process this new mail?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    self.ProcessNewEmail;
end;

procedure TfmEmail.btnDeleteNewClick(Sender: TObject);
Var
  filename: String;
begin
  if MessageDlg('Are you sure you want to delete the New email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      if lbNewEmail.ItemIndex < 0 then
        Exit;
      //Get the email header information
      EmailMessage := TidMessage(lbNewEmail.Items.Objects[lbNewEmail.ItemIndex]);
      //Construct our filename
      filename := fldr_new+EmailMessage.Subject+'.email';
      if FileExists(filename) then
        self.DeleteEmail(filename);
      self.ListNewEmails;
    end;
end;

procedure TfmEmail.btnDeleteArchiveClick(Sender: TObject);
Var
  filename: String;
begin
  if MessageDlg('Are you sure you want to delete the Archive email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    begin
      if lbArchiveEmail.ItemIndex < 0 then
        Exit;
      //Get the email header information
      EmailMessage := TidMessage(lbArchiveEmail.Items.Objects[lbArchiveEmail.ItemIndex]);
      //Construct our filename
      filename := fldr_archive+EmailMessage.Subject+'.email';
      if FileExists(filename) then
        self.DeleteEmail(filename);
      self.ListArchiveEmails;
    end;
end;

procedure TfmEmail.btnProcessArchiveClick(Sender: TObject);
begin
  if MessageDlg('Are you sure you want to process the archived email?', mtConfirmation, [mbYes,mbNo], 0) = mrYes then
    self.ProcessArchiveEmail;
end;

procedure TfmEmail.FormShow(Sender: TObject);
begin
  InitVars;
  pcEmail.ActivePage := tsSendData;
end;

procedure TfmEmail.lbUnsentEmailsDblClick(Sender: TObject);
Var
  filename: String;
begin
  if lbUnsentEmails.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbUnsentEmails.Items.Objects[lbUnsentEmails.ItemIndex]);
  //Construct our filename
  filename := fldr_unsent+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.LoadEmail(filename);
end;

procedure TfmEmail.lbSentEmailsDblClick(Sender: TObject);
Var
  filename: String;
begin
  if lbSentEmails.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbSentEmails.Items.Objects[lbSentEmails.ItemIndex]);
  //Construct our filename
  filename := fldr_sent+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.LoadEmail(filename);
end;

procedure TfmEmail.lbNewEmailDblClick(Sender: TObject);
Var
  filename: String;
begin
  if lbNewEmail.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbNewEmail.Items.Objects[lbNewEmail.ItemIndex]);
  //Construct our filename
  filename := fldr_new+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.LoadEmail(filename);
end;

procedure TfmEmail.lbArchiveEmailDblClick(Sender: TObject);
Var
  filename: String;
begin
  if lbArchiveEmail.ItemIndex < 0 then
    Exit;
  //Get the email header information
  EmailMessage := TidMessage(lbArchiveEmail.Items.Objects[lbArchiveEmail.ItemIndex]);
  //Construct our filename
  filename := fldr_archive+EmailMessage.Subject+'.email';
  if FileExists(filename) then
    self.LoadEmail(filename);
end;

procedure TfmEmail.SMTPConnected(Sender: TObject);
begin
  self.StartMeter(self.cur_file_size);
  self.MeterText('Sending E-Mail ('+ IntToStr(cur_file_size)+' bytes)');
end;

procedure TfmEmail.SMTPDisconnected(Sender: TObject);
begin
  self.EndMeter;
end;

procedure TfmEmail.SMTPWork(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  if AWorkMode = wmWrite then
      self.IncMeter(Round(AWorkCount/4000));
end;

procedure TfmEmail.POP3Connected(Sender: TObject);
begin
  self.StartMeter(100);
  self.MeterText('Downloading E-mails');
end;

procedure TfmEmail.POP3Disconnected(Sender: TObject);
begin
  self.EndMeter;
end;

procedure TfmEmail.POP3Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
  if AWorkMode = wmRead then
      self.IncMeter(Round(AWorkCount/4000));
end;

procedure TfmEmail.POP3Status(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  if (AStatus = hsDisconnecting) or (AStatus = hsDisconnected) then
    EndMeter;
end;

procedure TfmEmail.SMTPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: String);
begin
  if (AStatus = hsDisconnecting) or (AStatus = hsDisconnected) then
    EndMeter;
end;

{
  Create a New email with a StringList attachment (which gets compressed)
  From - the sender's email address
  SendTo - the recipient's email address
  Subject - the subject of the email
  filename - the name to give the Attachment (with extension)
  dbname - the database name where the email is being sent FROM
  Att - The string list that is to be the attachment.
}
procedure TfmEmail.CreateNewTextMail(Att: TStringList; From, SendTo,
  Subject, filename, dbName: String);
var
  Attachment: TidAttachmentMemory;
  EmailFile: TFileStream;
  Uncompressed, AttachBuffer: TMemoryStream;
  Body: TIdText;
  BodyText: TStringList;
begin
  //Make sure we have initialized our folders, at the least
  InitFirstUse;
  // Create a new blank message
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  EmailMessage.Clear;
  if SendTo <> '' then
    EmailMessage.Recipients.EMailAddresses := SendTo
  else
    Exit;
  if From <> '' then
    EmailMessage.From.Address := From
  else
    Exit;
  { Create the attachment }
  //Compress the File in the memory buffer
  Uncompressed := TMemoryStream.Create;
  Att.SaveToStream(Uncompressed);
  AttachBuffer := TMemoryStream.Create;
  Uncompressed.Position := 0;
  Zlib.DeflateStream(Uncompressed,AttachBuffer,9);
  Uncompressed.Free;
  AttachBuffer.Seek(0,soFromBeginning);
  Attachment := TidAttachmentMemory.Create(EmailMessage.MessageParts, AttachBuffer);
  AttachBuffer.Free;
  Attachment.FileName := filename;
  Attachment.ContentTransfer := 'base64';
  Attachment.ContentID := 'SingleAttachment';
  //HEADERS
  EmailMessage.Subject := Subject;
  BodyText := TStringList.Create;
  BodyText.Append('Zipped Text E-mail');  //0
  BodyText.Append(FormatDateTime('yyyymmddhhnnss', Now));//1
  BodyText.Append(dbName);                //2
  BodyText.Append(filename);         //3
  Body := TIdText.Create(EmailMessage.MessageParts, BodyText);
   //Save EmailMessage to the unsent folder
  EmailMessage.GenerateHeader;
  EmailFile := TFileStream.Create(fldr_unsent+EmailMessage.Subject+'.email',fmCreate);
  EmailMessage.SaveToStream(EmailFile,False);
  EmailFile.Free;
  //Refresh our listing
  ListUnsentEmails;
end;

end.



This is the source code for one of the sub-classes.


unit FormPFEmail;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,
  FormEmail, IdAttachmentMemory, IdMessageParts, StrUtils, IdMessage, DataModule,
  FormMySQLBackup, IdText;

type
  TfmPFEmail = class(TfmEmail)
  protected
    { proTecTed deClarations }
    procedure ProcessEmail(filename: String); override;
    procedure CreateNewMail; override;
    procedure DownloadMail; override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmPFEmail: TfmEmail;

implementation

uses
  Dialogs;

{ TfmPFEmail }

procedure TfmPFEmail.CreateNewMail;
begin
  MessageDlg('Updates are created on Employee transfers (on the Employees '+#13+#10+'screen).', mtInformation, [mbOK], 0);
end;

procedure TfmPFEmail.DownloadMail;
Var
  i, MsgCount, curMsgSize: Integer;
  EmailFile: TFileStream;
begin
  ConnectIncomingMailServer;
  //Download the mail
  if cbOutHostType.ItemIndex = 0 then //POP3
    begin
      //Verify that we're connected.
      if not POP3.Connected then
        begin
          MessageDlg('The POP3 client could not connect to the server.  Some setting '+#13+#10+'must be wrong.  Fix the settings and try again.', mtError, [mbOK], 0);
          EndMeter;
          Exit;
        end;
      MsgCount := POP3.CheckMessages;
      //Go through all the messages on the server, downloading the ones we need
      for i := 1 to MsgCount do
        begin
          StartMeter(1000);
          MeterText('Checking ' + IntToStr(i) + ' of ' + IntToStr(MsgCount) + ' messages');
          if EmailMessage = Nil then
            EmailMessage := TIdMessage.Create(self);
          POP3.RetrieveHeader(i, EmailMessage);
          if (LeftStr(EmailMessage.Subject, 17) = 'PayrollDataUpdate') OR
              (LeftStr(EmailMessage.Subject, 16) = 'PayrollDataEmail') then
            begin
              curMsgSize := POP3.RetrieveMsgSize(i);
              self.StartMeter(curMsgSize);
              MeterText('Downloading ' + IntToStr(i) + ' of ' + IntToStr(MsgCount) + ' messages');
              //Download the entire message
              POP3.Retrieve(i, EmailMessage);
              //Add a new header for filename
              EmailMessage.Headers.Append(fldr_new+EmailMessage.Subject+'.email');
              //Save the mail to the email\new folder
              EmailFile := TFileStream.Create(fldr_new+EmailMessage.Subject+'.email',fmCreate);
              EmailMessage.SaveToStream(EmailFile,False);
              EmailFile.Free;
              EmailMessage.Free;
              if EmailMessage = Nil then
                EmailMessage := TIdMessage.Create(self);
              POP3.Delete(i);//Remove the message from the server.
            end;//end of downloading email
        end;//end of for loop
      EndMeter;
      POP3.Disconnect;
      if POP3.IOHandler.Opened then
        POP3.IOHandler.Close;
    end;
  ListNewEmails;
end;

procedure TfmPFEmail.ProcessEmail(filename: String);
var
  j: Integer;
  CompressedAtt, TextAtt: TMemoryStream;
  DataFile: TFileStream;
  TextStrings: TStringList;
  att_filename, dbName, SQL: String;
begin
  //Load the email message
  if EmailMessage = Nil then
    EmailMessage := TidMessage.Create;
  EmailMessage.LoadFromFile(filename,False);
  //Check the subject
  if EmailMessage.Subject <> 'FILTER' then
    begin
      MessageDlg('The selected email is not a data email.', mtWarning, [mbOK], 0);
      Exit;
    end;
  dbName := '';
  //Get the attachment
  if EmailMessage.MessageParts.Count > 0 then
    begin
      //Go through all the message parts to find the text portion (to get a var name)
      for j := 0 to EmailMessage.MessageParts.Count - 1 do
        begin
          //if the message part is text, then check to see if it has the database name
          if EmailMessage.MessageParts.Items[j].PartType = mptText then
            begin
              TextStrings := TStringList.Create;
              TextStrings.AddStrings(TidText(EmailMessage.MessageParts.Items[j]).Body);
              //Get the database name
              if TextStrings.Strings[0] <> 'FILTER STRING 1' then
              //This text attachment is not the one we're looking for
                break
              else
                dbName := TextStrings.Strings[2];
              TextStrings.Free;
            end;
        end;
      //Verify the dbName
      SQL := 'SELECT DBName FROM mytable WHERE DBName = ''' + dbName + ''';';
      dm.MiscQry(SQL);
      if dm.qryMisc.RecordCount <> 1 then
        begin
          MessageDlg('The database name ('+dbName+') for this grouping is incorrect.  Exiting.', mtError, [mbOK], 0);
          Exit;
        end;
      dm.qryMisc.Active := False;
      //Check to see if we have a database name
      if dbName = '' then
        begin
          MessageDlg('No suitable database name could be found.  Exiting.', mtError, [mbOK], 0);
          Exit;
        end;
      //Go through all the message parts to find the attachment
      for j := 0 to EmailMessage.MessageParts.Count - 1 do
        begin
          //if the message part is an attachment, then check it out
          if EmailMessage.MessageParts.Items[j].PartType = mptAttachment then
            begin
              //Decompress the attachment
              CompressedAtt := TMemoryStream.Create;
              att_filename := fldr_temp + EmailMessage.MessageParts.Items[j].FileName;
              TidAttachmentMemory(EmailMessage.MessageParts.Items[j]).SaveToStream(CompressedAtt);
              CompressedAtt.Position := 0;
              try
                DataFile := TFileStream.Create(att_filename,fmCreate);
              except
                MessageDlg('Could not create temporary file.  Exiting operation.', mtError, [mbOK], 0);
                Exit;
              end;
              //Decompress the attachment to a file
              Try
                Zlib.InflateStream(CompressedAtt, DataFile);
              Except
                MessageDlg('The attachment is in the wrong format.', mtError, [mbOK], 0);
                Exit;
              end;
              //Close the file and the attachment
              CompressedAtt.Free;
              DataFile.Free;
              //Run a db restore on the file
              if fmMySQLBackup = Nil then
                fmMySQLBackup := TfmMySQLBackup.Create(nil);
              fmMySQLBackup.Restore(att_filename,dbName,dm.db.User, dm.db.Password,
                dm.db.HostName,IntToStr(dm.db.Port),'');
              //Delete the temporary file
              if not DeleteFile(att_filename) then
                MessageDlg('The temporary file could not be deleted.  Try deleting it '+#13+#10+'manually (file name: '+att_filename+').', mtWarning, [mbOK], 0);
           end;
        end;//of for loop (j)
    end//If there are message parts
  else
    MessageDlg('No attachments found to process!', mtWarning, [mbOK], 0);
end;

end.

Popular posts from this blog

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