Send HTML Formatted Mail

hi!
i've got a customer database with about 3000 persons in it who want to receive my newsletter.
i would like to send personalized mails with the name and company name in it and the
mail should be html formatted. it would be best if there is a possibility to use an email editor
like ms outlook. i'm using delphi 6 enterprise. i can send simple mails with smtp but how can
i send and edit html formatted complicated mails with attachments and images in it ? is it
possible to send mails using outlook ? i've seen those components on the servers tab but
actually i don't know how to use them. something like

open outlook mail editor
type in my mail

from database:_
send mail to adress 1
send mail to adress 2
[...]

would be cool ;)

thanks
fuluppi
fuluppiAsked:
Who is Participating?
 
Melih SARICAConnect With a Mentor OwnerCommented:
Hi...

Here is a code that i use for sending multiple messages With Authentication, It works fine with all kinda a Automation Objects..

Im Using this Code for Sending messages to Customers on a big E-sales Project / and CRM .. U can send thousand of mail in a very short time ..




//****************** Unit *************
//   Porpose   : Sending Mail Via Telnet Connection on port 25
//   Auther     : Non_Zero (Melih SARICA)
//  
unit Connections;

interface
uses
  classes,StdCtrls;
Const
 WinSock='wsock32.dll';
 Internet=2;
 Stream=1;
 fIoNbRead = $4004667F;
 WinSMTP        = $0001;
 LinuxSMTP      = $0002;

Type

  TWSAData = packed record
    wVersion: Word;
    wHighVersion: Word;
    szDescription: array[0..256] of Char;
    szSystemStatus: array[0..128] of Char;
    iMaxSockets: Word;
    iMaxUdpDg: Word;
    lpVendorInfo: PChar;
  end;
  PHost = ^THost;
  THost = packed record
    name     : PChar;
    aliases  : ^PChar;
    addrtype : Smallint;
    length   : Smallint;
    addr     : ^pointer;
  end;

  TSockAddr=packed record
   Family:word;
   Port:word;
   Addr:LongInt;
   Zeros:array[0..7] of byte;
  end;


