email.pas

收发MAPI E-Mail(非SMTP E-mail), 传真的构件

    claming that StrNew will never return NIL; the VCL
    source code says the opposite }
  if pLongText <> nil then
  begin
    FpLongText := StrNew(pLongText);
    Result := StrLen(FpLongText);
  end
  else
  begin
    FpLongText := nil;
    Result := 0;
  end;
end;


{ get a pointer to the message body }
function TEmail.GetLongText: PChar;
begin
  Result := FpLongText;
end;


{ get net message ID }
{--------------------}

function TEmail.GetNextMessageId: SString;
var
  szMessageID     : PChar;
  szSeedMessageID : PChar;
  flLogoff        : Boolean;
  flFlags         : ULONG;
  MapiResult      : ULONG;

begin
  CheckMapi;

  szMessageID     := nil;
  szSeedMessageID := nil;

  { Auto Logoff, if no session active. }
  flLogoff := (hSession = 0);

  { Logon to mail server. }
  if Logon <> SUCCESS_SUCCESS then
  begin
    Result := '';
    exit;
  end;

  try
    szMessageID := StrAlloc(MsgIdSize); { MAPI 32bit !! }
    szSeedMessageID := StrAlloc(MsgIdSize); { MAPI 32bit !! }
    FillChar(szSeedMessageID^, MsgIdSize, 0);

    if Length(FMessageId) = 0 then
    begin
      FillChar(szMessageID^, MsgIdSize, 0);
    end
    else
    begin
      StrPCopy(szMessageId, FMessageId);
    end;

    StrCopy(szSeedMessageId, szMessageId);
    flFlags := 0;

    if FUnreadOnly then
      inc(flFlags, MAPI_UNREAD_ONLY);

    if FUseLongMessageID then
      inc(flFlags, MAPI_LONG_MSGID);

    MapiResult := MapiFindNext(hSession, 0, nil, szSeedMessageID, flflags, 0, @szMessageID^);
    if  MapiResult = SUCCESS_SUCCESS then
    begin
      FMessageId := StrPas(szMessageId);
    end
    else
    begin
      DoMapiError(MapiResult);

      FMessageId := '';
    end;

  finally
    StrDispose(szMessageID);
    StrDispose(szSeedMessageID);

    { Auto logoff, if no session was active. }
    if flLogoff = True then Logoff;
  end;

  Result := FMessageID;

end;

{ set recipient }
{---------------}

procedure TEmail.SetRecip(const Recip: TStrings);
begin
  FRecip.Assign(Recip);
end;

{ set CC }
{--------}

procedure TEmail.SetCC(const CC: TStrings);
begin
  FCC.Assign(CC);
end;


{ set  BCC }
{----------}

procedure TEmail.SetBcc(const Bcc: TStrings);
begin
  FBcc.Assign(Bcc);
end;


{ set attachment }
{----------------}

procedure TEmail.SetAttachment(const Attachment: TStrings);
begin
  FAttachment.Assign(Attachment);
end;


{ set DownloadFirst property settings }
{-------------------------------------}

procedure TEmail.SetDownLoadFirst(bDownLoadFirst: boolean);
begin
  if bDownLoadFirst then
    flLogonFlags := flLogonFlags or MAPI_FORCE_DOWNLOAD
  else
    flLogonFlags := flLogonFlags and (not MAPI_FORCE_DOWNLOAD);

  FDownLoadFirst := bDownLoadFirst;
end;

{ set NewSession property settings }
{-------------------------------------}

procedure TEmail.SetNewSession(bNewSession: boolean);
begin
  if bNewSession then
    flLogonFlags := flLogonFlags or MAPI_NEW_SESSION
  else
    flLogonFlags := flLogonFlags and (not MAPI_NEW_SESSION);

  FNewSession := bNewSession;
end;

{ Count number of unread messages. }
{----------------------------------}

function TEmail.CountUnread: ULONG;
var
  szMessageID     : PChar;
  szSeedMessageID : PChar;
  flFlags         : ULONG;
  Count           : ULONG;
  flLogoff        : Boolean;
