AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Netzwerke Delphi Memo an E-Mail versenden.
Thema durchsuchen
Ansicht
Themen-Optionen

Memo an E-Mail versenden.

Ein Thema von Area51 · begonnen am 29. Apr 2006 · letzter Beitrag vom 7. Aug 2013
 
bernhard_LA

Registriert seit: 8. Jun 2009
Ort: Bayern
1.142 Beiträge
 
Delphi 11 Alexandria
 
#19

AW: Memo an E-Mail versenden.

  Alt 7. Aug 2013, 19:51
Anbei ein Code Ausschnitt aus meinem E MAil Programm, alles mit DELPHI XE2 und INDY 10 ....



Delphi-Quellcode:


unit Unit_simpleEMail;

///
/// *** very simple e mail client with INDY 10 ****
///
/// by BDLM :
///
/// version 01 : can read e mails from the host
/// can write e mails
///
///
///
///
///
///
///
///
///
///
///
///

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, email_classes,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.ComCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdSMTP, Idtext, IdGlobalProtocols, IdGlobal,
  IdAttachment, IdMessageParts, IdAttachmentFile,
  IdExplicitTLSClientServerBase, IdMessageClient, IdPOP3, contnrs,
  IdMessage, Vcl.StdCtrls, Vcl.ExtCtrls, inifiles, IdSMTPBase;

type



  TSimpleMailForm = class(TForm)
    MainMenu1: TMainMenu;
    SimpleMailStatusBar: TStatusBar;
    File1: TMenuItem;
    Mail1: TMenuItem;
    SetUp1: TMenuItem;
    Exit1: TMenuItem;
    EmailSettingsMenuItem: TMenuItem;
    MyIndyPOP3: TIdPOP3;
    Connect1: TMenuItem;
    EMails1: TMenuItem;
    Panel1: TPanel;
    Panel2: TPanel;
    EMailInListBox: TListBox;
    Splitter1: TSplitter;
    WriteNewEMail1: TMenuItem;
    Panel3: TPanel;
    MailSubjectLabel: TLabel;
    MailFromLabel: TLabel;
    CCLabel: TLabel;
    BCCLabel: TLabel;
    MailBoxPanel: TPanel;
    Help1: TMenuItem;
    ber1: TMenuItem;
    MyIndySMTP: TIdSMTP;
    MyNewIndyMessage: TIdMessage;
    Benutzerliste1: TMenuItem;
    ffneBenutzerliste1: TMenuItem;
    MyOpenDialog: TOpenDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    MailBodyMemo: TMemo;
    RichEdit1: TRichEdit;
    procedure Exit1Click(Sender: TObject);
    procedure Connect1Click(Sender: TObject);
    procedure EMails1Click(Sender: TObject);
    procedure EmailSettingsMenuItemClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure EMailInListBoxDblClick(Sender: TObject);
    procedure WriteNewEMail1Click(Sender: TObject);
    procedure ber1Click(Sender: TObject);
    procedure Benutzerliste1Click(Sender: TObject);
    procedure ffneBenutzerliste1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    FEMailUserList: TEMailUserList;
    FuserListFile: String;
    Factiveuserindex: Integer;

  public
    { Public-Deklarationen }
    MsgList: TObjectlist;

    Msg_attach : String;

    msg_to : String;

    msg_sub : String;

    msg_Line : string;



    SelectedMailItem: Integer;

    FActiveEMailUser: TEMailUser;

    Attachment: TIdAttachment;

    procedure SetActiveUser(aUserIndex: Integer);

    procedure LoadPostOfficeParameter(aFile: String);

    procedure SetSMTPValues(Sender: TObject);

    procedure SendMail(edfrom, edto, edcc, edBcc, edSubject: string;
      edContent: TStrings);

    procedure AttachFile(aAttachmentFilename: String);

    procedure DisplayMultiPartAlternative(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);

    procedure DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);

    procedure DisplayPlainText(Body: TStrings);

    procedure DisplayHTML(Body: TStrings);

    procedure DisplayMsg(aMsg: TIdMessage);

    procedure CommandLineEMail;

  end;

var
  SimpleMailForm: TSimpleMailForm;





implementation

uses Unit_email_write, Unit_email_settings, ABOUT, Unit_emailBenutzerliste;

{$R *.dfm}

procedure TSimpleMailForm.Benutzerliste1Click(Sender: TObject);
begin

     BenutzerListenAnzeigeForm.Benutzerliste := FEMailUserList;

     BenutzerListenAnzeigeForm.Show;
end;

