david
bd7a099c7d
git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES/trunk@4 b68bf8ae-e977-074f-a058-3cfd71dd8f45
122 lines
3.1 KiB
ObjectPascal
122 lines
3.1 KiB
ObjectPascal
{
|
|
===============================================================================
|
|
Copyright (©) 2001. Rodax Software.
|
|
===============================================================================
|
|
Los contenidos de este fichero son propiedad de Rodax Software titular del
|
|
copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
|
|
en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
|
|
acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
|
|
bajo el que se suministra.
|
|
-----------------------------------------------------------------------------
|
|
Web: www.rodax-software.com
|
|
===============================================================================
|
|
Fecha primera versión: 02-02-2005
|
|
Versión actual: 1.0.0
|
|
Fecha versió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.
|