122 lines
3.1 KiB
ObjectPascal
122 lines
3.1 KiB
ObjectPascal
|
{
|
|||
|
|
===============================================================================
|
|||
|
|
Copyright (<EFBFBD>) 2001. Rodax Software.
|
|||
|
|
===============================================================================
|
|||
|
|
Los contenidos de este fichero son propiedad de Rodax Software titular del
|
|||
|
|
copyright. Este fichero s<EFBFBD>lo podr<EFBFBD> ser copiado, distribuido y utilizado,
|
|||
|
|
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
|
|||
|
|
acuerdo con los t<EFBFBD>rminos y condiciones establecidas en el acuerdo/contrato
|
|||
|
|
bajo el que se suministra.
|
|||
|
|
-----------------------------------------------------------------------------
|
|||
|
|
Web: www.rodax-software.com
|
|||
|
|
===============================================================================
|
|||
|
|
Fecha primera versi<EFBFBD>n: 02-02-2005
|
|||
|
|
Versi<EFBFBD>n actual: 1.0.0
|
|||
|
|
Fecha versi<EFBFBD>n actual: 02-02-2005
|
|||
|
|
===============================================================================
|
|||
|
|
Modificaciones:
|
|||
|
|
|
|||
|
|
Fecha Comentarios
|
|||
|
|
---------------------------------------------------------------------------
|
|||
|
|
===============================================================================
|
|||
|
|
}
|
|||
|
|
|
|||
|
|
unit Correo;
|
|||
|
|
|
|||
|
|
interface
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Classes;
|
|||
|
|
|
|||
|
|
type
|
|||
|
|
TDatosCorreo = class(TPersistent)
|
|||
|
|
public
|
|||
|
|
Direcciones : TStringList;
|
|||
|
|
Asunto: String;
|
|||
|
|
Cuerpo : String;
|
|||
|
|
Adjuntos : TStringList;
|
|||
|
|
constructor Create;
|
|||
|
|
destructor Destroy; override;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
procedure enviarCorreo(Const Datos: TDatosCorreo);
|
|||
|
|
|
|||
|
|
implementation
|
|||
|
|
|
|||
|
|
uses
|
|||
|
|
Sysutils, StrFunc,
|
|||
|
|
ComObj, OutlookXP;
|
|||
|
|
|
|||
|
|
procedure enviarCorreo(Const Datos: TDatosCorreo);
|
|||
|
|
const
|
|||
|
|
olMailItem = 0;
|
|||
|
|
olByValue = 1;
|
|||
|
|
|
|||
|
|
var
|
|||
|
|
OutlookApp, MailItem, MyAttachments: OLEVariant;
|
|||
|
|
i: Integer;
|
|||
|
|
Nombre: String;
|
|||
|
|
|
|||
|
|
begin
|
|||
|
|
//Comprobamos que halla datos para enviar
|
|||
|
|
if Datos = Nil then
|
|||
|
|
exit;
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
OutlookApp := GetActiveOleObject('Outlook.Application');
|
|||
|
|
except
|
|||
|
|
OutlookApp := CreateOleObject('Outlook.Application');
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
try
|
|||
|
|
MailItem := OutlookApp.CreateItem(olMailItem);
|
|||
|
|
|
|||
|
|
for i:=0 to Datos.Direcciones.Count - 1 do
|
|||
|
|
if not EsCadenaVacia(Datos.Direcciones.Strings[i]) then
|
|||
|
|
MailItem.Recipients.Add(Datos.Direcciones.Strings[i]);
|
|||
|
|
|
|||
|
|
MailItem.Subject := Datos.Asunto;
|
|||
|
|
MailItem.Body := Datos.Cuerpo;
|
|||
|
|
|
|||
|
|
myAttachments := MailItem.Attachments;
|
|||
|
|
for i:=0 to Datos.Adjuntos.Count - 1 do
|
|||
|
|
begin
|
|||
|
|
Nombre := copy(Datos.Adjuntos.Strings[i], LastDelimiter('\', Datos.Adjuntos.Strings[i])+1, length(Datos.Adjuntos.Strings[i]));
|
|||
|
|
myAttachments.Add(Datos.Adjuntos.Strings[i], olByValue, 1, Nombre);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
// OutlookApp.WindowState := olNormalWindow;
|
|||
|
|
MailItem.Display;
|
|||
|
|
//MailItem.Send;
|
|||
|
|
finally
|
|||
|
|
myAttachments := VarNull;
|
|||
|
|
OutlookApp := VarNull;
|
|||
|
|
end;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
{ TDatosCorreo }
|
|||
|
|
|
|||
|
|
constructor TDatosCorreo.Create;
|
|||
|
|
begin
|
|||
|
|
inherited Create;
|
|||
|
|
Direcciones := TStringList.Create;
|
|||
|
|
Adjuntos := TStringList.Create;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
destructor TDatosCorreo.Destroy;
|
|||
|
|
var
|
|||
|
|
i: Integer;
|
|||
|
|
begin
|
|||
|
|
//limpiamos los fichero temporales
|
|||
|
|
for i:=0 to Adjuntos.Count - 1 do
|
|||
|
|
begin
|
|||
|
|
DeleteFile(Adjuntos.Strings[i]);
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
FreeAndNil(Direcciones);
|
|||
|
|
FreeAndNil(Adjuntos);
|
|||
|
|
inherited;
|
|||
|
|
end;
|
|||
|
|
|
|||
|
|
end.
|