jclmapi.pas

East make Tray Icon in delphi

  FClientConnectKind := ctAutomatic;
  FSelectedClientIndex := -1;
  ReadMapiSettings;
end;

destructor TJclSimpleMapi.Destroy;
begin
  UnloadClientLib;
  inherited Destroy;
end;

procedure TJclSimpleMapi.BeforeUnloadClientLib;
begin
  if Assigned(FBeforeUnloadClient) then
    FBeforeUnloadClient(Self);
end;

procedure TJclSimpleMapi.CheckListIndex(I, ArrayLength: Integer);
begin
  if (I < 0) or (I >= ArrayLength) then
    raise EJclMapiError.CreateResFmt(@RsMapiInvalidIndex, [I]);
end;

function TJclSimpleMapi.ClientLibLoaded: Boolean;
begin
  Result := FClientLibHandle <> 0;
end;

function TJclSimpleMapi.GetClientCount: Integer;
begin
  Result := Length(FClients);
end;

function TJclSimpleMapi.GetClientLibName: string;
begin
  if UseMapi then
    Result := MapiDll
  else
    Result := FClients[FSelectedClientIndex].ClientPath;
end;

function TJclSimpleMapi.GetClients(Index: Integer): TJclMapiClient;
begin
  CheckListIndex(Index, ClientCount);
  Result := FClients[Index];
end;

function TJclSimpleMapi.GetCurrentClientName: string;
begin
  if UseMapi then
    Result := 'MAPI'
  else
  if ClientCount > 0 then
    Result := Clients[SelectedClientIndex].ClientName
  else
    Result := '';
end;

function TJclSimpleMapi.GetProfileCount: Integer;
begin
  Result := Length(FProfiles);
end;

function TJclSimpleMapi.GetProfiles(Index: Integer): string;
begin
  CheckListIndex(Index, ProfileCount);
  Result := FProfiles[Index];
end;

procedure TJclSimpleMapi.LoadClientLib;
var
  I: Integer;
  P: Pointer;
begin
  if ClientLibLoaded then
    Exit;
  FClientLibHandle := LoadLibrary(PChar(GetClientLibName));
  if FClientLibHandle = 0 then
    RaiseLastOSError;
  for I := 0 to Length(FFunctions) - 1 do
  begin
    P := GetProcAddress(FClientLibHandle, PChar(MapiExportNames[I]));
    if P = nil then
    begin
      UnloadClientLib;
      raise EJclMapiError.CreateResFmt(@RsMapiMissingExport, [MapiExportNames[I]]);
    end
    else
      FFunctions[I]^ := P;
  end;
end;

class function TJclSimpleMapi.ProfilesRegKey: string;
begin
  if IsWinNT then
    Result := 'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles'
  else
    Result := 'SOFTWARE\Microsoft\Windows Messaging Subsystem\Profiles';
end;

procedure TJclSimpleMapi.ReadMapiSettings;
const
  MessageSubsytemKey = 'SOFTWARE\Microsoft\Windows Messaging Subsystem';
  MailClientsKey = 'SOFTWARE\Clients\Mail';
var
  DefaultValue, ClientKey: string;
  SL: TStringList;
  I: Integer;

  function CheckValid(var Client: TJclMapiClient): Boolean;
  var
    I: Integer;
    LibHandle: THandle;
  begin
    LibHandle := LoadLibraryEx(PChar(Client.ClientPath), 0, DONT_RESOLVE_DLL_REFERENCES);
    Result := (LibHandle <> 0);
    if Result then
    begin
       for I := Low(MapiExportNames) to High(MapiExportNames) do
        if GetProcAddress(LibHandle, PChar(MapiExportNames[I])) = nil then
        begin
          Result := False;
          Break;
        end;
      FreeLibrary(LibHandle);
    end;
    Client.Valid := Result;
  end;

