jvqmail.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{  WARNING:  JEDI preprocessor generated unit.  Do not edit.                                       }
{**************************************************************************************************}

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvMail.PAS, released Jun 10, 2000.

The Initial Developer of the Original Code is Petr Vones (petr dott v att mujmail dott cz)
Portions created by Petr Vones are Copyright (C) 2000 Petr Vones.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): ______________________________________.

Current Version: 0.50

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------
Doesn't work with Paegasus Mail because it has no MAPI support at all.      }

{$I jvcl.inc}

unit JvQMail;

interface

uses
  Windows, SysUtils, Classes,
  QControls, QForms, Qt, QWindows,
  Mapi, JclBase, JclMapi, JvQComponent;

type
  TJvMail = class;

  // (rom) renamed
  TJvMailRecipient = class(TCollectionItem)
  private
    FAddress: string;
    FName: string;
    function GetAddressAndName: string;
    function GetValid: Boolean;
  protected
    function GetDisplayName: string; override;
  public
    // (rom) renamed
    property AddressAndName: string read GetAddressAndName;
  published
    property Address: string read FAddress write FAddress;
    property Name: string read FName write FName;
    property Valid: Boolean read GetValid;
  end;

  // (rom) renamed
  TJvMailRecipients = class(TCollection)
  private
    FOwner: TJvMail;
    FRecipientClass: DWORD;
    function GetItem(Index: Integer): TJvMailRecipient;
    procedure SetItem(Index: Integer; const Value: TJvMailRecipient);
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TJvMail; ARecipientClass: DWORD);
    function Add: TJvMailRecipient;
    function AddRecipient(const Address: string; const Name: string = ''): Integer;
    procedure Assign(Source: TPersistent); override;
    property Items[Index: Integer]: TJvMailRecipient read GetItem write SetItem; default;
    property RecipientClass: DWORD read FRecipientClass;
  end;

  TJvMailLogonOption = (loLogonUI, loNewSession, loDownloadMail);
  TJvMailLogonOptions = set of TJvMailLogonOption;
  TJvMailReadOption = (roUnreadOnly, roFifo, roPeek, roHeaderOnly, roAttachments);
  TJvMailReadOptions = set of TJvMailReadOption;

  TJvMailReadedData = record
    RecipientAddress: string;
    RecipientName: string;
    ConversationID: string;
    DateReceived: TDateTime;
  end;

  TJvMailErrorEvent = procedure(Sender: TJvMail; ErrorCode: ULONG) of object;

  TJvMail = class(TJvComponent)
  private
    FAttachment: TStringList;
    FAttachArray: array of TMapiFileDesc;
    FBlindCopy: TJvMailRecipients;
    FBody: TStringList;
    FBodyText: string;
    FCarbonCopy: TJvMailRecipients;
    FRecipient: TJvMailRecipients;
    FSimpleMapi: TJclSimpleMapi;
    FSubject: string;
    FSessionHandle: THandle;
    FMapiMessage: TMapiMessage;
    FRecipArray: array of TMapiRecipDesc;
    FLongMsgId: Boolean;
    FLogonOptions: TJvMailLogonOptions;
    FPassword: string;
    FProfileName: string;
    FSaveTaskWindows: array of Boolean;
    FSaveTaskActiveForm: TForm;
    FSeedMessageID: string;
    FReadOptions: TJvMailReadOptions;
    FReadedMail: TJvMailReadedData;
    FOnError: TJvMailErrorEvent;
    procedure BeforeClientLibUnload(Sender: TObject);
    procedure SetBlindCopy(const Value: TJvMailRecipients);
    procedure SetCarbonCopy(const Value: TJvMailRecipients);
    procedure SetRecipient(const Value: TJvMailRecipients);
    function GetBody: TStrings;
    procedure SetBody(const Value: TStrings);
    function GetUserLogged: Boolean;
    function GetAttachment: TStrings;
    procedure SetAttachment(const Value: TStrings);
    function GetSimpleMapi: TJclSimpleMapi;
    procedure SetSeedMessageID(const Value: string);
  protected
    procedure CheckLoadLib;
    procedure CheckUserLogged;
    procedure CreateMapiMessage;
    procedure CreateRecips;
    procedure DecodeAttachments(Attachments: PMapiFileDesc; AttachCount: Integer);
    procedure DecodeRecipients(Recips: PMapiRecipDesc; RecipCount: Integer);
    procedure FreeMapiMessage;
    function LogonFlags: DWORD;
    procedure RestoreTaskWindowsState;
    procedure SaveTaskWindowsState;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Address(const Caption: string = ''; EditFields: Integer = 3): Boolean;
    procedure Clear;
    function ErrorCheck(Res: DWORD): DWORD;
    function FindFirstMail: Boolean;
    function FindNextMail: Boolean;
    procedure FreeSimpleMapi;
    procedure LogOff;
    procedure LogOn;
    procedure ReadMail;
    function ResolveName(const Name: string): string;
    function SaveMail(const MessageID: string): string;
    procedure SendMail(ShowDialog: Boolean = True);
    property ReadedMail: TJvMailReadedData read FReadedMail;
    property SeedMessageID: string read FSeedMessageID write SetSeedMessageID;
    property SessionHandle: THandle read FSessionHandle;
    property SimpleMAPI: TJclSimpleMapi read GetSimpleMapi;
    property UserLogged: Boolean read GetUserLogged;
  published
    property Attachment: TStrings read GetAttachment write SetAttachment;
    property BlindCopy: TJvMailRecipients read FBlindCopy write SetBlindCopy;
    property Body: TStrings read GetBody write SetBody;
    property CarbonCopy: TJvMailRecipients read FCarbonCopy write SetCarbonCopy;
    property LogonOptions: TJvMailLogonOptions read FLogonOptions write FLogonOptions
      default [loLogonUI, loNewSession];
    property LongMsgId: Boolean read FLongMsgId write FLongMsgId default True;
    property Password: string read FPassword write FPassword;
    property ProfileName: string read FProfileName write FProfileName;
    property ReadOptions: TJvMailReadOptions read FReadOptions write FReadOptions
      default [roFifo, roPeek];
    property Recipient: TJvMailRecipients read FRecipient write SetRecipient;
    property Subject: string read FSubject write FSubject;
    property OnError: TJvMailErrorEvent read FOnError write FOnError;
  end;