procedure TSimpleMailForm.ber1Click(Sender: TObject);
begin
  AboutBox.Show;
end;

procedure TSimpleMailForm.Connect1Click(Sender: TObject);
begin
  if not MyIndyPOP3.Connected then
  begin
    MyIndyPOP3.Host := EMailSettingsForm.popedHost.Text;
    MyIndyPOP3.Port := StrToInt(EMailSettingsForm.popedPort.Text);
    MyIndyPOP3.UserName := EMailSettingsForm.popedUser.Text;
    MyIndyPOP3.Password := EMailSettingsForm.popedPassword.Text;
    MyIndyPOP3.Connect;
    Connect1.checked := true;
    SimpleMailStatusBar.SimpleText := ' connected to ' +
      EMailSettingsForm.popedHost.Text;
  end
  else
  begin
    MyIndyPOP3.Disconnect;

    Connect1.checked := false;

    SimpleMailStatusBar.SimpleText := ' disconnected from ' +
      EMailSettingsForm.popedHost.Text;
  end;
end;

procedure TSimpleMailForm.EMailInListBoxDblClick(Sender: TObject);
begin

  SelectedMailItem := EMailInListBox.ItemIndex;

  SimpleMailStatusBar.SimpleText := ' MailItem ' + IntToStr(SelectedMailItem);

  MailBodyMemo.Lines.Clear;

  MyIndyPOP3.Retrieve(SelectedMailItem,
    TIdMessage(MsgList.Items[SelectedMailItem - 1]));

  MailSubjectLabel.Caption := 'Subject: ' +
    TIdMessage(MsgList.Items[SelectedMailItem]).Subject;

  MailFromLabel.Caption := 'From : ' +
    TIdMessage(MsgList.Items[SelectedMailItem]).FromList.EMailAddresses;

  BCCLabel.Caption := 'BCC : ' + TIdMessage(MsgList.Items[SelectedMailItem])
    .BccList.EMailAddresses;

  CCLabel.Caption := 'CC : ' + TIdMessage(MsgList.Items[SelectedMailItem])
    .CCList.EMailAddresses;

// MailBodyMemo.Lines.AddStrings
// (LinesFromMsg(TIdMessage(MsgList.Items[SelectedMailItem])));

DisplayMsg( TIdMessage(MsgList.Items[SelectedMailItem]));

end;


procedure TSimpleMailForm.DisplayPlainText(Body: TStrings);
begin
  // display plain text as needed...

  MailBodyMemo.Lines.AddStrings(Body);
end;

procedure TSimpleMailForm.DisplayHTML(Body: TStrings);
begin
  // display html as needed...
  RichEdit1.Lines.AddStrings(Body)
end;

