jclmapi.pas

East make Tray Icon in delphi

  if foUnreadOnly in FFindOptions then
    Inc(Flags, MAPI_UNREAD_ONLY);
  Res := MapiFindNext(FSessionHandle, 0, nil, PChar(FSeedMessageID), Flags, 0, MsgId);
  Result := (Res = SUCCESS_SUCCESS);
  if Result then
    SeedMessageID := MsgID
  else
  begin
    SeedMessageID := '';
    if Res <> MAPI_E_NO_MESSAGES then
      MapiCheck(Res, True);
  end;
end;

function TJclEmail.GetAttachments: TStrings;
begin
  Result := FAttachments;
end;

function TJclEmail.GetParentWnd: HWND;
begin
  if FParentWndValid then
    Result := FParentWnd
  else
    Result := GetMainAppWndFromPid(GetCurrentProcessId);
end;

function TJclEmail.GetUserLogged: Boolean;
begin
  Result := (FSessionHandle <> 0);
end;

function TJclEmail.InternalSendOrSave(Save, ShowDialog: Boolean): Boolean;
const
  RecipClasses: array [TJclEmailRecipKind] of DWORD =
    (MAPI_ORIG, MAPI_TO, MAPI_CC, MAPI_BCC);
var
  AttachArray: array of TMapiFileDesc;
  RecipArray: array of TMapiRecipDesc;
  RealAdresses: array of string;
  MapiMessage: TMapiMessage;
  Flags, Res: DWORD;
  I: Integer;
  MsgID: array [0..512] of AnsiChar;
  HtmlBodyFileName: string;
