unit MailerFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdMessage, ExtCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  IdHeaderList,
  UtlType, PropUtl, ExeLogu, UlanGlob;

type
  TMailerForm = class(TForm)
    IdSMTP: TIdSMTP;
    Password: TLabeledEdit;
    UserID: TLabeledEdit;
    Host: TLabeledEdit;
    IdMessage: TIdMessage;
    Memo: TMemo;
    SendButton: TButton;
    OKButton: TButton;
    To_: TLabeledEdit;
    Subject_: TLabeledEdit;
    Label1: TLabel;
    EmailOnAbortCheckBox: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure OKButtonClick(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
  private
    { Private declarations }
    //Rec: shortstring;
    procedure FormToComp;
    procedure CompToForm;
  public
    { Public declarations }
  end;

var
  MailerForm: TMailerForm;

{ Send e-mail using parameters specified in the idSMTP and idMessage }
procedure SMTPSend(idSMTP: TidSMTP; idMessage: TidMessage);

{ Will send e-mail with Msg message in the body to the address specified
  in the setup form. Raise exception if something fails. }
procedure EMailCulMsg(const Msg: string);

{ As EMailCulMsg, but does not raise exception, just silently dies.
  Useful for calling from automated processes. }
procedure TryEmailCulMsg(const Msg: string);

implementation
const
  HdrIni = 'mail_hdr.ini';

{$R *.dfm}

procedure IdMessageSave(idMessage: TIdMessage; const AFileName: string);
var
  h: TIdHeaderList;
begin
  h := idMessage.GenerateHeader;
  try
    h.Add('Subject: ' + idMessage.Subject);
    h.SaveToFile(HdrIni);
  finally
    h.Free;
  end;
end;

procedure IdMessageLoad(idMessage: TIdMessage; const AFileName: string);
var
  h: TIdHeaderList;
  i: integer;
begin
  if FileExists(AFileName) then begin
    h := TIdHeaderList.Create;
    try
      h.LoadFromFile(HdrIni);
      idMessage.Headers.Assign(h);
      if h.IndexOfName('To') >= 0 then
        idMessage.Recipients.EmailAddresses := h.Values['To'];
      if h.IndexOfName('Subject') >= 0 then
        idMessage.Subject := h.Values['Subject'];
    finally
      h.Free;
    end;
  end;
end;

procedure IdMessageSetDefs(idMessage: TIdMessage);
begin
  idMessage.Headers.Values['From'] := 'chromulan@chromulan.org';
  //idMessage.Recipients.EMailAddresses := edtTo.Text; { To: header }
  //idMessage.Subject := 'cul msg';
  idMessage.Priority := TIdMessagePriority(0); { Message Priority }
  //CCList.EMailAddresses := edtCC.Text; {CC}
  //BccList.EMailAddresses := edtBCC.Text; {BBC}
  //if chkReturnReciept.Checked then
  //begin {We set the recipient to the From E-Mail address }
  //ReceiptRecipient.Text := From.Text;
  //end
  //else
  //begin {indicate that there is no receipt recipiant}
  idMessage.ReceiptRecipient.Text := '';
  //end;
end;

procedure TMailerForm.FormCreate(Sender: TObject);
begin
{SetDefaults}
  //idMessage.Recipients.Add;
  IdMessageSetDefs(idMessage);

  idSMTP.MailAgent := 'CHROMuLAN';
  idSMTP.Port := 25;
{/SetDefaults}

  IdMessageLoad(idMessage, HdrIni);
  ClassReadWriteIniFile(idSMTP, 0, '', true);{proputl}

//  ClassReadWriteIniFile(idMessage, 0, '', true);
//  ConfigReadWriteValue(nil, rwRead, 'idSMTP', 'recipient', @Rec, ptString);
//  ClassReadWriteIniFile(idMessage.Recipients[0], 0, '', true);


  CompToForm;
end;

procedure TMailerForm.OKButtonClick(Sender: TObject);
var h: TIdHeaderList;
begin
  FormToComp;

  ClassReadWriteIniFile(idSMTP, 0, '', false);
  IdMessageSave(idMessage, HdrIni);
end;


procedure TMailerForm.FormToComp;
var
  i: integer;
  c: TControl;
  n: string;
  v: string;
begin
  idSMTP.Host := Host.Text;
  idSMTP.Password := Password.Text;
  idSMTP.UserID := UserID.Text;

  for i := 0 to ControlCount - 1 do begin
    c := Controls[i];
    if c.Name[length(c.Name)] = '_' then begin
      n := copy(c.Name, 1, length(c.Name) - 1);
      v := '';//c.Caption;
      if c is TLabeledEdit then begin
        v := TLabeledEdit(c).Text;
      end;
      idMessage.Headers.Values[n] := v;
      if n = 'To' then
        idMessage.Recipients.EMailAddresses := v;
      if n = 'Subject' then
        idMessage.Subject := v;
    end;
  end;
//  Rec :=
  EmailOnAbort := EmailOnAbortCheckbox.Checked;
  //idMessage.Recipients[0].Address := Rec;
  idMessage.Body.Assign(Memo.Lines);
end;

procedure TMailerForm.CompToForm;
var
  i: integer;
  c: TControl;
begin
  Host.Text := idSMTP.Host;
  Password.Text := idSMTP.Password;
  UserID.Text := idSMTP.UserID;
  EmailOnAbortCheckbox.Checked := EmailOnAbort;
  To_.Text := idMessage.Recipients.EMailAddresses;
  Subject_.Text := idMessage.Subject;
  for i := 0 to ControlCount - 1 do begin
    c := Controls[i];
    if c.Name[length(c.Name)] = '_' then begin
      if c is TLabeledEdit then
        TLabeledEdit(c).Text := idMessage.Headers.Values[copy(c.Name, 1, length(c.Name) - 1)];
    end;
  end;

//  Rec;
//  idMessage.Recipients.EMailAddresses := Rec;
  //idMessage.Recipients[0].Address := Rec;
end;


procedure TMailerForm.SendButtonClick(Sender: TObject);
begin
  FormToComp;
  SMTPSend(idSMTP, idMessage);
  ShowMessage('Test message was sent.');
end;

procedure Log(const Msg: string);
begin
  ExeLog.Log(Msg);
end;

(*
procedure SMTPSend(idSMTP: TidSMTP; idMessage: TidMessage);
begin
  with IdMessage do
  begin
    Body.Assign(Memo1.Lines);
    From.Text := UserEmail;
    Recipients.EMailAddresses := edtTo.Text; { To: header }
    Subject := edtSubject.Text; { Subject: header }
    Priority := TIdMessagePriority(cboPriority.ItemIndex); { Message Priority }
    CCList.EMailAddresses := edtCC.Text; {CC}
    BccList.EMailAddresses := edtBCC.Text; {BBC}
    if chkReturnReciept.Checked then
    begin {We set the recipient to the From E-Mail address }
      ReceiptRecipient.Text := From.Text;
    end
    else
    begin {indicate that there is no receipt recipiant}
      ReceiptRecipient.Text := '';
    end;
  end;

  {authentication settings}
  case SmtpAuthType of
    0: SMTP.AuthenticationType := atNone;
    1: SMTP.AuthenticationType := atLogin; {Simple Login}
  end;
  SMTP.UserID := SmtpServerUser;
  SMTP.Password := SmtpServerPassword;

  {General setup}
  SMTP.Host := SmtpServerName;
  SMTP.Port := SmtpServerPort;

  {now we send the message}
  SMTP.Connect;
  try
    SMTP.Send(IdMsgSend);
  finally
    SMTP.Disconnect;
  end;
end;
*)

procedure SMTPSend(idSMTP: TidSMTP; idMessage: TidMessage);
var i: integer;
begin
  if (idSMTP.Password <> '') and (idSMTP.UserID <> '') then begin
    idSMTP.AuthenticationType := atLogin;
  end else begin
    idSMTP.AuthenticationType := atNone;
  end;

  try
    idSMTP.Connect;
    Log('SMTP Connected to ' + idSMTP.Host + '. Auth. schemes supported:');
    for i := 0 to idSMTP.AuthSchemesSupported.Count - 1 do begin
      Log('  ' + idSMTP.AuthSchemesSupported[i]);
    end;
    try
      {if not idSMTP.Authenticate then begin
        Log('Auth failed.');
        ShowMessage('Authentication failed.');
        //exit;
      end else begin
        Log('Auth OK.');
      end;
      }
      try
        idSMTP.Send(idMessage);
      except
        Log('Send failed.');
        raise;
      end;
    finally
      idSMTP.Disconnect;
    end;
  except
    Log('SMTP send failed');
    raise;
  end;
end;

procedure EMailCulMsg(const Msg: string);
begin
  MailerForm.idMessage.Body.Text := Msg;
  SMTPSend(MailerForm.idSMTP, MailerForm.IdMessage);
end;

procedure TryEmailCulMsg(const Msg: string);
begin
  try
    EMailCulMsg(Msg);
  except
  end;
end;

end.