begin
  FClients := nil;
  FDefaultClientIndex := -1;
  FProfiles := nil;
  FDefaultProfileName := '';
  SL := TStringList.Create;
  try
    if RegKeyExists(HKEY_LOCAL_MACHINE, MessageSubsytemKey) then
    begin
      FMapiInstalled := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPIX', '') = '1';
      FSimpleMapiInstalled := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPI', '') = '1';
      FMapiVersion := RegReadStringDef(HKEY_LOCAL_MACHINE, MessageSubsytemKey, 'MAPIXVER', '');
    end;
    FAnyClientInstalled := FMapiInstalled;
    if RegKeyExists(HKEY_LOCAL_MACHINE, MailClientsKey) then
    begin
      DefaultValue := RegReadStringDef(HKEY_LOCAL_MACHINE, MailClientsKey, '', '');
      if RegGetKeyNames(HKEY_LOCAL_MACHINE, MailClientsKey, SL) then
      begin
        SetLength(FClients, SL.Count);
        for I := 0 to SL.Count - 1 do
        begin
          FClients[I].RegKeyName := SL[I];
          FClients[I].Valid := False;
          ClientKey := MailClientsKey + '\' + SL[I];
          if RegKeyExists(HKEY_LOCAL_MACHINE, ClientKey) then
          begin
            FClients[I].ClientName := RegReadStringDef(HKEY_LOCAL_MACHINE, ClientKey, '', '');
            FClients[I].ClientPath := RegReadStringDef(HKEY_LOCAL_MACHINE, ClientKey, 'DLLPath', '');
            ExpandEnvironmentVar(FClients[I].ClientPath);
            if CheckValid(FClients[I]) then
              FAnyClientInstalled := True;
          end;
        end;
        FDefaultClientIndex := SL.IndexOf(DefaultValue);
        FSelectedClientIndex := FDefaultClientIndex;
      end;
    end;
    if RegKeyExists(HKEY_CURRENT_USER, ProfilesRegKey) then
    begin
      FDefaultProfileName := RegReadStringDef(HKEY_CURRENT_USER, ProfilesRegKey, 'DefaultProfile', '');
      if RegGetKeyNames(HKEY_CURRENT_USER, ProfilesRegKey, SL) then
      begin
        SetLength(FProfiles, SL.Count);
        for I := 0 to SL.Count - 1 do
          FProfiles[I] := SL[I];
      end;
    end;
  finally
    SL.Free;
  end;
end;

procedure TJclSimpleMapi.SetClientConnectKind(const Value: TJclMapiClientConnect);
begin
  if FClientConnectKind <> Value then
  begin
    FClientConnectKind := Value;
    UnloadClientLib;
  end;
end;

procedure TJclSimpleMapi.SetSelectedClientIndex(const Value: Integer);
begin
  CheckListIndex(Value, ClientCount);
  if FSelectedClientIndex <> Value then
  begin
    FSelectedClientIndex := Value;
    UnloadClientLib;
  end;
end;

procedure TJclSimpleMapi.UnloadClientLib;
var
  I: Integer;
begin
  if ClientLibLoaded then
  begin
    BeforeUnloadClientLib;
    FreeLibrary(FClientLibHandle);
    FClientLibHandle := 0;
     for I := 0 to Length(FFunctions) - 1 do
      FFunctions[I]^ := nil;
  end;
end;

function TJclSimpleMapi.UseMapi: Boolean;
begin
  case FClientConnectKind of
    ctAutomatic:
      UseMapi := FSimpleMapiInstalled;
    ctMapi:
      UseMapi := True;
    ctDirect:
      UseMapi := False;
  else
    UseMapi := True;
  end;
end;

//=== { TJclEmailRecip } =====================================================

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

class function TJclEmailRecip.RecipKindToString(const AKind: TJclEmailRecipKind): string;
const
  Idents: array [TJclEmailRecipKind] of string = (
    RsMapiMailORIG, RsMapiMailTO, RsMapiMailCC, RsMapiMailBCC);
begin
  case AKind of
     rkOriginator:
       Result := RsMapiMailORIG;
     rkTO:
       Result := RsMapiMailTO;
     rkCC:
       Result := RsMapiMailCC;
     rkBCC:
       Result := RsMapiMailBCC;
   end;
end;

function TJclEmailRecip.SortingName: string;
begin
  if FName = '' then
    Result := FAddress
  else
    Result := FName;
end;

//=== { TJclEmailRecips } ====================================================

function TJclEmailRecips.Add(const Address, Name: string;
  const Kind: TJclEmailRecipKind; const AddressType: string): Integer;
var
  Item: TJclEmailRecip;
begin
  Item := TJclEmailRecip.Create;
  try
    Item.Address := Trim(Address);
    Item.AddressType := AddressType;
    Item.Name := Name;
    Item.Kind := Kind;
    Result := inherited Add(Item);
  except
    Item.Free;
    raise;
  end;
end;

function TJclEmailRecips.GetItems(Index: Integer): TJclEmailRecip;
begin
  Result := TJclEmailRecip(Get(Index));
end;