begin
  CheckMapi;

  Count := 0;

  { Auto Logoff, if no session active. }
  flLogoff := (hSession = 0);

  { Logon to mail server. }
  if Logon <> SUCCESS_SUCCESS then
  begin
    Result := MAPI_E_LOGIN_FAILURE;
    exit;
  end;

  szMessageId := nil;
  szSeedMessageId := nil;
  { Start at first message. }
  try
    szMessageID := StrAlloc(MsgIdSize); { MAPI 32bit !! }
    szSeedMessageID := StrAlloc(MsgIdSize); { MAPI 32bit !! }
    FillChar(szMessageID^, MsgIdSize, 0);
    FillChar(szSeedMessageID^, MsgIdSize, 0);

    flFlags := MAPI_UNREAD_ONLY;

    if FUseLongMessageID then
      inc(flFlags, MAPI_LONG_MSGID);

    while MapiFindNext( hSession, 0, nil, szSeedMessageID,
                        flFlags, 0, @szMessageID^) = SUCCESS_SUCCESS do
    begin
      if StrComp(szSeedMessageId, szMessageId) = 0 then
        break
      else
        StrCopy(szSeedMessageId,szMessageId);

      inc(Count);
    end;

  finally
    StrDispose(szMessageID);
    StrDispose(szSeedMessageID);

    { Auto logoff, if no session was active. }
    if flLogoff = True then Logoff;
  end;

  Result := Count;
end;

 { Following code added by Rudi Claasen }

{ get address dialog }
{--------------------}

function TEmail.Address: Integer;
var
  MapiRecipDesc : TMapiRecipDesc;
  lpRecipArray  : TlpRecipArray;
  lpNwRecipArray: TlpRecipArray;
  lppRecipArray : lpMapiRecipDesc;

  flLogoff      : Boolean;
  MapiResult    : ULONG;

  i             : Integer;

  nRecipients   : Integer;    { number of initial recipients after address check }
  nNwRecipients : Integer;    { number of recipients returned by MapiAddress }

begin
  CheckMapi;

  { make sure the cleanup does not free garbage }
  lpRecipArray  := nil;

  flLogoff       := False;

  { check our built-in limits }
  nRecipients := FCC.Count + FBCC.Count + Frecip.Count;
  if nRecipients > RECIP_MAX then
  begin
    Result := MAPI_E_TOO_MANY_RECIPIENTS;

    DoMapiError(Result);

    exit;
  end;

  { begin the work}
  try
    lpRecipArray  := TlpRecipArray(StrAlloc(nRecipients*SizeOf(TMapiRecipDesc)));
    FillChar(lpRecipArray^, StrBufSize(PChar(lpRecipArray)), 0);

    flLogoff := (hSession = 0);

    { Logon to mail server if not already logged on. }

    if Logon <> SUCCESS_SUCCESS then
    begin
      Result := MAPI_E_LOGIN_FAILURE;
      exit;
    end;
    { Initialise MAPI structures and local arrays. }

    FillChar(MapiRecipDesc, SizeOf(TMapiRecipDesc), 0);

    nRecipients := 0;
    { check and fill in recipients if any }
    ListToRecipArray(FRecip, MAPI_TO,  lpRecipArray, nRecipients);
    ListToRecipArray(FCC,    MAPI_CC,  lpRecipArray, nRecipients);
    ListToRecipArray(FBcc,   MAPI_BCC, lpRecipArray, nRecipients);

    Result := -1;
    MapiResult := MapiAddress (hSession,
                               0,
                               '',
                               4,
                               '',
                               nRecipients,
                               lpRecipArray^[0],
                               0,
                               0,
                               @nNwRecipients,
                               lppRecipArray);
    if MapiResult <> SUCCESS_SUCCESS then
    begin
      Result := MapiResult;

      DoMapiError(Result);

      exit;
    end;

    try
      lpNwRecipArray := @lppRecipArray^;

      { Convert names to TStringList }
      FRecip.Clear;
      FCC.Clear;
      FBcc.Clear;
      for i := 0 to (nNwRecipients - 1) do
      begin
        if lpNwRecipArray^[i].ulRecipClass = MAPI_TO then
          FRecip.Add(StrPas(lpNwRecipArray^[i].lpszName));

        if lpNwRecipArray^[i].ulRecipClass = MAPI_CC then
          FCC.Add(StrPas(lpNwRecipArray^[i].lpszName));

        if lpNwRecipArray^[i].ulRecipClass = MAPI_BCC then
          FBcc.Add(StrPas(lpNwRecipArray^[i].lpszName));
      end;
    finally
      MapiFreeBuffer(lppRecipArray);      { added 17/02/97 -- dh --}
    end;

    Result := SUCCESS_SUCCESS;

  finally
    { dispose of the recipient & CC & BCC name strings }
    { free only those that passed initial address check }
    if Assigned(lpRecipArray) then
    begin
      for i := 0 to (nRecipients - 1) do
      begin
        Dispose(lpRecipArray^[i].lpszName);
      end;
    end;

    { dispose of the recipient/CC/BCC array }
    StrDispose(PChar(lpRecipArray));

    { Auto logoff, if no session was active. }
    if flLogoff = True then Logoff;
  end;
