uses IdHTTP, WinInet, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,
IdSSL, IdSSLOpenSSL, IdExplicitTLSClientServerBase, Datasnap.DBClient,
IdBaseComponent, IdComponent, IdTCPServer, IdSMTPServer, tzprimds, ucommon, utzcds, utzfds,
IdMessage, IdEMailAddress, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, idexception, myaccess, IdAttachmentFile,
IdRawBase, IdRawClient, IdIcmpClient, IdSSLOpenSSLHeaders;
procedure emailgmail(host: string; nombre: string; password: string; port: integer; desde: string; hasta: string; asunto: string; cuerpo: string; adjunto: string);
var
IDSMTP1: TIDSMTP; IdSSLIOHandlerSocketOpenSSL: tIdSSLIOHandlerSocketOpenSSL;
Mensaje: TIdMessage;
begin
screen.cursor := crhourglass;
IdSSLIOHandlerSocketOpenSSL := tIdSSLIOHandlerSocketOpenSSL.Create(nil);
IdSSLIOHandlerSocketOpenSSL.Destination := host + ':' + IntToStr(port); IdSSLIOHandlerSocketOpenSSL.host := host + ':' + IntToStr(port);;
IdSSLIOHandlerSocketOpenSSL.port := port;
IdSSLIOHandlerSocketOpenSSL.ssloptions.method := sslvSSLv3;
IdSSLIOHandlerSocketOpenSSL.ssloptions.mode := sslmUnassigned;
IDSMTP1 := TIDSMTP.Create(nil);
IDSMTP1.UserNAME := nombre;
IDSMTP1.password := password;
IDSMTP1.host := host;
IDSMTP1.port := port;
IDSMTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL;
IDSMTP1.UseTLS := utUseImplicitTLS;
Mensaje := TIdMessage.Create(nil);
with Mensaje do
begin
Body.Add(cuerpo);
From.Text := desde;
Recipients.EMailAddresses := hasta;
Subject := asunto;
Priority := TIdMessagePriority(mpHighest); CCList.EMailAddresses := '';
BccList.EMailAddresses := '';
if adjunto <> '' THEN
TIdAttachmentfile.Create(Mensaje.MessageParts, adjunto);
end;
with IDSMTP1 do
begin
try
Connect;
try
Send(Mensaje);
log(ExtractFilePath(application.ExeName) + 'emailseviados.log', hasta + '|' + asunto + '|' + cuerpo + '|' + adjunto);
finally
Disconnect;
end;
except
on e: EFOpenError do
begin
MessageDlg('No se ha podido enviar el email.' + #13 + 'Fichero Adjunto desconocido o erróneo.', mtError, [mbOK], 0);
end;
else
begin
MessageDlg('Fallo en el envio de email', mtError, [mbOK], 0);
end;
end;
end;
screen.cursor := crdefault;
ENd;