function TJclEmailRecips.GetOriginator: TJclEmailRecip;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
    if Items[I].Kind = rkOriginator then
    begin
      Result := Items[I];
      Break;
    end;
end;

function EmailRecipsCompare(Item1, Item2: Pointer): Integer;
var
  R1, R2: TJclEmailRecip;
begin
  R1 := TJclEmailRecip(Item1);
  R2 := TJclEmailRecip(Item2);
  Result := Integer(R1.Kind) - Integer(R2.Kind);
  if Result = 0 then
    Result := AnsiCompareStr(R1.SortingName, R2.SortingName);
end;

procedure TJclEmailRecips.SortRecips;
begin
  Sort(EmailRecipsCompare);
end;

//=== { TJclEmail } ==========================================================

constructor TJclEmail.Create;
begin
  inherited Create;
  FAttachments := TStringList.Create;
  FLogonOptions := [loLogonUI];
  FFindOptions := [foFifo];
  FRecipients := TJclEmailRecips.Create(True);
  FRecipients.AddressesType := MapiAddressTypeSMTP;
end;

destructor TJclEmail.Destroy;
begin
  FreeAndNil(FAttachments);
  FreeAndNil(FRecipients);
  inherited Destroy;
end;

function TJclEmail.Address(const Caption: string; EditFields: Integer): Boolean;
var
  NewRecipCount: ULONG;
  NewRecips: PMapiRecipDesc;
  Recips: TMapiRecipDesc;
  Res: DWORD;
begin
  LoadClientLib;
  NewRecips := nil;
  NewRecipCount := 0;
  Res := MapiAddress(FSessionHandle, ParentWnd, PChar(Caption), EditFields, nil,
    0, Recips, LogonOptionsToFlags(False), 0, @NewRecipCount, NewRecips);
  Result := (MapiCheck(Res, True) = SUCCESS_SUCCESS);
  if Result then
  try
    DecodeRecips(NewRecips, NewRecipCount);
  finally  
    MapiFreeBuffer(NewRecips);
  end;
end;

procedure TJclEmail.BeforeUnloadClientLib;
begin
  LogOff;
  inherited BeforeUnloadClientLib;
end;

procedure TJclEmail.Clear;
begin
  Attachments.Clear;
  Body := '';
  FSubject := '';
  Recipients.Clear;
  FReadMsg.MessageType := '';
  FReadMsg.DateReceived := 0;
  FReadMsg.ConversationID := '';
  FReadMsg.Flags := 0;
end;

procedure TJclEmail.DecodeRecips(RecipDesc: PMapiRecipDesc; Count: Integer);
var
  S: string;
  N, I: Integer;
  Kind: TJclEmailRecipKind;
begin
  for I := 0 to Count - 1 do
  begin
    if RecipDesc = nil then
      Break;
    Kind := rkOriginator;
    with RecipDesc^ do
    begin
      case ulRecipClass of
         MAPI_ORIG:
           Kind := rkOriginator;
         MAPI_TO:
           Kind := rkTO;   
         MAPI_CC:   
           Kind := rkCC;   
         MAPI_BCC:   
           Kind := rkBCC;
        $FFFFFFFF:  // Eudora client version 5.2.0.9 bug
          Kind := rkOriginator;
      else
        MapiCheck(MAPI_E_INVALID_MESSAGE, True);
      end;  
      S := lpszAddress;
      N := Pos(AddressTypeDelimiter, S);
      if N = 0 then
        Recipients.Add(S, lpszName, Kind)
      else
        Recipients.Add(Copy(S, N + 1, Length(S)), lpszName, Kind, Copy(S, 1, N - 1));
    end;
    Inc(RecipDesc);
  end;
end;

function TJclEmail.Delete(const MessageID: string): Boolean;
begin
  LoadClientLib;
  Result := MapiCheck(MapiDeleteMail(FSessionHandle, 0, PChar(MessageID), 0, 0),
    False) = SUCCESS_SUCCESS;
end;

function TJclEmail.FindFirstMessage: Boolean;
begin
  SeedMessageID := '';
  Result := FindNextMessage;
end;

function TJclEmail.FindNextMessage: Boolean;
var
  MsgID: array [0..512] of AnsiChar;
  Flags, Res: ULONG;
begin
  Result := False;
  if not UserLogged then
    Exit;
  Flags := MAPI_LONG_MSGID;
  if foFifo in FFindOptions then
    Inc(Flags, MAPI_GUARANTEE_FIFO);