如何用delphi的发html格式的邮件？

Question

我做了个邮件发送软件，用的是idsmtp控件，
但是现在只能发送文字，如何发送html格式的文件，
大家贴点代码上来

Answer 1

还敢用idsmtp啊，赶紧换吧，好多邮件服务商都封杀了，用idsmtp发垃圾的太多了

Answer 2

unit unitMain;interfaceuses
  Windows, SysUtils, Classes,StdCtrls, ExtCtrls, ComCtrls, Dialogs,
  IdMessage, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdMessageClient, IdSMTPBase, IdSMTP, IdText,
  IDAttachmentFile;function SendEMail(SenderName, SenderAddress: PChar;
    Receivename, ReceiveAddress: PChar; MailSubject, MailContent: PChar;
    JpgFileName: PChar; SendType: Integer; PicID: PChar; IsCustom: Boolean): Boolean; stdcall;
function ConnectMailServer(Host, UserName, Password: PChar;
    Port: Integer): Boolean; stdcall;
procedure DisconnectMail; stdcall;type
  TSendMailObj = class
  private
    FHost: String;
    FPort: Integer;
    FUserName: String;
    FPassword: String;
    ASmtp: TIdSMTP;
  public
    property Host: string read FHost write FHost;
    property Port: Integer read FPort write FPort;
    property UserName: String read FUserName write FUserName;
    property Password: String read FPassword write FPassword;
    constructor Create;
    function ConnectServer: Boolean;
    function SendEMail(SenderName, SenderAddress: PChar;
       Receivename, ReceiveAddress: PChar; MailSubject, MailContent: PChar;
       JpgFileName: PChar; SendType: Integer; PicID: PChar;
       IsCustom: Boolean): Boolean;
  end;var
  SendObj: TSendMailObj;implementationfunction SendEMail(SenderName, SenderAddress: PChar;
    Receivename, ReceiveAddress: PChar; MailSubject, MailContent: PChar;
    JpgFileName: PChar; SendType: Integer; PicID: PChar; IsCustom: Boolean): Boolean; stdcall;
begin
  Result :=  SendObj.SendEMail(SenderName, SenderAddress, Receivename,
           ReceiveAddress, MailSubject, MailContent,
            JpgFileName, SendType, PicID, IsCustom);
end;function ConnectMailServer(Host, UserName, Password: PChar;
    Port: Integer): Boolean; stdcall;
begin
  try
    //if SendObj = nil then
    SendObj := TSendMailObj.Create;
{    if SendObj.ASmtp.Connected then
      SendObj.ASmtp.Disconnect;  }
    SendObj.Host := StrPas(Host);
    SendObj.Port := Port;
    SendObj.Username := StrPas(UserName);
    SendObj.Password := StrPas(Password);
    Result := SendObj.ConnectServer;
  except
    Result := False;
  end;
end;procedure DisconnectMail; stdcall;
begin
  if SendObj <> nil then
  begin
    if SendObj.ASmtp <> nil then
      SendObj.ASmtp.Disconnect;
    SendObj := nil;
    SendObj.Free;
  end;
end;
{ TSendMailObj }function TSendMailObj.ConnectServer: Boolean;
begin
  ASmtp.Host := FHost;
  ASmtp.Port := FPort;
  ASmtp.Username := FUserName;
  ASmtp.Password := FPassword;
  try
    ASmtp.Connect;
    Result := ASmtp.Connected;
  except
    Result := False;
  end;
end;constructor TSendMailObj.Create;
begin
  ASmtp := TIdSMTP.Create(nil);end;function TSendMailObj.SendEMail(SenderName, SenderAddress, Receivename,
  ReceiveAddress, MailSubject, MailContent, JpgFileName: PChar;
  SendType: Integer; PicID: PChar; IsCustom: Boolean): Boolean;
var
  IdBody, IdHtml: TIdText;
  Att: TIdAttachmentFile;
  AMessage: TIdMessage;
  ASmtp_1: TIdSMTP;
begin
  ASmtp_1 := TIdSMTP.Create(nil);
  ASmtp_1.Host := FHost;
  ASmtp_1.Port := FPort;
  ASmtp_1.Username := FUserName;
  ASmtp_1.Password := FPassword;
  ASmtp_1.AuthType := atDefault;
  ASmtp_1.Connect; // }
  if not ASmtp.Connected then
    ASmtp.Connect;
  AMessage := TIdMessage.Create(nil);
  with AMessage do
  begin
    NoDecode := False;
    NoEncode := False;
    ContentType := 'multipart/mixed';
    Encoding := meMIME;
    MsgId := 'PrettyPic';
    if FileExists(StrPas(JpgFileName)) then
      References := ChangeFileExt(ExtractFileName(StrPas(JpgFileName)), '')
    else
      References := '';
    Recipients.Clear;
    with Recipients.Add do
    begin
      Name := StrPas(Receivename);
      Address := StrPas(ReceiveAddress);
    end;
    Subject := StrPas(MailSubject);
    Sender.Name := StrPas(SenderName);
    Sender.Address := StrPas(SenderAddress);
    From.Name := Sender.Name;
    From.Address := Sender.Address;
    if SendType = 0 then
    begin
      IdBody := TIdText.Create(MessageParts);
      IdBody.ContentType := 'text/plain';
      IdBody.Body.Add(StrPas(MailContent));
      IdBody.Body.Add('');
    end
    else
    begin
      IdHtml := TIdText.Create(MessageParts);
      IdHtml.ContentType := 'text/html;charset=gb2312';
      IdHtml.ContentTransfer := '7bit';
      IdHtml.Body.Add('<html>');
      IdHtml.Body.Add('   <head>');
      IdHtml.Body.Add('       <title>' + StrPas(MailSubject) + '</title>');
      IdHtml.Body.Add('   </head>');
      IdHtml.Body.Add('   <body title="' + References + '">');
      IdHtml.Body.Add('    ' + StrPas(MailContent) + '<br>');
      if (not IsCustom) and FileExists(StrPas(JpgFileName)) then
        IdHtml.Body.Add('      <img src="cid:' + StrPas(PicID) + '" alt="' + ExtractFileName(StrPas(JpgFileName)) +
                            '" name="' + ExtractFileName(StrPas(JpgFileName)) + '" title="">');
      IdHtml.Body.Add('   </body>');
      IdHtml.Body.Add('</html>');
    end;
    if FileExists(StrPas(JpgFileName)) then
    begin
      Att := TIdAttachmentFile.Create(MessageParts, StrPas(JpgFileName));
      Att.ExtraHeaders.Values['Content-ID'] := StrPas(PicID);
      Att.ContentType := 'image/jpeg';
    end;
  end;
  try
    ASmtp_1.Send(AMessage);
    if Att <> nil then
      Att.Free;
    if IdBody <> nil then
      IdBody.Free;
    if IdHtml <> nil then
      IdHtml.Free;
    if AMessage <> nil then
      AMessage.Free;
    ASmtp_1.Disconnect;    ASmtp_1.Free; //}
    ASmtp.Disconnect;
    Result := True;
  except on e: Exception do
  begin
    Result := False;
  end;
  end;end;end.

Answer 3

这是用Delphi2007写的发送邮件的DLL主文件，测试后可用！！！
此功能可以发现常规的信件和Html邮件，仅供参考。