end;


{ list to recipient arrary }
{--------------------------}

Function TEmail.ListToRecipArray( FArray          : TStrings;
                                  AulRecipClass   : ULONG;
                                  lpRecipArray    : TlpRecipArray;
                                  var nRecipients : Integer): Integer;
const
  RecipSize = 256;
var
  lpRecip    : lpMapiRecipDesc;

  szRecipName: PChar;
  MapiResult : ULONG;
  i          : Integer;

  s: SString;
begin
  { CheckMapi;   ListToRecipArray is an internal function that can/should
                 only get called by code that has already called CheckMapi }

  szRecipName := nil;
  try
    szRecipName := StrAlloc(RecipSize);
    Result := SUCCESS_SUCCESS;

    for i := 0 to (FArray.Count - 1) do
    begin
      if Length(FArray.Strings[i]) > 0 then           { recipient specified }
      begin
        StrPCopy(szRecipName, FArray.Strings[i]);     { check recipients name }

        MapiResult := MapiResolveName(hSession, 0, szRecipName, 0, 0, @lpRecip);
        if (MapiResult = MAPI_E_AMBIGUOUS_RECIPIENT) or
           (MapiResult = MAPI_E_UNKNOWN_RECIPIENT) then
        begin
          MapiResult := MapiResolveName( hSession, 0, szRecipName,
                                         MAPI_DIALOG, 0, @lpRecip);
        end;

        { Windows will either be happy about something like [FAX:123456] or not;
          if it is happy it will strip  '[FAX:' and ']', leaving just 123456

          Strategy:
          - Find out whether szRecipName originally contained '[', ']'
          - Check whether they are still there
             -> error, NO direct address
          - [] are gone, so simply add the ORIGINAL string, NOT the modified
              MAPI resolved name to .lpszAddress }

        if MapiResult <> SUCCESS_SUCCESS then
        begin
          Result := MapiResult;

          DoMapiError(Result);
        end
        else
        begin

          { the original address looked like a direct address }
          if ((Pos('[', FArray.Strings[i]) > 0) and (Pos(']', FArray.Strings[i]) > 0)) and

          { did Windows recognize this?}
             ((StrScan (lpRecip^.lpszName, '[') = nil) and
              (StrRScan(lpRecip^.lpszName, ']') = nil)) then
          begin
            { use original address }
            { do NOT re-assign FArray.Strings }
            MapiFreeBuffer(lpRecip); { free the buffer }

            with lpRecipArray^[nRecipients] do
            begin
              s := FArray.Strings[i];

              { remove [ ] }
              { this assumes that there is only ONE of '[' and ']' each in the string }
              { testing indicates that for a valid direct address - which we DO have
                here - this is always the case; no documentation could be found though
                that assures us of this }
              Delete(s, Pos(']', s), 1);
              Delete(s, Pos('[', s), 1);

              ulRecipClass   := AulRecipClass;
              lpszAddress    := StrPCopy( new(TlpszRecipName)^, s);
              lpszName       := StrPCopy( new(TlpszRecipName)^, s);
            end;
          end
          else
          begin
            { use resolved address }
            FArray.Strings[i] := StrPas(lpRecip^.lpszName);

            with lpRecipArray^[nRecipients] do
            begin
              ulRecipClass  := AulRecipClass;

              lpszName      := StrCopy( new(TlpszRecipName)^, lpRecip^.lpszName);

              { Eudora MAPI DLL does not fill in lpszAddress                 }
              { "Ken Clark" <[e-mail]> 16/07/1998        }
              if lpRecip^.lpszAddress = nil then
                lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszName)
              else
                lpszAddress := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszAddress);

              { Old code:
                  lpszAddress    := StrCopy(new(TlpszRecipName)^, lpRecip^.lpszAddress); }
              ulEIDSize     := lpRecip^.ulEIDSize;
              lpEntryID     := lpRecip^.lpEntryID;
            end;

            MapiFreeBuffer(lpRecip); { free the buffer }
          end;

          Inc(nRecipients);
        end;

      end;
    end;

  finally
    StrDispose(szRecipName);
  end;

end;

{------------------------------------------------------------------------------}

initialization
  {$IFNDEF WIN32} {$IFDEF UseGenericThunks}{ need some code for generic thunking }
     InitWin32;
  {$ENDIF UseGenericThunks} {$ENDIF WIN32}
end.