Function WSAStartup(Version:word; Var Data:TwsaData):integer; stdcall; far; external winsock;
Function socket(Family,Kind,Protocol:integer):integer; stdcall; far; external winsock;
Function shutdown(Socket,How:Integer):integer; stdcall; far; external winsock;
Function closesocket(socket:Integer):integer; stdcall; far; external winsock;
Function WSACleanup:integer; stdcall; far; external winsock;
Function bind(Socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
Function listen(socket,flags:Integer):integer; stdcall; far; external winsock;
Function connect(socket:Integer; Var SockAddr:TSockAddr; AddrLen:integer):integer; stdcall; far; external winsock;
Function accept(socket:Integer; Var SockAddr:TSockAddr; Var AddrLen:Integer):integer; stdcall; far; external winsock;
Function WSAGetLastError:integer; stdcall; far; external winsock;
Function recv(socket:integer; data:pchar; datalen,flags:integer):integer; stdcall; far; external winsock;
Function send(socket:integer; var data; datalen,flags:integer):integer; stdcall; far; external winsock;
Function gethostbyname(HostName:PChar):PHost; stdcall; far; external winsock;
Function WSAIsBlocking:boolean; stdcall; far; external winsock;
Function WSACancelBlockingCall:integer; stdcall; far; external winsock;
Function ioctlsocket(socket:integer; cmd: Longint; var arg: longint): Integer; stdcall; far; external winsock;
Function gethostname(name:pchar; size:integer):integer; stdcall; far; external winsock;

Procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
Function ConnectServer(mhost:string;mport:integer):integer;
Function ConnectServerwin(mhost:string;mport:integer):integer;
Function DisConnectServer:integer;
function Stat: string;
function SendCommand(Command: String): string;
function SendData(Command: String): string;
function SendCommandWin(Command: String): string;
function ReadCommand: string;
function encryptB64(s:string):string;


var
  mconnHandle           : integer;
  mFin,mFOut            : Textfile;
  EofSock               : boolean;
  mactive               : boolean;
  mSMTPErrCode          : integer;
  mSMTPErrText          : string;
  mMemo                 : Tmemo;

implementation
uses sysutils,sockets,IdBaseComponent,
  IdCoder, IdCoder3to4, IdCoderMIME,inifiles;
var
  mClient               : TTcpClient;


Procedure _authSendMail(MailServer,uname,upass,mFrom,mFromName,mToName,Subject:string;mto,mbody:TStringList);
var
  tmpstr        : string;
  cnt           : integer;
  mstrlist      : Tstrings;
  RecipientCount: integer;
begin
 if ConnectServerWin(Mailserver,25) = 250 then
    begin
      Sendcommandwin('AUTH LOGIN ');
      SendcommandWin(encryptB64(uname));
      SendcommandWin(encryptB64(upass));
      SendcommandWin('MAIL FROM: '+mfrom);
      with TIniFile.Create('c:\program files\wServer\wServer.ini') do
        begin
         RecipientCount:=ReadInteger('SendMail','RecipientCount',0);
         for cnt:=1 to RecipientCount do
          begin
           tmpstr:=ReadString('Recipients','RCPTO_'+inttostr(cnt),'');
           if length(tmpstr) > 0 then
              SendcommandWin('RCPT TO: '+tmpstr);
           end;
          free;
       end;
        for cnt:=0 to mto.Count -1 do
            SendcommandWin('RCPT TO: '+mto[cnt]);
      Sendcommandwin('DATA');
      SendData('Subject: '+Subject);
      SendData('From: "'+mFromName+'" <'+mfrom+'>');
      SendData('To: '+mToName);
      SendData('Mime-Version: 1.0');
      SendData('Content-Type: multipart/related; boundary="Esales-Order";');
      SendData('      type="text/html"');
      SendData('');
      SendData('--Esales-Order');
      SendData('Content-Type: text/html;');
      SendData('        charset="iso-8859-9"');
      SendData('Content-Transfer-Encoding: QUOTED-PRINTABLE');
      SendData('');
      for cnt := 0 to mbody.Count -1  do
        SendData(mbody[cnt]);
      Senddata('');
      SendData('--Esales-Order--');
      Senddata(' ');
      mSMTPErrText:=SendCommand(crlf+'.'+crlf);
      try
        mSMTPErrCode:=strtoint(copy(mSMTPErrText,1,3));
      except
      end;
      SendData('QUIT');
     DisConnectServer;
    end;

end;


function Stat: string;
var
  s : string;
begin
   s:=ReadCommand;
   result:=s;
end;

function EchoCommand(Command: String): string;
begin
  SendCommand(Command);
  Result:=ReadCommand;
end;

function ReadCommand: string;
var
  tmp :  string;
begin
  repeat
   ReadLn(mfin,tmp);
   if Assigned(mmemo) then
      mmemo.Lines.add(tmp);
   until (length(tmp)<4) or (tmp[4]<>'-');
   result:=tmp
end;
function SendData(Command: String): string;
begin
   Writeln(mfout,Command);
end;

function SendCommand(Command: String): string;
begin
   Writeln(mfout,Command);
   result:=stat;
end;

function SendCommandWin(Command: String): string;
begin
   Writeln(mfout,Command+#13);
   result:=stat;
end;

Function FillBlank(Source:string;number:integer):string;
var
  a: integer;
begin
 result:='';
 for a:=length(trim(source)) to number do
   result:=Result+' ';
End;

Function IpToLong(ip:string):LongInt;
 var
  x,i:byte;
  ipx:array[0..3] of byte;
  v:integer;
 begin
  Result:=0;
  longint(ipx):=0; i:=0;
  for x:=1 to length(ip) do
   if ip[x]='.' then begin
    inc(i);
    if i=4 then exit;
   end else begin
    if not (ip[x] in ['0'..'9']) then exit;
    v:=ipx[i]*10+ord(ip[x])-ord('0');
    if v>255 then exit;
    ipx[i]:=v;
   end;
  result:=longint(ipx);
 end;

Function HostToLong(AHost:string):LongInt;
 Var
  Host:PHost;
 begin
  Result:=IpToLong(AHost);
  if Result=0 then begin
   Host:=GetHostByName(PChar(AHost));
   if Host<>nil then Result:=longint(Host^.Addr^^);
  end;
 end;

Function LongToIp(Long:LongInt):string;
 var
  ipx:array[0..3] of byte;
  i:byte;
 begin
  longint(ipx):=long;
  Result:='';
  for i:=0 to 3 do result:=result+IntToStr(ipx[i])+'.';
  SetLength(Result,Length(Result)-1);
 end;

procedure Disconnect(Socket:integer);
 begin
  ShutDown(Socket,1);
  CloseSocket(Socket);
 end;

function CallServer(Server:string; Port:word):integer;
 var
  SockAddr:TSockAddr;
 begin
  Result:=socket(Internet,Stream,0);
  if Result=-1 then exit;
  FillChar(SockAddr,SizeOf(SockAddr),0);
  SockAddr.Family:=Internet;
  SockAddr.Port:=swap(Port);
  SockAddr.Addr:=HostToLong(Server);
  if Connect(Result,SockAddr,SizeOf(SockAddr))<>0 then begin
   Disconnect(Result);
   Result:=-1;
  end;
 end;

function OutputSock(Var F:TTextRec):integer; far;
 begin
  if F.BufPos<>0 then begin
   Send(F.Handle,F.BufPtr^,F.BufPos,0);
   F.BufPos:=0;
  end;
  Result:=0;
 end;

function InputSock(var F: TTextRec): Integer; far;
 Var
  Size:longint;
 begin
  F.BufEnd:=0;
  F.BufPos:=0;
  Result:=0;
  Repeat
   if (IoctlSocket(F.Handle, fIoNbRead, Size)<0) then begin
    EofSock:=True;
    exit;
   end;
  until (Size>=0);
  F.BufEnd:=Recv(F.Handle,F.BufPtr,F.BufSize,0);
  EofSock:=(F.Bufend=0);
 end;


function CloseSock(var F:TTextRec):integer; far;
 begin
  Disconnect(F.Handle);
  F.Handle:=-1;
  Result:=0;
 end;

function OpenSock(var F: TTextRec): Integer; far;
begin
  if F.Mode = fmInput then begin
    EofSock:=False;
    F.BufPos:=0;
    F.BufEnd:=0;
    F.InOutFunc := @InputSock;
    F.FlushFunc := nil;
  end else begin
    F.Mode := fmOutput;
    F.InOutFunc := @OutputSock;
    F.FlushFunc := @OutputSock;
  end;
  F.CloseFunc := @CloseSock;
  Result:=0;
end;
Procedure AssignCrtSock(Socket:integer; Var Input,Output:TextFile);
 begin
  with TTextRec(Input) do begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  with TTextRec(Output) do begin
    Handle := Socket;
    Mode := fmClosed;
    BufSize := SizeOf(Buffer);
    BufPtr := @Buffer;
    OpenFunc := @OpenSock;
  end;
  Reset(Input);
  Rewrite(Output);
 end;

Function ConnectServer(mhost:string;mport:integer):integer;
var
  tmp : string;
begin
   mClient:=TTcpClient.Create(nil);
   mClient.RemoteHost:=mhost;
   mClient.RemotePort:=inttostr(mport);
   mClient.Connect;
   mconnhandle:=callserver(mhost,mport);
   if (mconnHandle<>-1) then
      begin
       AssignCrtSock(mconnHandle,mFin,MFout);
       tmp:=stat;
       tmp:=SendCommand('HELO Melih SARICA);
       if copy(tmp,1,3) = '250' then
         begin
          result:=strtoint(copy(tmp,1,3)) ;
         end;
      end;
  end;

Function ConnectServerWin(mhost:string;mport:integer):integer;
var
  tmp : string;
begin
   mClient:=TTcpClient.Create(nil);
   mClient.RemoteHost:=mhost;
   mClient.RemotePort:=inttostr(mport);
   mClient.Connect;
   mconnhandle:=callserver(mhost,mport);
   if (mconnHandle<>-1) then
      begin
       AssignCrtSock(mconnHandle,mFin,MFout);
       tmp:=stat;
       tmp:=SendCommandWin('HELO Melih SARICA);
       if copy(tmp,1,3) = '250' then
         begin
          result:=strtoint(copy(tmp,1,3)) ;
         end;
      end;
  end;

Function DisConnectServer:integer;
begin
   closesocket(mconnhandle);
   mClient.Disconnect;
   mclient.Free;
End;

function encryptB64(s:string):string;
var
   hash1 : TIdEncoderMIME ;
   p: string;
begin
  if s <> '' then
       begin
         hash1:=TIdEncoderMIME.Create(nil);
         p:=hash1.Encode(s);
         hash1.Free;
       end;
  Result:=p;
end;

end.
//****************
0
 
shaneholmesCommented:
U can use the delphi Indy component from the Indy tab, to send mail,

TIdMessage.ContentType should be  "text/html; charset=us-ascii"

and you can send the whole HTML code in the body.

Look here for examples:

http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20740992.html

there are also many examples on the Indy site

www.nevrona.com/indy

Shane
 
0
 
fuluppiAuthor Commented:
hi shane !
this seems to work, too. but how can i let my users create the mails ? i need
something like a wysiwyg mail editor. any ideas ?

thanks
fuluppi
0
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

 
FeralCTOCommented:
You can accomplish this (WYSIWYG HTML editing) by encapsulating the same editor used by Outlook - DHTMLEdit. There's plenty of stuff on the web about how to use it, including this site:

http://members.shaw.ca/iedelphi/dhtmledit.htm 

If you want to accomplish this without much learning curve or doing much coding:

www.profgrid.com/dhtmledit.html 
ProfDHTMLEdit. $99 with source. Delphi wrapper for the MS DHTML component. If it's well done, it's easily worth $99.

If for some reason you don't want to go the DHTMLEdit route, HTMLEdit is a native VCL component. It's a WYSISYG HTML editor. Looked cool. $139 US. www.purposesoft.com 

Regards,

Ron
"FeralCTO"
0
 
shaneholmesCommented:
You use a TEdit for the To:

A TEdit for the From:

A TRichEdit for the message body

etc.

When they fill it all out, u assign all the values of the controls to the  indy component's properties at runtime.

Then send the mail

SHane
0
 
shaneholmesCommented:
If you want them to be able to create HTML mail, then you need a Control which will allow this.

A third party RichEdit, or HTML control

Shane
0
 
shaneholmesCommented:
Right, for the body text, i.e. HTML portion,  you will need a control such as dhtmledit as described by FeralCTO above.

Shane
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.