procedure TSimpleMailForm.DisplayMultiPartAlternative(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
  Part: TIdMessagePart;
  i: Integer;
begin
  for i := aLastIndex-1 downto aParentIndex+1 do
  begin
    Part := aMsg.MessageParts.Items[i];
    if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
    begin
      if IsHeaderMediaType(Part.ContentType, 'text/html') then
      begin
        DisplayHTML(TIdText(Part).Body);
        Exit;
      end;
      if IsHeaderMediaType(Part.ContentType, 'text/plain') then
      begin
        DisplayPlainText(TIdText(Part).Body);
        Exit;
      end;
    end;
  end;
  // nothing supported to display...
end;

procedure TSimpleMailForm.DisplayMultiPartMixed(aMsg: TIdMessage; aParentIndex, aLastIndex: Integer);
var
  Part: TIdMessagePart;
  i: Integer;
begin
  for i := aLastIndex-1 downto aParentIndex+1 do
  begin
    Part := aMsg.MessageParts.Items[i];
    if (Part.ParentPart = aParentIndex) and (Part is TIdText) then
    begin
      if IsHeaderMediaType(Part.ContentType, 'multipart/alternative') then
      begin
        DisplayMultiPartAlternative(aMsg, Part.Index, aLastIndex);
        Exit;
      end;
      if IsHeaderMediaType(Part.ContentType, 'text/html') then
      begin
          DisplayHTML(TIdText(Part).body);
        Exit;
      end;
      if IsHeaderMediaType(Part.ContentType, 'text/plain') then
      begin
          DisplayPlainText(TIdText(Part).body);
        Exit;
      end;
      aLastIndex := i;
    end;
    // nothing supported to display...
  end;
end;

procedure TSimpleMailForm.DisplayMsg(aMsg: TIdMessage);
var
  ContentType: string;
begin
  ContentType := ExtractHeaderMediaType(aMsg.ContentType);

  SimpleMailStatusBar.SimpleText := ' content Type= ' + ContentType ;

  case PosInStrArray(ContentType, ['multipart/mixed', 'multipart/alternative', 'text/html', 'text/plain','text'], False) of
    0: begin
      DisplayMultiPartAlternative(aMsg, -1, aMsg.MessageParts.Count);
      Exit;
    end;
    1: begin
      DisplayMultiPartMixed(aMsg, -1, aMsg.MessageParts.Count);
      Exit;
    end;
    2: begin
      DisplayHTML(aMsg.Body);
      Exit;
    end;
    3,4: begin
      DisplayPlainText(aMsg.Body);
      Exit;
    end;
  else
    // nothing supported to display...
  end;
end ;

procedure TSimpleMailForm.EMails1Click(Sender: TObject);
var
  MailCount: Integer;
  i: Integer;
  Msg: TIdMessage;
begin

  MailBoxPanel.Caption := ' MAILBOX ' + MyIndyPOP3.Host;

   EMailInListBox.Items.Clear;

  if MyIndyPOP3.Connected then
  begin
    MailCount := MyIndyPOP3.CheckMessages;

    SimpleMailStatusBar.SimpleText := 'Mail Box Size ' +
      IntToStr(MyIndyPOP3.RetrieveMailBoxSize) + ' Bytes' + 'Mail Count ' +
      IntToStr(MailCount);

    for i := 1 To MailCount Do
    begin
      Msg := TIdMessage.Create;
      try

        MyIndyPOP3.RetrieveHeader(i, Msg);

        MsgList.Add(Msg);

        EMailInListBox.Items.Add(DateToStr(Msg.Date) + TimeToStr(Msg.Date) +
          ' von ' + Msg.From.Text);
      finally
        ///
      end;
    end;
  end;

end;

procedure TSimpleMailForm.Exit1Click(Sender: TObject);
begin
  close;
end;

procedure TSimpleMailForm.ffneBenutzerliste1Click(Sender: TObject);
begin
   if MyOpenDialog.Execute then
   begin
     if fileexists(FuserListFile) then
  begin

    FuserListFile := MyOpenDialog.FileName;

    FEMailUserList.LoadFromFile(FuserListFile);

    SimpleMailStatusBar.SimpleText := ' load userliste : ' + FuserListFile + ' nr of e mail users '  + IntToStr(FEMailUserList.count) ;

  end

   end;
end;

procedure TSimpleMailForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MsgList.Free;

  FEMailUserList.Free;
end;

procedure TSimpleMailForm.FormCreate(Sender: TObject);
begin
  MsgList := TObjectlist.Create;

  MailSubjectLabel.Caption := 'Subject: ';

  MailFromLabel.Caption := 'From : ';

  BCCLabel.Caption := 'BCC : ';

  CCLabel.Caption := 'CC : ';

  FEMailUserList := TEMailUserList.Create;

end;

procedure TSimpleMailForm.FormShow(Sender: TObject);
var
  aFile: String;
  i: Integer;
begin

  for i := 1 to ParamCount do
  begin

    if ParamStr(i) = 'userfilethen
    begin
      FuserListFile := ParamStr(i + 1);
    end;

    if ParamStr(i) = 'activeuserindexthen
    begin
      Factiveuserindex := StrToInt(ParamStr(i + 1))-1;
    end;

    if ParamStr(i) = 'msg_tothen
    begin
       Msg_To := ParamStr(i + 1);
    end;

    if ParamStr(i) = 'msg_subthen
    begin
       Msg_sub := ParamStr(i + 1);
    end;

      if ParamStr(i) = 'msg_linethen
    begin
       Msg_line := ParamStr(i + 1);
    end;

    if ParamStr(i) = 'msg_attachthen
    begin
       Msg_attach := ParamStr(i + 1);
    end;

  end;

  ///
  ///
  /// -----------------------------------
  ///
  ///

  if fileexists(FuserListFile) then
  begin

    FEMailUserList.LoadFromFile(FuserListFile);

    SimpleMailStatusBar.SimpleText := ' load userliste : '    + ' nr of e mail users : '  + IntToStr(FEMailUserList.count) ;

  end
  else
  begin

  SimpleMailStatusBar.SimpleText := ' userliste not found ! command line param : userfile '  ;

  end;

  if ((Factiveuserindex > -1) and (Factiveuserindex < FEMailUserList.Count ))
  then
  begin

    SetActiveUser(Factiveuserindex);

  end;


    ///
  ///
  /// -----send a mail and close the program at the end ...----------
  ///
  ///

  if (msg_to <> '') and (msg_line<> '') and (msg_sub <>'') then
       begin

       SimpleMailStatusBar.SimpleText := 'sending robot mail .... ';

       CommandLineEMail;

       SimpleMailStatusBar.SimpleText := 'sending robot done .... ';

       Close;

       end;

end;


procedure TSimpleMailForm.CommandLineEMail;
var MyLines : TStrings;
begin
      MyLines :=TStringList.Create;

       SetSMTPValues(nil);

       AttachFile(msg_attach);

       MyLines.Add(msg_line);

       MyLines.Add('********************************************* ');

       MyLines.Add(' this is an automatic generated e mail ');

       MyLines.Add(' generated with FREE SOFTWARE simple mail ' );

       MyLines.Add(' http://sourceforge.net/projects/simpleemail/ ');

       MyLines.Add('********************************************* ');

       SendMail( FActiveEMailUser.UserEMail, msg_to, '','', msg_sub, MyLines );

       MyLines.Free;

       if (Attachment <> nil) then freeandnil( Attachment );


end;

procedure TSimpleMailForm.SetActiveUser(aUserIndex: Integer);

begin

  FActiveEMailUser := TEMailUser(FEMailUserList.Items[aUserIndex]);

  LoadPostOfficeParameter( FActiveEMailUser.UserSettings);

end;

procedure TSimpleMailForm.LoadPostOfficeParameter(aFile: String);
var
  aIniFile: TIniFile;
begin

  aIniFile := TIniFile.Create(aFile);

  EMailSettingsForm.popedHost.Text := aIniFile.ReadString('POP3', 'Host',
    'pop3.myoffice.org');
  EMailSettingsForm.popedPort.Text := aIniFile.ReadString('POP3',
    'port', '110');
  EMailSettingsForm.popedUser.Text := aIniFile.ReadString('POP3', 'user',
    'error no user name found !');
  EMailSettingsForm.popedPassword.Text := aIniFile.ReadString('POP3',
    'password', 'error no user password found !');

  EMailSettingsForm.smtpedHost.Text := aIniFile.ReadString('smtp', 'Host',
    'pop3.myoffice.org');
  EMailSettingsForm.smtpedUser.Text := aIniFile.ReadString('smtp', 'user',
    'error no user name found !');
  EMailSettingsForm.smtpedPassword.Text := aIniFile.ReadString('smtp',
    'password', 'error no user password found !');

  aIniFile.Free;

end;

procedure TSimpleMailForm.EmailSettingsMenuItemClick(Sender: TObject);
begin

  SimpleMailStatusBar.SimpleText := 'Kontoeinstellungen anzeigen und abändern';

  EMailSettingsForm.EMailUserList := FEMailUserList;

  EMailSettingsForm.Show;
end;

procedure TSimpleMailForm.WriteNewEMail1Click(Sender: TObject);
begin

   SimpleMailStatusBar.SimpleText := 'EMails schreiben';

  WriteEMailForm.Show;
end;

procedure TSimpleMailForm.SetSMTPValues(Sender: TObject);
begin
  // Authentifizierung mit dem smtp server --- Server authentication
  MyIndySMTP.AuthType := TIdSMTPAuthenticationType.satDefault;

  // Benutzerdaten für Authentifizierung --- set Server Username & Password
  MyIndySMTP.UserName := EMailSettingsForm.smtpedUser.Text;
  MyIndySMTP.Password := EMailSettingsForm.smtpedPassword.Text;

  // Server-Daten
  MyIndySMTP.Host := EMailSettingsForm.smtpedHost.Text;
  MyIndySMTP.Port := 25; // confirm this data !
end;

procedure TSimpleMailForm.AttachFile(aAttachmentFilename: String);
begin
  Attachment := TIdAttachmentFile.Create(MyNewIndyMessage.MessageParts,
    aAttachmentFilename);
end;

procedure TSimpleMailForm.SendMail(edfrom, edto, edcc, edBcc, edSubject: string;
  edContent: TStrings);
begin
  MyIndySMTP.Connect;

  try
    MyNewIndyMessage.From.Address := edfrom;
    MyNewIndyMessage.Recipients.EMailAddresses := edto;
    MyNewIndyMessage.CCList.EMailAddresses := edcc;
    MyNewIndyMessage.BccList.EMailAddresses := edBcc;
    MyNewIndyMessage.Subject := edSubject;
    MyNewIndyMessage.Body := edContent;
    MyIndySMTP.Send(MyNewIndyMessage);
  finally
    MyIndySMTP.Disconnect;
  end;
end;



end.
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz