unitsendmail.pas

delphi 带图片 html功能的Mail

unit UnitSendMail;

interface

uses
  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;Attachment:PChar): 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;Attachment:PChar): Boolean;
  end; 

var 
  SendObj: TSendMailObj; 

implementation 

function SendEMail(SenderName, SenderAddress: PChar;
    Receivename, ReceiveAddress: PChar; MailSubject, MailContent: PChar;
    JpgFileName: PChar; SendType: Integer; PicID: PChar; IsCustom: Boolean;Attachment:PChar): Boolean; stdcall;
begin
  Result :=  SendObj.SendEMail(SenderName, SenderAddress, Receivename,
          ReceiveAddress, MailSubject, MailContent,
            JpgFileName, SendType, PicID, IsCustom,Attachment);
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;Attachment:PChar): 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/jpg';
    end;   
    if FileExists(StrPas(Attachment)) then
    begin
      Att := TIdAttachmentFile.Create(MessageParts, StrPas(Attachment));
    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.