implementation

uses
  JvQResources;

//=== TJvMailRecipient =======================================================

function TJvMailRecipient.GetAddressAndName: string;
var
  N: string;
begin
  if Name = '' then
    N := Address
  else
    N := Name;
  Result := Format('"%s" <%s>', [N, Address]);
end;

function TJvMailRecipient.GetDisplayName: string;
begin
  if Valid then
    Result := AddressAndName
  else
    Result := inherited GetDisplayName;
end;

function TJvMailRecipient.GetValid: Boolean;
begin
  Result := FAddress <> '';
end;

//=== TJvMailRecipients ======================================================

function TJvMailRecipients.Add: TJvMailRecipient;
begin
  Result := TJvMailRecipient(inherited Add);
end;

function TJvMailRecipients.AddRecipient(const Address, Name: string): Integer;
var
  Item: TJvMailRecipient;
begin
  Item := Add;
  Result := Item.Index;
  try
    Item.Address := Address;
    Item.Name := Name;
  except
    Item.Free;
    raise;
  end;
end;

procedure TJvMailRecipients.Assign(Source: TPersistent);
var
  I: Integer;
begin
  if Source is TStrings then
  begin
    BeginUpdate;
    try
      for I := 0 to TStrings(Source).Count - 1 do
        AddRecipient(TStrings(Source)[I]);
    finally
      EndUpdate;
    end;
  end
  else
    inherited Assign(Source);
end;

procedure TJvMailRecipients.AssignTo(Dest: TPersistent);
var
  I: Integer;
begin
  if Dest is TStrings then
  begin
    TStrings(Dest).BeginUpdate;
    try
      for I := 0 to Count - 1 do
        TStrings(Dest).Add(Items[I].Address);
    finally
      TStrings(Dest).EndUpdate;
    end;
  end
  else
    inherited AssignTo(Dest);
