unit ZipAndEmail;

interface

uses
  Classes, Windows, SysUtils, Forms;

procedure MakeZip(const srcFolder, destFile: String);
procedure SendMapiEmail(Handle: THandle; aTo, aSubject, aBody, aAttachment: String);

implementation

uses
  AbZipper, Mapi;

procedure MakeZip(const srcFolder, destFile: String);
var
  AbZipper: TAbZipper;
begin
  AbZipper := TAbZipper.Create(nil);
  try
    { if you want/need to display zip progress
      AbZipper.ArchiveProgressMeter := frmProgress.AbVCLMeterLink1;
    Application.ProcessMessages; }
    AbZipper.Filename := destFile;
    AbZipper.AddFiles(srcFolder + '\*.*', 0 );
    AbZipper.Save;
  finally
    AbZipper.Free;
  end
end;


// based on code from Xavier Pacheco
procedure SendMapiEmail(Handle: THandle; aTo, aSubject, aBody, aAttachment: String);
type
  TAttachAccessArray = array [0..0] of TMapiFileDesc;
  PAttachAccessArray = ^TAttachAccessArray;
var
  mail: TStringList;
  MapiMessage: TMapiMessage; 
  Receip: TMapiRecipDesc; 
  Attachments: PAttachAccessArray; 
  AttachCount: Integer; 
  i1: integer; 
  FileName: string; 
  dwRet: Cardinal; 
  MAPI_Session: Cardinal; 
  WndList: Pointer; 
begin
  mail := TStringList.Create;
  try
    mail.values['to'] := aTo;
    mail.values['subject'] := aSubject;
    mail.values['body'] := aBody;
    mail.values['attachment0'] := aAttachment;

    dwRet := MapiLogon(Handle,
      PChar(''),
      PChar(''),
      MAPI_LOGON_UI or MAPI_NEW_SESSION,
      0, @MAPI_Session);

    if (dwRet <> SUCCESS_SUCCESS) then
    begin
      MessageBox(Handle,
        PChar('Error while trying to send email'),
        PChar('Error'),
        MB_ICONERROR or MB_OK);
    end
    else begin
      FillChar(MapiMessage, SizeOf(MapiMessage), #0);
      Attachments := nil;
      FillChar(Receip, SizeOf(Receip), #0);

      if Mail.Values['to'] <> '' then
      begin
        Receip.ulReserved := 0;
        Receip.ulRecipClass := MAPI_TO;
        Receip.lpszName := StrNew(PChar(Mail.Values['to']));
        Receip.lpszAddress := StrNew(PChar('SMTP:' + Mail.Values['to']));
        Receip.ulEIDSize := 0;
        MapiMessage.nRecipCount := 1;
        MapiMessage.lpRecips := @Receip;
      end;

      AttachCount := 0;

      for i1 := 0 to MaxInt do
      begin
        if Mail.Values['attachment' + IntToStr(i1)] = '' then
          break;
        Inc(AttachCount);
      end;

      if AttachCount > 0 then
      begin
        GetMem(Attachments, SizeOf(TMapiFileDesc) * AttachCount);

        for i1 := 0 to AttachCount - 1 do
        begin
          FileName := Mail.Values['attachment' + IntToStr(i1)];
          Attachments[i1].ulReserved := 0;
          Attachments[i1].flFlags := 0;
          Attachments[i1].nPosition := ULONG($FFFFFFFF);
          Attachments[i1].lpszPathName := StrNew(PChar(FileName));
          Attachments[i1].lpszFileName :=
            StrNew(PChar(ExtractFileName(FileName)));
          Attachments[i1].lpFileType := nil;
        end;
        MapiMessage.nFileCount := AttachCount;
        MapiMessage.lpFiles := @Attachments^;
      end;

     if Mail.Values['subject'] <> '' then
        MapiMessage.lpszSubject := StrNew(PChar(Mail.Values['subject']));
      if Mail.Values['body'] <> '' then
        MapiMessage.lpszNoteText := StrNew(PChar(Mail.Values['body']));

      WndList := DisableTaskWindows(0);
      try
        MapiSendMail(MAPI_Session, Handle, MapiMessage, MAPI_DIALOG, 0);
      finally
        EnableTaskWindows( WndList );
      end;

      for i1 := 0 to AttachCount - 1 do
      begin
        StrDispose(Attachments[i1].lpszPathName);
        StrDispose(Attachments[i1].lpszFileName);
      end;

      if Assigned(MapiMessage.lpszSubject) then
        StrDispose(MapiMessage.lpszSubject);
      if Assigned(MapiMessage.lpszNoteText) then
        StrDispose(MapiMessage.lpszNoteText);
      if Assigned(Receip.lpszAddress) then
        StrDispose(Receip.lpszAddress);
      if Assigned(Receip.lpszName) then
        StrDispose(Receip.lpszName);
      MapiLogOff(MAPI_Session, Handle, 0, 0);
    end;

  finally
    mail.Free;
  end;
end;


end.