begin
  if not AnyClientInstalled then
    raise EJclMapiError.CreateRes(@RsMapiMailNoClient);

  HtmlBodyFileName := '';
  try
    if FHtmlBody then
    begin
      HtmlBodyFileName := FindUnusedFileName(PathAddSeparator(GetWindowsTempFolder) + 'JclMapi', 'htm', 'Temp');
      Attachments.Insert(0, HtmlBodyFileName);
      StringToFile(HtmlBodyFileName, Body);
    end;
    // Create attachments
    if Attachments.Count > 0 then
    begin
      SetLength(AttachArray, Attachments.Count);
      for I := 0 to Attachments.Count - 1 do
      begin
        if not FileExists(Attachments[I]) then
          MapiCheck(MAPI_E_ATTACHMENT_NOT_FOUND, False);
        Attachments[I] := ExpandFileName(Attachments[I]);
        FillChar(AttachArray[I], SizeOf(TMapiFileDesc), #0);
        AttachArray[I].nPosition := DWORD(-1);
        AttachArray[I].lpszFileName := nil;
        AttachArray[I].lpszPathName := PChar(Attachments[I]);
      end;
    end
    else
      AttachArray := nil;
    // Create recipients
    if Recipients.Count > 0 then
    begin
      SetLength(RecipArray, Recipients.Count);
      SetLength(RealAdresses, Recipients.Count);
      for I := 0 to Recipients.Count - 1 do
      begin
        FillChar(RecipArray[I], SizeOf(TMapiRecipDesc), #0);
        with RecipArray[I], Recipients[I] do
        begin
          ulRecipClass := RecipClasses[Kind];
          if Name = '' then // some clients requires Name item always filled
          begin
            if FAddress = '' then
              MapiCheck(MAPI_E_INVALID_RECIPS, False);
            lpszName := PChar(FAddress);
          end
          else
            lpszName := PChar(FName);
          if FAddressType <> '' then
            RealAdresses[I] := FAddressType + AddressTypeDelimiter + FAddress
          else
          if Recipients.AddressesType <> '' then
            RealAdresses[I] := Recipients.AddressesType + AddressTypeDelimiter + FAddress
          else
            RealAdresses[I] := FAddress;
          lpszAddress := PCharOrNil(RealAdresses[I]);
        end;
      end;
    end
    else
    begin
      if ShowDialog then
        RecipArray := nil
      else
        MapiCheck(MAPI_E_INVALID_RECIPS, False);
    end;
    // Load MAPI client library
    LoadClientLib;
    // Fill MapiMessage structure
    FillChar(MapiMessage, SizeOf(MapiMessage), #0);
    MapiMessage.lpszSubject := PChar(FSubject);
    if FHtmlBody then
      MapiMessage.lpszNoteText := #0
    else
      MapiMessage.lpszNoteText := PChar(FBody);
    MapiMessage.lpRecips := PMapiRecipDesc(RecipArray);
    MapiMessage.nRecipCount := Length(RecipArray);
    MapiMessage.lpFiles := PMapiFileDesc(AttachArray);
    MapiMessage.nFileCount := Length(AttachArray);
    Flags := LogonOptionsToFlags(ShowDialog);
    if Save then
    begin
      StrPLCopy(MsgID, SeedMessageID, SizeOf(MsgID));
      Res := MapiSaveMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0, MsgID);
      if Res = SUCCESS_SUCCESS then
        SeedMessageID := MsgID;
    end
    else
      Res := MapiSendMail(FSessionHandle, ParentWND, MapiMessage, Flags, 0);
    Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS);
  finally
    if HtmlBodyFileName <> '' then
    begin
      DeleteFile(HtmlBodyFileName);
      Attachments.Delete(0);
    end;
  end;
end;

procedure TJclEmail.LogOff;
begin
  if UserLogged then
  begin
    MapiCheck(MapiLogOff(FSessionHandle, ParentWND, 0, 0), True);
    FSessionHandle := 0;
  end;
end;

procedure TJclEmail.LogOn(const ProfileName, Password: string);
begin
  if not UserLogged then
  begin
    LoadClientLib;
    MapiCheck(MapiLogOn(ParentWND, PChar(ProfileName), PChar(Password),
      LogonOptionsToFlags(False), 0, @FSessionHandle), True);
  end; 
end;

function TJclEmail.LogonOptionsToFlags(ShowDialog: Boolean): DWORD;
begin
  Result := 0;
  if FSessionHandle = 0 then
  begin
    if loLogonUI in FLogonOptions then
      Inc(Result, MAPI_LOGON_UI);
    if loNewSession in FLogonOptions then
      Inc(Result, MAPI_NEW_SESSION);
    if loForceDownload in FLogonOptions then
      Inc(Result, MAPI_FORCE_DOWNLOAD);
  end;
  if ShowDialog then
    Inc(Result, MAPI_DIALOG);
end;

function TJclEmail.MessageReport(Strings: TStrings; MaxWidth: Integer; IncludeAddresses: Boolean): Integer;
const
  NameDelimiter = ', ';
var
  LabelsWidth: Integer;
  NamesList: array [TJclEmailRecipKind] of string;
  ReportKind: TJclEmailRecipKind;
  I, Cnt: Integer;
  BreakStr, S: string;
begin
  Cnt := Strings.Count;
  LabelsWidth := Length(RsMapiMailSubject);
  for ReportKind := Low(ReportKind) to High(ReportKind) do
  begin
    NamesList[ReportKind] := '';
    LabelsWidth := Max(LabelsWidth, Length(TJclEmailRecip.RecipKindToString(ReportKind)));
  end;
  BreakStr := AnsiCrLf + StringOfChar(' ', LabelsWidth + 2);
  for I := 0 to Recipients.Count - 1 do
    with Recipients[I] do
    begin
      if IncludeAddresses then
        S := AddressAndName
      else
        S := Name;
      NamesList[Kind] := NamesList[Kind] + S + NameDelimiter;
    end;

  Strings.BeginUpdate;
  try
    for ReportKind := Low(ReportKind) to High(ReportKind) do
      if NamesList[ReportKind] <> '' then
      begin
        S := StrPadRight(TJclEmailRecip.RecipKindToString(ReportKind), LabelsWidth, AnsiSpace) + ': ' +
          Copy(NamesList[ReportKind], 1, Length(NamesList[ReportKind]) - Length(NameDelimiter));
        Strings.Add(WrapText(S, BreakStr, [AnsiTab, AnsiSpace], MaxWidth));
      end;
    S := RsMapiMailSubject + ': ' + Subject;
    Strings.Add(WrapText(S, BreakStr, [AnsiTab, AnsiSpace], MaxWidth));
    Result := Strings.Count - Cnt;
    Strings.Add('');
    Strings.Add(WrapText(Body, AnsiCrLf, [AnsiTab, AnsiSpace, '-'], MaxWidth));
  finally
    Strings.EndUpdate;
  end;
end;

function TJclEmail.Read(const Options: TJclEmailReadOptions): Boolean;
var
  Flags: ULONG;
  Msg: PMapiMessage;
  I: Integer;
  Files: PMapiFileDesc;

  function CopyAndStrToInt(const S: string; Index, Count: Integer): Integer;
  begin
    Result := StrToIntDef(Copy(S, Index, Count), 0);
  end;

  function MessageDateToDate(const S: string): TDateTime;
  var
    T: TSystemTime;
  begin
    FillChar(T, SizeOf(T), #0);
    with T do
    begin
      wYear := CopyAndStrToInt(S, 1, 4);
      wMonth := CopyAndStrToInt(S, 6, 2);
      wDay := CopyAndStrToInt(S, 9, 2);
      wHour := CopyAndStrToInt(S, 12, 2);
      wMinute := CopyAndStrToInt(S, 15,2);
      Result := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    end;
  end;

begin
  Result := False;
  if not UserLogged then
    Exit;
  Clear;
  Flags := 0;
  if roHeaderOnly in Options then
    Inc(Flags, MAPI_ENVELOPE_ONLY);
  if not (roMarkAsRead in Options) then
    Inc(Flags, MAPI_PEEK);
  if not (roAttachments in Options) then
    Inc(Flags, MAPI_SUPPRESS_ATTACH);
  MapiCheck(MapiReadMail(SessionHandle, 0, PChar(FSeedMessageID), Flags, 0, Msg), True);
  if Msg <> nil then
  try
    DecodeRecips(Msg^.lpOriginator, 1);
    DecodeRecips(Msg^.lpRecips, Msg^.nRecipCount);
    FSubject := Msg^.lpszSubject;
    Body := AdjustLineBreaks(Msg^.lpszNoteText);
    Files := Msg^.lpFiles;
    if Files <> nil then
      for I := 0 to Msg^.nFileCount - 1 do
      begin
        if Files^.lpszPathName <> nil then
          Attachments.Add(Files^.lpszPathName)
        else
          Attachments.Add(Files^.lpszFileName);
        Inc(Files);
      end;
    FReadMsg.MessageType := Msg^.lpszMessageType;
    if Msg^.lpszDateReceived <> nil then
      FReadMsg.DateReceived := MessageDateToDate(Msg^.lpszDateReceived);
    FReadMsg.ConversationID := Msg^.lpszConversationID;
    FReadMsg.Flags := Msg^.flFlags;
    Result := True;
  finally
    MapiFreeBuffer(Msg);
  end;
end;

function TJclEmail.ResolveName(var Name, Address: string; ShowDialog: Boolean): Boolean;
var
  Recip: PMapiRecipDesc;
  Res, Flags: DWORD;
begin
  LoadClientLib;
  Flags := LogonOptionsToFlags(ShowDialog) or MAPI_AB_NOMODIFY;
  Recip := nil;
  Res := MapiResolveName(FSessionHandle, ParentWnd, PChar(Name), Flags, 0, Recip);
  Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS) and (Recip <> nil);
  if Result then
  begin
    Address := Recip^.lpszAddress;
    Name := Recip^.lpszName;
    MapiFreeBuffer(Recip);
  end;
end;

procedure TJclEmail.RestoreTaskWindows;
begin
  RestoreTaskWindowsList(FTaskWindowList);
  FTaskWindowList := nil;
end;

function TJclEmail.Save: Boolean;
begin
  Result := InternalSendOrSave(True, False);
end;

procedure TJclEmail.SaveTaskWindows;
begin
  FTaskWindowList := SaveTaskWindowsList;
end;

function TJclEmail.Send(ShowDialog: Boolean): Boolean;
begin
  Result := InternalSendOrSave(False, ShowDialog);
end;

procedure TJclEmail.SetBody(const Value: string);
begin
  if Value = '' then
    FBody := ''
  else
    FBody := StrEnsureSuffix(AnsiCrLf, Value);
end;

procedure TJclEmail.SetParentWnd(const Value: HWND);
begin
  FParentWnd := Value;
  FParentWndValid := True;
end;

procedure TJclEmail.SortAttachments;
begin
  FAttachments.Sort;
end;

//=== Simple email send function =============================================

function SimpleSendHelper(const ARecipient, AName, ASubject, ABody: string; const AAttachment: string;
  AShowDialog: Boolean; AParentWND: HWND; const AProfileName, APassword, AAddressType: string): Boolean;
begin
  with TJclEmail.Create do
  try
    if AParentWND <> 0 then
      ParentWnd := AParentWND;
    if ARecipient <> '' then
      Recipients.Add(ARecipient, AName, rkTO, AAddressType);
    Subject := ASubject;
    Body := ABody;
    if AAttachment <> '' then
      Attachments.Add(AAttachment);
    if AProfileName <> '' then
      LogOn(AProfileName, APassword);
    Result := Send(AShowDialog);
  finally
    Free;
  end;
end;

function JclSimpleSendMail(const Recipient, Name, Subject, Body: string;
  const Attachment: string; ShowDialog: Boolean; ParentWND: HWND;
  const ProfileName: string; const Password: string): Boolean;
begin
  Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND,
    ProfileName, Password, MapiAddressTypeSMTP);
