jvqmail.pas

East make Tray Icon in delphi

    MakeAttachments;
    FBodyText := Body.Text;
    FillChar(FMapiMessage, SizeOf(FMapiMessage), #0);
    FMapiMessage.lpszSubject := PChar(FSubject);
    FMapiMessage.lpszNoteText := PChar(FBodyText);
    FMapiMessage.lpRecips := PMapiRecipDesc(FRecipArray);
    FMapiMessage.nRecipCount := Length(FRecipArray);
    FMapiMessage.lpFiles := PMapiFileDesc(FAttachArray);
    FMapiMessage.nFileCount := Length(FAttachArray);
  except
    FreeMapiMessage;
    raise;
  end;
end;

procedure TJvMail.CreateRecips;
var
  RecipIndex: Integer;

  procedure MakeRecips(RecipList: TJvMailRecipients);
  var
    I: Integer;
  begin
    for I := 0 to RecipList.Count - 1 do
    begin
      if not RecipList[I].Valid then
{$TYPEDADDRESS OFF}
        raise EJclMapiError.CreateResFmt(@RsRecipNotValid, [RecipList[I].GetNamePath]);
{$TYPEDADDRESS ON}
      FillChar(FRecipArray[RecipIndex], SizeOf(TMapiRecipDesc), #0);
      with FRecipArray[RecipIndex], RecipList[I] do
      begin
        ulRecipClass := RecipList.RecipientClass;
        if Name = '' then // some clients requires Name item always filled
          lpszName := PChar(Address)
        else
          lpszName := PChar(Name);
        lpszAddress := PChar(Address);
      end;
      Inc(RecipIndex);
    end;
  end;

begin
  SetLength(FRecipArray, FBlindCopy.Count + FCarbonCopy.Count + FRecipient.Count);
  RecipIndex := 0;
  MakeRecips(FBlindCopy);
  MakeRecips(FCarbonCopy);
  MakeRecips(FRecipient);
end;

procedure TJvMail.DecodeAttachments(Attachments: PMapiFileDesc; AttachCount: Integer);
var
  I: Integer;
begin
  Attachment.Clear;
  if Attachments = nil then
    Exit;
  for I := 0 to AttachCount - 1 do
  begin
    Attachment.Add(Attachments^.lpszPathName);
    Inc(Attachments);
  end;
end;

procedure TJvMail.DecodeRecipients(Recips: PMapiRecipDesc; RecipCount: Integer);
var
  I: Integer;
begin
  FBlindCopy.Clear;
  FCarbonCopy.Clear;
  FRecipient.Clear;
  if Recips = nil then
    Exit;
  for I := 0 to RecipCount - 1 do
  begin
    with Recips^ do
      case ulRecipClass of
        MAPI_BCC:
          BlindCopy.AddRecipient(lpszAddress, lpszName);
        MAPI_CC:
          CarbonCopy.AddRecipient(lpszAddress, lpszName);
        MAPI_TO:
          Recipient.AddRecipient(lpszAddress, lpszName);
      end;
    Inc(Recips);
  end;
end;

destructor TJvMail.Destroy;
begin
  FreeSimpleMapi;
  FreeAndNil(FAttachment);
  FreeAndNil(FBody);
  FreeAndNil(FBlindCopy);
  FreeAndNil(FCarbonCopy);
  FreeAndNil(FRecipient);
  inherited Destroy;
end;

function TJvMail.ErrorCheck(Res: DWORD): DWORD;
begin
  if Assigned(FOnError) then
  begin
    Result := Res;
    if Res <> SUCCESS_SUCCESS then
      FOnError(Self, Res);
  end
  else
    Result := MapiCheck(Res);
end;

function TJvMail.FindFirstMail: Boolean;
begin
  FSeedMessageID := '';
  Result := FindNextMail;
end;

function TJvMail.FindNextMail: Boolean;
var
  MsgID: array[0..512] of AnsiChar;
  Flags, Res: ULONG;
begin
  CheckUserLogged;
  Flags := 0;
  if FLongMsgId then
    Inc(Flags, MAPI_LONG_MSGID);
  if roFifo in FReadOptions then
    Inc(Flags, MAPI_GUARANTEE_FIFO);
  if roUnreadOnly in FReadOptions then
    Inc(Flags, MAPI_UNREAD_ONLY);
  Res := FSimpleMapi.MapiFindNext(SessionHandle, QWidget_WinId(Application.AppWidget), nil,
    PChar(FSeedMessageID), Flags, 0, MsgId);
  Result := (Res = SUCCESS_SUCCESS);
  if Result then
  begin
    FSeedMessageID := MsgID;
  end
  else
  begin
    FSeedMessageID := '';
    if Res <> MAPI_E_NO_MESSAGES then
      ErrorCheck(Res);
  end;
end;

procedure TJvMail.FreeMapiMessage;
begin
  FAttachArray := nil;
  FRecipArray := nil;
  FBodyText := '';
  FillChar(FMapiMessage, SizeOf(FMapiMessage), #0);
end;

procedure TJvMail.FreeSimpleMapi;
begin
  FreeAndNil(FSimpleMapi);
end;

function TJvMail.GetSimpleMapi: TJclSimpleMapi;
begin
  if not Assigned(FSimpleMapi) then
  begin
    FSimpleMapi := TJclSimpleMapi.Create;
    FSimpleMapi.BeforeUnloadClient := BeforeClientLibUnload;
  end;
  Result := FSimpleMapi;
end;

function TJvMail.GetUserLogged: Boolean;
begin
  Result := FSessionHandle <> 0;
end;

procedure TJvMail.LogOff;
begin
  CheckLoadLib;
  if UserLogged then
  begin
    ErrorCheck(FSimpleMapi.MapiLogOff(FSessionHandle, Application.Handle, 0, 0));
    FSessionHandle := 0;
  end;
end;

procedure TJvMail.LogOn;
begin
  CheckLoadLib;
  if UserLogged then
    Exit;
  SaveTaskWindowsState;
  try
    ErrorCheck(FSimpleMapi.MapiLogOn(Application.Handle, PChar(FProfileName),
      PChar(FPassword), LogonFlags, 0, @FSessionHandle));
  finally
    RestoreTaskWindowsState;
  end;
end;

function TJvMail.LogonFlags: DWORD;
begin
  Result := 0;
  if not UserLogged then
  begin
    if loLogonUI in FLogonOptions then
      Inc(Result, MAPI_LOGON_UI);
    if loNewSession in FLogonOptions then
      Inc(Result, MAPI_NEW_SESSION);
    if loDownloadMail in FLogonOptions then
      Inc(Result, MAPI_FORCE_DOWNLOAD);
  end;
end;  

procedure TJvMail.ReadMail;
var
  Flags: ULONG;
  Msg: PMapiMessage;
  SOldDateFormat: string;
  OldDateSeparator: Char;
begin
  CheckUserLogged;
  Clear;
  Flags := 0;
  if roHeaderOnly in FReadOptions then
    Inc(Flags, MAPI_ENVELOPE_ONLY);
  if roPeek in FReadOptions then
    Inc(Flags, MAPI_PEEK);
  if not (roAttachments in FReadOptions) then
    Inc(Flags, MAPI_SUPPRESS_ATTACH);
  ErrorCheck(FSimpleMapi.MapiReadMail(SessionHandle, Application.Handle,
    PChar(FSeedMessageID), Flags, 0, Msg));
  with Msg^ do
  begin
    if lpOriginator <> nil then
    begin
      FReadedMail.RecipientAddress := lpOriginator^.lpszAddress;
      FReadedMail.RecipientName := lpOriginator^.lpszName;
    end;
    DecodeRecipients(lpRecips, nRecipCount);
    FSubject := lpszSubject;
    Body.Text := lpszNoteText;
    //    FDateReceived := StrToDateTime(lpszDateReceived);
    SOldDateFormat := ShortDateFormat;
    OldDateSeparator := DateSeparator;
    try
      ShortDateFormat := 'yyyy/M/d';
      DateSeparator := '/';
      FReadedMail.DateReceived := StrToDateTime(lpszDateReceived);
    finally
      ShortDateFormat := SOldDateFormat;
      DateSeparator := OldDateSeparator;
    end;
    FReadedMail.ConversationID := lpszConversationID;
    DecodeAttachments(lpFiles, nFileCount);
  end;
  FSimpleMapi.MapiFreeBuffer(Msg);
end;

function TJvMail.ResolveName(const Name: string): string;
var
  RecipDesc: PMapiRecipDesc;
  Res: DWORD;
begin
  Result := '';
  CheckLoadLib;
  SaveTaskWindowsState;
  Res := FSimpleMAPI.MapiResolveName(SessionHandle, Application.Handle,
    PChar(Name), LogonFlags or MAPI_AB_NOMODIFY or MAPI_DIALOG, 0, RecipDesc);
  RestoreTaskWindowsState;
  if (Res <> MAPI_E_AMBIGUOUS_RECIPIENT) and (Res <> MAPI_E_UNKNOWN_RECIPIENT) then
  begin
    Result := RecipDesc^.lpszName;
    FSimpleMapi.MapiFreeBuffer(RecipDesc);
    ErrorCheck(Res);
  end;
end;

procedure TJvMail.RestoreTaskWindowsState;
var
  I: Integer;
begin
  if (FSaveTaskWindows <> nil) and (Length(FSaveTaskWindows) >= Screen.FormCount) then
    for I := 0 to Screen.FormCount - 1 do
      EnableWindow(Screen.Forms[I].Handle, FSaveTaskWindows[I]);
  FSaveTaskWindows := nil;
  if FSaveTaskActiveForm <> nil then
    SetFocus(FSaveTaskActiveForm.Handle);
end;

function TJvMail.SaveMail(const MessageID: string): string;
var
  MsgID: array[0..512] of AnsiChar;
  Flags: ULONG;
begin
  Result := '';
  CheckLoadLib;
  CreateMapiMessage;
  try
    StrPCopy(MsgID, MessageID);
    SaveTaskWindowsState;
    Flags := LogonFlags;
    if FLongMsgId then
      Flags := Flags or MAPI_LONG_MSGID;
    try
      ErrorCheck(FSimpleMapi.MapiSaveMail(FSessionHandle, Application.Handle,
        FMapiMessage, Flags, 0, MsgID));
    finally
      RestoreTaskWindowsState;
    end;
    Result := MsgID;
  finally
    FreeMapiMessage;
  end;
end;

procedure TJvMail.SaveTaskWindowsState;
var
  I: Integer;
  W: HWND;
begin
  SetLength(FSaveTaskWindows, Screen.FormCount);
  FSaveTaskActiveForm := Screen.ActiveForm;
  for I := 0 to Screen.FormCount - 1 do
  begin
    W := Screen.Forms[I].Handle;
    FSaveTaskWindows[I] := IsWindowEnabled(W);
    EnableWindow(W, False);
  end;
end;

procedure TJvMail.SendMail(ShowDialog: Boolean);
var
  Flags: ULONG;
begin
  CheckLoadLib;
  CreateMapiMessage;
  try
    Flags := LogonFlags;
    if ShowDialog then
      Flags := Flags or MAPI_DIALOG;
    SaveTaskWindowsState;
    try
      ErrorCheck(FSimpleMapi.MapiSendMail(FSessionHandle, Application.Handle,
        FMapiMessage, Flags, 0));
    finally
      RestoreTaskWindowsState;
    end;
  finally
    FreeMapiMessage;
  end;
end;

function TJvMail.GetAttachment: TStrings;
begin
  Result := FAttachment;
end;

procedure TJvMail.SetAttachment(const Value: TStrings);
begin
  FAttachment.Assign(Value);
end;

procedure TJvMail.SetBlindCopy(const Value: TJvMailRecipients);
begin
  FBlindCopy.Assign(Value);
end;

function TJvMail.GetBody: TStrings;
begin
  Result := FBody;
end;

procedure TJvMail.SetBody(const Value: TStrings);
begin
  FBody.Assign(Value);
end;

procedure TJvMail.SetCarbonCopy(const Value: TJvMailRecipients);
begin
  FCarbonCopy.Assign(Value);
end;

procedure TJvMail.SetRecipient(const Value: TJvMailRecipients);
begin
  FRecipient.Assign(Value);
end;

procedure TJvMail.SetSeedMessageID(const Value: string);
begin
  FSeedMessageID := Value;
end;

end.