SendMailMAPI如何调整以支持多个文件附件

Question

我有这个代码只发送一个附件的时间，如何调整此代码以发送1-2个附件？

function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail, 
        RecepientName, RecepientEMail: String) : Integer; 
var 
    message: TMapiMessage; 
    lpSender, 
    lpRecepient: TMapiRecipDesc; 
    FileAttach: TMapiFileDesc; 
    SM: TFNMapiSendMail; 
    MAPIModule: HModule; 
begin 
    FillChar(message, SizeOf(message), 0); 
    with message do 
    begin 
    if (Subject<>'') then 
    begin 
     lpszSubject := PChar(Subject) 
    end; 
    if (Body<>'') then 
    begin 
     lpszNoteText := PChar(Body) 
    end; 
    if (SenderEMail<>'') then 
    begin 
     lpSender.ulRecipClass := MAPI_ORIG; 
     if (SenderName='') then 
     begin 
     lpSender.lpszName := PChar(SenderEMail) 
     end 
     else 
     begin 
     lpSender.lpszName := PChar(SenderName) 
     end; 
     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 
     begin 
     lpRecepient.lpszName := PChar(RecepientEMail) 
     end 
     else 
     begin 
     lpRecepient.lpszName := PChar(RecepientName) 
     end; 
     lpRecepient.lpszAddress := PChar('SMTP:'+RecepientEMail); 
     lpRecepient.ulReserved := 0; 
     lpRecepient.ulEIDSize := 0; 
     lpRecepient.lpEntryID := nil; 
     nRecipCount := 1; 
     lpRecips := @lpRecepient; 
    end 
    else 
    begin 
     lpRecips := nil 
    end; 
    if (FileName='') then 
    begin 
     nFileCount := 0; 
     lpFiles := nil; 
    end 
    else 
    begin 
     FillChar(FileAttach, SizeOf(FileAttach), 0); 
     FileAttach.nPosition := Cardinal($FFFFFFFF); 
     FileAttach.lpszPathName := PChar(FileName); 
     nFileCount := 1; 
     lpFiles := @FileAttach; 
    end; 
    end; 
    MAPIModule := LoadLibrary(PChar(MAPIDLL)); 
    if MAPIModule=0 then 
    begin 
    Result := -1 
    end 
    else 
    begin 
    try 
     @SM := GetProcAddress(MAPIModule, 'MAPISendMail'); 
     if @SM<>nil then 
     begin 
     Result := SM(0, Application.Handle, message, MAPI_DIALOG or 
        MAPI_LOGON_UI, 0); 
     end 
     else 
     begin 
     Result := 1 
     end; 

    finally 
     FreeLibrary(MAPIModule); 
    end; 
    end; 
    if Result<>0 then 
    begin 
    MessageDlg('Error sending mail ('+IntToStr(Result)+').', mtError, [mbOk], 
       0) 
    end; 
end; 

Answer 1

你可以安排你的代码通过文件名作为一个开放数组参数，同样构建一个“MapiFileDesc” S阵列传递到MAPISendMail则。

//function SendMailMAPI(const Subject, Body, FileName, SenderName, SenderEMail, 
//     RecepientName, RecepientEMail: String) : Integer; 
function SendMailMAPI(const Subject, Body, SenderName, SenderEMail, 
    RecepientName, RecepientEMail: String; FileNames: array of string) : Integer; 
var 
    ... 
// FileAttach: TMapiFileDesc; 
    FileAttachments: array of TMapiFileDesc; 
    FileAttach: PMapiFileDesc; 
    i: Integer; 
    ... 
begin 
    ... 
    ... 
    begin 
     lpRecips := nil 
    end; 
// if (FileName='') then 
// begin 
// ... 
// ... 
//  lpFiles := @FileAttach; 
// end; 
    nFileCount := High(FileNames) + 1; 
    SetLength(FileAttachments, nFileCount); 
    if nFileCount > 0 then 
     lpFiles := @FileAttachments[0]; 
    for i := 0 to High(FileNames) do 
    begin 
     FileAttach := @FileAttachments[i]; 
     FillChar(FileAttach^, SizeOf(FileAttach^), 0); 
     FileAttach.nPosition := $FFFFFFFF; 
     FileAttach.lpszPathName := PChar(FileNames[i]); 
    end; 
    end; 
    ... 
    ... 

Answer 2

布赖恩·弗罗斯特解释here