(Delphi 7) Email HTML

[camaleonteplus]

Finalmente sono riuscito a finire il mio programma per l'invio della posta elettronica, al mio programma vorrei aggiungere la possibilità di inviare posta anche in formato HTML, vsto che adesso la posso inviare solo in formato testo, uso il componente Indy smtp, per avere un aiuto devo postare il codice?

[camaleonteplus]

unit Email;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, RzPanel, StdCtrls, Buttons, IdIPWatch,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, ComCtrls, MauryXPGroup, IdMessage, REAbout, Mask,
  ScktComp, XPStyleActnCtrls, ActnList, ActnMan, Menus, RzDlgBtn, jpeg,
  StdActns, ExtActns, RzButton, WinTypes, ShellAPI, mmSystem, WaveUtils,
  WaveStorage, WaveIO, WaveOut, WavePlayers, Sockets, WinInet;

type
  TForm1 = class(TForm)
    SMTP: TIdSMTP;
    Panel1: TPanel;
    Allega: TBitBtn;
    MailMessage: TIdMessage;
    Allegato: TEdit;
    GroupBox1: TGroupBox;
    Nome: TEdit;
    Email1: TLabel;
    Da: TEdit;
    GroupBox2: TGroupBox;
    Email2: TLabel;
    Email3: TLabel;
    Cc: TEdit;
    Ccn: TEdit;
    Group1: TMauryXPGroup;
    Group2: TMauryXPGroup;
    Anonimo: TRadioButton;
    Autentificato: TRadioButton;
    Username: TEdit;
    Password: TEdit;
    Group3: TMauryXPGroup;
    OpenDialog1: TOpenDialog;
    Messaggio: TRichEdit;
    Oggetto: TEdit;
    Email4: TLabel;
    Server: TComboBox;
    MainMenu1: TMainMenu;
    Edit1: TMenuItem;
    About: TMenuItem;
    Info: TLabel;
    Agent: TComboBox;
    IdTCPClient1: TIdTCPClient;
    Acceso: TRzButton;
    RzButton1: TRzButton;
    StatusBar1: TStatusBar;
    Stop: TBitBtn;
    Spedisci: TBitBtn;
    MauryXPGroup2: TMauryXPGroup;
    Num: TEdit;
    UpDown1: TUpDown;
    Bombing: TBitBtn;
    Host: TEdit;
    Label5: TLabel;
    Port: TEdit;
    Status: TLabel;
    A: TEdit;
    MauryXPGroup1: TMauryXPGroup;
    Carica: TBitBtn;
    Edit: TBitBtn;
    Clean: TRzButton;
    Lista: TComboBox;
    Tcp: TTcpClient;
    MauryXPGroup3: TMauryXPGroup;
    InfoDominio: TLabel;
    HostLocale: TLabel;
    TCPInfo: TBitBtn;
    Conta: TLabel;
    Edit2: TMenuItem;
    Grassetto1: TMenuItem;
    Corsivo1: TMenuItem;
    Sottolineato1: TMenuItem;
    AllineaSX1: TMenuItem;
    Centra1: TMenuItem;
    AllineaDX1: TMenuItem;
    IP: TIdIPWatch;
    IPLocale: TLabel;
    IPCorrente: TLabel;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    EditUndo1: TEditUndo;
    EditDelete1: TEditDelete;
    RichEditBold1: TRichEditBold;
    RichEditItalic1: TRichEditItalic;
    RichEditUnderline1: TRichEditUnderline;
    RichEditStrikeOut1: TRichEditStrikeOut;
    RichEditBullets1: TRichEditBullets;
    RichEditAlignLeft1: TRichEditAlignLeft;
    RichEditAlignRight1: TRichEditAlignRight;
    RichEditAlignCenter1: TRichEditAlignCenter;
    Barrato: TMenuItem;
    Edit3: TMenuItem;
    Find1: TMenuItem;
    PasteSpecial1: TMenuItem;
    Paste1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    N3: TMenuItem;
    Undo1: TMenuItem;
    Formattazione1: TMenuItem;
    SoloTesto1: TMenuItem;
    SoloRTFHTML1: TMenuItem;
    SiaTestocheRTFHTML1: TMenuItem;
    procedure DisconnettiClick(Sender: TObject);
    procedure SpedisciClick(Sender: TObject);
    procedure AllegaClick(Sender: TObject);
    procedure AboutClick(Sender: TObject);
    procedure accesoClick(Sender: TObject);
    procedure spentoClick(Sender: TObject);
    procedure AutentificatoClick(Sender: TObject);
    procedure StopClick(Sender: TObject);
    procedure BombingClick(Sender: TObject);
    procedure CaricaClick(Sender: TObject);
    procedure EditClick(Sender: TObject);
    procedure CleanClick(Sender: TObject);
    procedure TCPInfoClick(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.DisconnettiClick(Sender: TObject);
begin
if SMTP.Connected then SMTP.Disconnect;
showmessage('Operazione Annulata');
end;

procedure TForm1.SpedisciClick(Sender: TObject);
begin
//setup SMTP
SMTP.Host := Server.Text;
SMTP.Port := 25;
SMTP.MailAgent := Agent.Text;
//setup mail message
  MailMessage.From.Address := Da.Text;
  MailMessage.From.Name := Nome.Text;
  MailMessage.Recipients.EMailAddresses :=
  A.Text + ' ' + Lista.Text;
  MailMessage.CCList.EMailAddresses := CC.Text;
  MailMessage.BccList.EMailAddresses := Ccn.Text;
  MailMessage.Subject := Oggetto.Text;
  MailMessage.Body.Text := Messaggio.Text;
  if FileExists(Allegato.Text) then
  TIdAttachment.Create(MailMessage.MessageParts,
                         Allegato.Text);
//send mail
  try
  try
  SMTP.Connect(10000);
  SMTP.Send(MailMessage);
  except on E:Exception do
  Messaggio.Lines.Insert(0, 'Errore: ' + E.Message);
  end;
  finally
  if SMTP.Connected then
     SMTP.Disconnect;
Status.Caption := 'Email Inviata';
end;
end;

procedure TForm1.AllegaClick(Sender: TObject);
begin
if OpenDialog1.Execute then
if FileExists(OpenDialog1.FileName) then
Allegato.Text := OpenDialog1.FileName;
end;

procedure TForm1.AboutClick(Sender: TObject);
begin
  with TAboutBox.Create(Self) do
  try
    ShowModal;
  finally
    Free;
  end;
  end;

procedure TForm1.accesoClick(Sender: TObject);
begin
try
IdTCPClient1.Host := Host.text;
IdTCPClient1.Port := StrToInt(Port.Text);
IdTCPClient1.Connect;
if idtcpclient1.Connected = true then showmessage('Connesso');
except
On E: Exception do showmessage('Non Connesso');
end;
end;

procedure TForm1.spentoClick(Sender: TObject);
begin
try
idTCPClient1.Disconnect;
if idtcpclient1.Connected = false then showmessage('Disconnesso');
except
On E: Exception do showmessage('Non Disconnesso');
end;
end;

procedure TForm1.AutentificatoClick(Sender: TObject);
begin
Smtp.Username := Username.Text;
Smtp.Password := Password.Text;
Smtp.AuthenticationType := atLogin;
end;

procedure TForm1.StopClick(Sender: TObject);
begin
if SMTP.Connected then SMTP.Disconnect;
try
idTCPClient1.Disconnect;
if idtcpclient1.Connected = false then showmessage('Disconnesso');
except
On E: Exception do showmessage('Non Disconnesso');
end;
end;

procedure TForm1.CaricaClick(Sender: TObject);
var
CLines, I : Integer;
begin
lista.items.loadfromfile('Rubrica.Txt');
begin
  CLines := 0;
  for I := 0 to  Lista.Items.Count - 1 do
   begin
     CLines := CLines + 1;
   end;
   Conta.Caption := 'Ci Sono '+ IntToStr(CLines) + ' Contatti!';
end;
end;

procedure TForm1.EditClick(Sender: TObject);
begin
ShellExecute(0, Nil, PChar('Rubrica.txt'),Nil, Nil, SW_NORMAL);
end;

procedure TForm1.CleanClick(Sender: TObject);
var
CLines, I : Integer;
begin
Lista.Items.Clear;
begin
  CLines := 0;
  for I := 0 to  Lista.Items.Count - 1 do
   begin
     CLines := CLines + 1;
   end;
   Conta.Caption := 'Ci Sono '+ IntToStr(CLines) + ' Contatti!';
end;
end;

procedure TForm1.TCPInfoClick(Sender: TObject);
begin
InfoDominio.Caption:= 'Domionio Locale: ' + (TCP.LocalDomainName);
HostLocale.Caption:= 'Host Locale: ' + (TCP.LocalHostName);
IPLocale.Caption:= 'IP Locale: ' + (IP.LocalIP);
IPCorrente.Caption:= 'IP Corrente: ' + (IP.CurrentIP);
end;
var
flags: dword;
state:Boolean;
begin
state := InternetGetConnectedState(@flags, 0);
if state then
begin
showmessage('Connessione A Internet Attiva');
if (flags and INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM then
showmessage('Connesso Con Modem');
if (flags and INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN then
showmessage('Connesso Con Lan');
if (flags and INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY then
showmessage('Connesso Con Proxy');
if (flags and INTERNET_CONNECTION_MODEM_BUSY) =INTERNET_CONNECTION_MODEM_BUSY then
showmessage('Modem Impegnato');
end;

end.

[camaleonteplus]

mi serve il vostro aiuto da solo non ci riuscirò mai!