end;

function JclSimpleSendFax(const Recipient, Name, Subject, Body: string;
  const Attachment: string; ShowDialog: Boolean; ParentWND: HWND;
  const ProfileName: string; const Password: string): Boolean;
begin
  Result := SimpleSendHelper(Recipient, Name, Subject, Body, Attachment, ShowDialog, ParentWND,
    ProfileName, Password, MapiAddressTypeFAX);
end;

function JclSimpleBringUpSendMailDialog(const Subject, Body: string;
  const Attachment: string; ParentWND: HWND;
  const ProfileName: string; const Password: string): Boolean;
begin
  Result := SimpleSendHelper('', '', Subject, Body, Attachment, True, ParentWND,
    ProfileName, Password, MapiAddressTypeSMTP);
end;

// History:

// $Log: JclMapi.pas,v $
// Revision 1.14  2005/03/08 08:33:22  marquardt
// overhaul of exceptions and resourcestrings, minor style cleaning
//
// Revision 1.13  2005/02/25 07:20:15  marquardt
// add section lines
//
// Revision 1.12  2005/02/24 16:34:52  marquardt
// remove divider lines, add section lines (unfinished)
//
// Revision 1.11  2004/10/25 20:42:07  mthoma
// #0002255
//
// Revision 1.10  2004/10/17 21:29:23  mthoma
// Used version rev 1.2 to remove all rev 1.3 contributions.
//
// Revision 1.9  2004/10/17 21:00:15  mthoma
// cleaning
//
// Revision 1.8  2004/07/31 06:21:03  marquardt
// fixing TStringLists, adding BeginUpdate/EndUpdate, finalization improved
//
// Revision 1.7  2004/07/28 18:00:53  marquardt
// various style cleanings, some minor fixes
//
// Revision 1.6  2004/06/16 07:30:30  marquardt
// added tilde to all IFNDEF ENDIFs, inherited qualified
//
// Revision 1.5  2004/06/02 03:23:47  rrossmair
// cosmetic changes in several units (code formatting, help TODOs processed etc.)
//
// Revision 1.4  2004/05/05 07:33:49  rrossmair
// header updated according to new policy: initial developers & contributors listed
//
// Revision 1.3  2004/04/06 04:55:17
// adapt compiler conditions, add log entry
//

end.