|
Ok aqui esta el codigo mejorado para enviar mas archivos adjuntos...
function TFrmPrintPreview.SendMailMapi(const subject, Body,
SenderName, SenderEmail, RecepientName,
RecepientEmail: String ; FileName:TStringList): Integer;
const
MaxFileListSize = Maxint div sizeof(TMapiFileDesc);
type
TMapiFileDescList = array[0..MaxFileListSize - 1] of TMapiFileDesc;
PMapiFileDescList = ^TMapiFileDescList;
var
mensaje: TMapiMessage;
lpsender, lpRecepient: TMapiRecipDesc;
FileAttach: TMapiFileDesc;
Archivo: PMapiFileDescList;
SM: TFNMapiSendMail;
MapiModule: HModule;
i:Word;
lista_Atach:TList;
function allocLpsz(lst:TList; Str:String):Pointer;
var
p:Pointer;
begin
p:= nil;
GetMem(p, Length(str)+1);
StrPCopy(p, str);
lst.add(p);
result:=p;
end;
begin
FillChar(mensaje, SizeOf(mensaje),0);
with mensaje do
begin
if Subject <> '' then
lpszSubject:= PChar(Subject);
if Body<> '' then
lpszNoteText:= PChar(Body);
if SenderEmail <> '' then
begin
lpSender.ulRecipClass:= MAPI_ORIG;
if SenderName = '' then
lpSender.lpszName:= PChar(SenderEmail)
else
lpSender.lpszName:= PChar(SenderName);
lpSender.lpszAddress:= PChar('SMTP:'+ SenderEmail);
lpSender.ulReserved:= 0;
lpSender.ulEIDSize:= 0;
lpSender.lpEntryID:= nil;
lpOriginator:= @lpSender;
end;
if RecepientEmail<> '' then
begin
lpRecepient.ulRecipClass:= MAPI_TO;
if RecepientName = '' then
lpRecepient.lpszName:= PChar(RecepientEmail)
else
lpRecepient.lpszName:= PChar(RecepientName);
lpRecepient.lpszAddress:= PChar('SMTP:' + RecepientEmail);
lpRecepient.ulReserved:= 0;
lpRecepient.ulEIDSize:= 0;
lpRecepient.lpEntryID:= nil;
nRecipCount:= 1;
lpRecips:= @lpRecepient;
end
else
lpRecips:= nil;
if FileName = nil then
begin
nFileCount:= 0;
lpFiles:= nil;
end
else
begin
lista_atach:= TList.Create;
GetMem(archivo, sizeof(TMapiFileDesc) * lista.count);
for i:= 0 to lista.count - 1 do
begin
with archivo[i] do
begin
ulReserved:= 0;
flFlags:= 0;
nPosition:= Cardinal (-1);
lpszPathName:= AllocLpsz(lista_atach,lista[i]);
lpszFileName:= AllocLpsz(lista_atach, extractfilename(lista[i]));
lpFileType:= nil;
end;
{
FillChar(FileAttach, SizeOf(FileAttach),0);
FileAttach.nPosition:= Cardinal($FFFFFFFF);
FileAttach.lpszPathName:= PChar(lista[i]);
FileAttach.lpszFileName:= PChar(ExtractFileName(lista[i]));}
end;
nFileCount:= lista.count;
lpFiles:= @archivo[0];
//lpFiles:= @FileAttach;
end;
end;
MAPIModule:= LoadLibrary(PChar(MAPIDLL));
if MAPIModule = 0 then
Result:= -1
else
begin
try
@SM:= GetProcAddress(MAPIModule, 'MAPISendMail');
if @SM <> nil then
Result:= SM(0, Application.Handle, mensaje, MAPI_DIALOG or MAPI_LOGON_UI, 0)
else
Result:= 1;
finally
FreeLibrary(MapiModule);
end;
end;
if Result <> 0 then
MessageDlg('Error de envio (' + IntToStr(Result) + ').', mtError, [mbOk], 0);
end;
Nota: "lista" es un TStringList que contiene los archivos que se van a adjuntar al
correo.
|