2012-05-07 71 views
2

我有一個傳統的德爾福2007年應用程序通過TurboPower Internet Professional 1.15(tpipro)發送電子郵件報警。最近我重新訪問了應用程序,發現由於大多數電子郵件服務器的TLS/SSL要求,發送的電子郵件不再有效。現在我的問題是從哪裏去。發送電子郵件從德爾福2007年應用程序

我有德爾福XE2,但真的沒有想花時間更新我的應用程序工作在這個IDE。它有很多庫依賴關係等等。

是否有第三方電子郵件客戶端是最新的,將在Delphi 2007上工作?或者,也許可以使用一個.dll?

回答

5

您可以使用包含在Delphi中Indy庫,這些組件都支持TLS和SSL(看看到TIdSmtp組件),你可以找到印Here的最後一個版本。

+0

嗯,很有趣,我居然貼使用了Indy的答案,我在生產中使用用Delphi 2007發送郵件使用TLS的電子郵件,並且與Indy的通用鏈接是被接受的答案。 – Misha

4

只給你一些更多的選擇

您也可以嘗試IPWorks它不是免費的你,你可以找到它Here或者你可能在ICS(Internet組件套件)這是免費想要的樣子,你可以發現, Here

印是顯而易見的選擇,因爲它是與德爾福XE2安裝

3

只是做這個昨天(你可以代替我自己的類與VCL類得到它的工作):

unit SmtpClientUnt; 

interface 

uses 
    Classes, IdSslOpenSsl, IdSmtp, CsiBaseObjectsUnt, DevExceptionsUnt; 

type 
    ESmtpClient = class(EDevException); 

    TSmtpClient = class sealed(TCsiBaseObject) 
    private 
    FHostName: string; 
    FIdSmtpClient: TIdSmtp; 
    FIoHandler: TIdSslIoHandlerSocketOpenSsl; 
    FUseTls: Boolean; 
    protected 
    procedure CheckIsOpen(const pEventAction: string); 
    function GetHostName: string; virtual; 
    function GetIsOpen: Boolean; virtual; 
    function GetObjectName: string; override; 
    public 
    const LC_SMTP_CLIENT = 'SMTP Client'; 

    constructor Create(const pHostName: string; pUseTls: Boolean = False); 
    destructor Destroy; override; 
    procedure Close; 
    procedure Open(const pUserName: string = ''; const pPassword: string = ''); 
    procedure Reconnect; 
    procedure SendMessage(pToAddresses: TStrings; const pFromAddress: string; 
          const pSubject: string; const pBody: string; 
          pAttachmentFiles: TStrings = nil); 
    property HostName: string read GetHostName; 
    property IsOpen: Boolean read GetIsOpen; 
    end; 

implementation 

uses 
    SysUtils, IdAttachmentFile, IdEmailAddress, IdExplicitTlsClientServerBase, IdMessage, 
    CsiExceptionsUnt, CsiGlobalsUnt, CsiSingletonManagerUnt, CsiStringsUnt; 

{ TSmtpClient } 

procedure TSmtpClient.CheckIsOpen(const pEventAction: string); 
begin 
    if not IsOpen then 
    raise ESmtpClient.Create('Cannot ' + pEventAction + 
          ' while the SMTP client is not open', slError, 1, 
          ObjectName); 
end; 

procedure TSmtpClient.Close; 
begin 
    if IsOpen then begin 
    CsiGlobals.AddLogMsg('Closing SMTP client', LC_SMTP_CLIENT, llVerbose, ObjectName); 
    FIdSmtpClient.Disconnect; 
    end; 
end; 

constructor TSmtpClient.Create(const pHostName: string; pUseTls: Boolean); 
begin 
    FHostName := pHostName; 
    FUseTls := pUseTls; 
    inherited Create; 
    if FHostName = '' then 
    raise ESmtpClient.Create('Cannot create SMTP client - empty host name', slError, 2, 
          ObjectName); 

    FIdSmtpClient := TIdSmtp.Create(nil); 
    FIdSmtpClient.Host := pHostName; 

    if FUseTls then begin 
    FIoHandler := TIdSslIoHandlerSocketOpenSsl.Create(nil); 
    FIdSmtpClient.IoHandler := FIoHandler; 
    FIdSmtpClient.UseTls := utUseRequireTls; 
    end; 
end; 

destructor TSmtpClient.Destroy; 
begin 
    Close; 

    if FUseTls and Assigned(FIdSmtpClient) then begin 
    FIdSmtpClient.IoHandler := nil; 
    FreeAndNil(FIoHandler); 
    end; 

    FreeAndNil(FIdSmtpClient); 
    inherited; 
end; 

function TSmtpClient.GetHostName: string; 
begin 
    if Assigned(FIdSmtpClient) then 
    Result := FIdSmtpClient.Host 
    else 
    Result := FHostName; 
end; 

function TSmtpClient.GetIsOpen: Boolean; 
begin 
    Result := Assigned(FIdSmtpClient) and FIdSmtpClient.Connected; 
end; 

function TSmtpClient.GetObjectName: string; 
var 
    lHostName: string; 
begin 
    Result := inherited GetObjectName; 
    lHostName := HostName; 
    if lHostName <> '' then 
    Result := Result + ' ' + lHostName; 
end; 

procedure TSmtpClient.Open(const pUserName: string; const pPassword: string); 
begin 
    if not IsOpen then begin 
    with FIdSmtpClient do begin 
     Username := pUserName; 
     Password := pPassword; 
     Connect; 
    end; 

    CsiGlobals.AddLogMsg('SMTP client opened', LC_SMTP_CLIENT, llVerbose, ObjectName); 
    end; 
end; 

procedure TSmtpClient.Reconnect; 
begin 
    Close; 
    Open; 
end; 

procedure TSmtpClient.SendMessage(pToAddresses: TStrings; const pFromAddress: string; 
            const pSubject: string; const pBody: string; 
            pAttachmentFiles: TStrings); 
var 
    lMessage: TIdMessage; 
    lAddress: string; 
    lName: string; 
    lIndex: Integer; 
    lAddressItem: TIdEMailAddressItem; 
    lAttachmentFile: TIdAttachmentFile; 
    lFileName: string; 
begin 
    CheckIsOpen('send message'); 

    lMessage := TIdMessage.Create(nil); 
    try 
    with lMessage do begin 
     CsiSplitFirstStr(pFromAddress, ',', lAddress, lName); 
     From.Address := lAddress; 
     From.Name := lName; 
     Subject := pSubject; 
     Body.Text := pBody; 
    end; 

    for lIndex := 0 to pToAddresses.Count - 1 do begin 
     lAddressItem := lMessage.Recipients.Add; 
     CsiSplitFirstStr(pToAddresses.Strings[lIndex], ',', lAddress, lName); 
     lAddressItem.Address := lAddress; 
     lAddressItem.Name := lName; 
    end; 

    if Assigned(pAttachmentFiles) then 
     for lIndex := 0 to pAttachmentFiles.Count - 1 do begin 
     lAttachmentFile := TIdAttachmentFile.Create(lMessage.MessageParts); 
     lFileName := pAttachmentFiles.Strings[lIndex]; 
     lAttachmentFile.StoredPathName := lFileName; 
     lAttachmentFile.FileName := lFileName; 
     end; 

    FIdSmtpClient.Send(lMessage); 
    finally 
    lMessage.Free; 
    end; 
end; 

procedure InitialiseUnit; 
begin 
    CsiAllCapWords.AddString('SMTP'); 
end; 

initialization 

CsiSingletonManager.RegisterHook(InitialiseUnit, nil); 

end. 
相關問題