end;

constructor TJvMailRecipients.Create(AOwner: TJvMail; ARecipientClass: DWORD);
begin
  inherited Create(TJvMailRecipient);
  FOwner := AOwner;
  FRecipientClass := ARecipientClass;
end;

function TJvMailRecipients.GetItem(Index: Integer): TJvMailRecipient;
begin
  Result := TJvMailRecipient(inherited GetItem(Index));
end;

function TJvMailRecipients.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TJvMailRecipients.SetItem(Index: Integer; const Value: TJvMailRecipient);
begin
  inherited SetItem(Index, Value);
end;

//=== TJvMail ================================================================

function TJvMail.Address(const Caption: string; EditFields: Integer): Boolean;
var
  NewRecipCount: ULONG;
  NewRecips: PMapiRecipDesc;
begin
  CheckLoadLib;
  CreateRecips;
  SaveTaskWindowsState;
  try
    Result := (ErrorCheck(FSimpleMapi.MapiAddress(FSessionHandle, QWidget_WinId(Application.AppWidget),
      PChar(Caption), EditFields, nil, Length(FRecipArray), FRecipArray[0],
      LogonFlags, 0, @NewRecipCount, NewRecips)) = SUCCESS_SUCCESS);
  finally
    RestoreTaskWindowsState;
  end;
  if Result then
    DecodeRecipients(NewRecips, NewRecipCount);
  FSimpleMapi.MapiFreeBuffer(NewRecips);
end;

procedure TJvMail.BeforeClientLibUnload(Sender: TObject);
begin
  if UserLogged then
    LogOff;
end;

procedure TJvMail.CheckLoadLib;
begin
  GetSimpleMapi;
  FSimpleMapi.LoadClientLib;
  if not FSimpleMapi.ClientLibLoaded then
{$TYPEDADDRESS OFF}
    raise EJclMapiError.CreateRes(@RsNoClientInstalled);
{$TYPEDADDRESS ON}
end;

procedure TJvMail.CheckUserLogged;
begin
  if not UserLogged then
{$TYPEDADDRESS OFF}
    raise EJclMapiError.CreateRes(@RsNoUserLogged);
{$TYPEDADDRESS ON}
end;

procedure TJvMail.Clear;
begin
  Body.Clear;
  BlindCopy.Clear;
  CarbonCopy.Clear;
  Recipient.Clear;
  Subject := '';
  with FReadedMail do
  begin
    RecipientAddress := '';
    RecipientName := '';
    ConversationID := '';
    DateReceived := 0;
  end;
  FreeMapiMessage;
end;

constructor TJvMail.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAttachment := TStringList.Create;
  FBody := TStringList.Create;
  FBlindCopy := TJvMailRecipients.Create(Self, MAPI_BCC);
  FCarbonCopy := TJvMailRecipients.Create(Self, MAPI_CC);
  FRecipient := TJvMailRecipients.Create(Self, MAPI_TO);
  FLongMsgId := True;
  FLogonOptions := [loLogonUI, loNewSession];
  FReadOptions := [roFifo, roPeek];
end;

procedure TJvMail.CreateMapiMessage;

  procedure MakeAttachments;
  var
    I: Integer;
  begin
    if Attachment.Count > 0 then
    begin
      SetLength(FAttachArray, Attachment.Count);
      for I := 0 to Attachment.Count - 1 do
      begin
        if not FileExists(Attachment[I]) then
{$TYPEDADDRESS OFF}
          raise EJclMapiError.CreateResFmt(@RsAttachmentNotFound, [Attachment[I]]);
{$TYPEDADDRESS ON}
        FillChar(FAttachArray[I], SizeOf(TMapiFileDesc), #0);
        FAttachArray[I].nPosition := $FFFFFFFF;
        FAttachArray[I].lpszFileName := PChar(Attachment[I]);
        FAttachArray[I].lpszPathName := PChar(Attachment[I]);
      end;
    end
    else
      FAttachArray := nil;
  end;

begin
  try
    CreateRecips;