email.pas

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

      StrDispose(szSubject);
      StrDispose(szText);
      StrDispose(szMessageID);
      StrDispose(szMessageType);
    end;

  finally
    { dispose of the recipient & CC name strings }
    if Assigned(lpRecipArray) then
      for i := 0 to (nRecipients - 1) do
      begin
        if Assigned(lpRecipArray^[i].lpszName) then
          Dispose(lpRecipArray^[i].lpszName);

        if Assigned(lpRecipArray^[i].lpszAddress) then
          Dispose(lpRecipArray^[i].lpszAddress);
      end;

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

    { dispose of the attachment file name strings }
    if Assigned(lpAttachArray) then
      for i := 0 to (nAttachments - 1) do
      begin
        Dispose(lpAttachArray^[i].lpszPathname);
        Dispose(lpAttachArray^[i].lpszFileName);
      end;

    { dispose of the attachment array }
    StrDispose(PChar(lpAttachArray));

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

end;

function TEmail.SendMail: Integer;
begin
  Result := SendMailEx(false);
end;

function TEmail.SaveMail: Integer;
begin
  Result := SendMailEx(true);
end;

{ Check a recipient }
{-------------------}

function TEmail.CheckRecipient(const ARecipient: SString) : SString;
const
  RecipSize = 256;
var
  szRecipName   : PChar;
  lpRecip       : lpMapiRecipDesc;
  flLogoff      : Boolean;
  MapiResult    : ULONG;

begin
  CheckMapi;

  flLogoff := (hSession = 0);

  { Logon to mail server if not already logged on . }
  if Logon <> SUCCESS_SUCCESS then exit;

  szRecipName := nil;
  try
    szRecipName := StrAlloc(RecipSize);
    szRecipName := StrPCopy(szRecipName, ARecipient);

    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;

    { same changes as below...}

    if MapiResult <> SUCCESS_SUCCESS then
    begin
      DoMapiError(MapiResult);

      Result := '';
      exit;
    end
    else
    begin

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

      { did Windows recognize this?}
         ((StrScan (lpRecip^.lpszName, '[') = nil) and
          (StrRScan(lpRecip^.lpszName, ']') = nil)) then
      begin
        { use original address, and DO NOT remove the brackets...
          we will need them later when the array is filled to determine
          whether this is a direct address or not }
        Result := ARecipient;
      end
      else
      begin
        { use resolved address }
        Result := StrPas(lpRecip^.lpszName);
      end;

      MapiFreeBuffer(lpRecip);
    end;

  finally
    StrDispose(szRecipName);
    if flLogoff = True then Logoff;
  end;

end;


{ Check if an attachment is a valid file }
{----------------------------------------}

function TEmail.CheckAttachment(const AnAttachment: SString): SString;
begin
  if not FileExists(AnAttachment) then
    Result := ''
  else
    Result := AnAttachment;
end;

{ Clear important fields of TEmail       }
{----------------------------------------}

procedure TEmail.Clear;
begin
  FAcknowledge := false;

  FAttachment.Clear;
  FBcc.Clear;
  FCC.Clear;
  FRecip.Clear;

  FSubject := '';

  SetLongText(nil); { implicitly sets FText = '' }
end;


{ Read e-mail message with FMessageId }
{-------------------------------------}

function TEmail.ReadMail: Integer;
var
  lppMapiMessage : lpMapiMessage;
  lpRecipArray   : TlpRecipArray;
  lpAttachArray  : TlpAttachArray;

  szMessageID : PChar;
  flLogoff    : Boolean;
  MapiResult  : ULONG;
  flFLags     : ULONG;
  i           : Integer;

begin
  CheckMapi;

  { 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;
  try
    if FMessageId = '' then
    begin
      Result := MAPI_E_INVALID_MESSAGE;

      DoMapiError(Result);

      exit;
    end;

    szMessageId := StrAlloc(MsgIdSize);
    FillChar(szMessageID^, MsgIdSize, 0);

    StrPCopy(szMessageId, FMessageId);

    flFlags := 0;
    if FLeaveUnread   then flFlags := MAPI_PEEK;
    if FNOAttachments then flFlags := flFlags or MAPI_SUPPRESS_ATTACH;
    if FHeaderOnly    then flFlags := flFlags or MAPI_ENVELOPE_ONLY;

    MapiResult := MapiReadMail(hSession, 0, szMessageId, flFlags, 0, lpMapiMessage(@lppMapiMessage));
    if MapiResult <> SUCCESS_SUCCESS then
    begin
      Result := MapiResult;

      DoMapiError(Result);

      exit;
    end;

    { copy the message type }
    FMessageType := '';
    if lppMapiMessage^.lpszMessageType <> nil then
      FMessageType := StrPas(lppMapiMessage^.lpszMessageType);


    { copy recipients to CC and Recipient stringlists }

    Frecip.Clear;
    FCC.Clear;
    FBcc.Clear;
    if lppMapiMessage = nil then
    begin
      Result := 1;
      exit;
    end;
    lpRecipArray := @lppMapiMessage^.lpRecips^;

    if lpRecipArray <> nil then
    begin
      for i := 0 to (lppMapiMessage^.nRecipCount - 1) do
      begin
        case lpRecipArray^[i].ulRecipClass of

          MAPI_TO:  FRecip.Add(StrPas(lpRecipArray^[i].lpszName));

          MAPI_CC:  FCC.Add(StrPas(lpRecipArray^[i].lpszName));

          MAPI_BCC: FBcc.Add(StrPas(lpRecipArray^[i].lpszName));

        end;
      end;
    end;

    { copy attachments to attchment stringlist                          }
    { Roman Popov suggests using lpszPathName instead of lpszFileName.  }
    { It seems that lpszFilename is not used by all MAPI implementations}
    { This is undocumented, but if attachments are requested, both the  }
    { temp pathname of the attachment and the filename part of the      }
    { original attachment pathname are returned. I give you the temp    }
    { pathname if the filename part is empty now.                       }
    { As a bonus you always get the pathname in a new read-only runtime }
    { stringlist property if NoAttachments := False.                    }
    { -- dh 03-05-97 -- }

    FAttachment.Clear;
    FAttPathNames.Clear;              { new read-only property }

    lpAttachArray := @lppMapiMessage^.lpFiles^;

    if lpAttachArray <> nil then { 2.10.0: added test for nil }
    begin
      for i := 0 to (lppMapiMessage^.nFileCount - 1) do
      begin
        if (lpAttachArray^[i].lpszFileName <> nil) then
          FAttachment.Add(StrPas(lpAttachArray^[i].lpszFileName))
        else
          FAttachment.Add(StrPas(lpAttachArray^[i].lpszPathName));

        if FNoAttachments = False then
          if lpAttachArray^[i].lpszPathName <> nil then
            FAttPathNames.Add(StrPas(lpAttachArray^[i].lpszPathName))
          else
            FAttPathNames.Add('');
      end;
    end;

    { copy subject Text }

    FSubject := '';
    if lppMapiMessage^.lpszSubject <> nil then
      FSubject := StrPas(lppMapiMessage^.lpszSubject);

    { copy message body }

    StrDispose(FpLongText); { test for nil implicit in StrDispose }
    FpLongText := nil;
    FText := '';
    if lppMapiMessage^.lpszNoteText <> nil then
    begin
      if StrLen(lppMapiMessage^.lpszNoteText) < 256 then
      begin
        FText := StrPas(lppMapiMessage^.lpszNoteText);
      end
      else
      begin
        FpLongText := StrNew(lppMapiMessage^.lpszNoteText);
      end;
    end;

    { set message status }
    (*
    if (Boolean(lppMapiMessage^.flFlags and MAPI_UNREAD) = True) then
      Funread := True
    else
      FunRead := False;
    *)
    FUnRead := (lppMapiMessage^.flFlags and MAPI_UNREAD <> 0);

    { copy message originator }
    FOriginator := StrPas(lppMapiMessage^.lpOriginator^.lpszName);

    { copy originators mail address }
    if lppMapiMessage^.lpOriginator^.lpszAddress <> nil then
      FOrigAddress := StrPas(lppMapiMessage^.lpOriginator^.lpszAddress);

    { copy message date }

    if lppMapiMessage^.lpszDateReceived <> nil then
      FDateRecvd := StrPas(lppMapiMessage^.lpszDateReceived);

    Result := SUCCESS_SUCCESS;
    MapiFreeBuffer(lppMapiMessage);
  finally
    StrDispose(szMessageId);
    { Auto logoff, if no session was active. }
    if flLogoff = True then Logoff;
  end;
end;

{ CopyAttachment :  }
{-------------------}

function TEmail.CopyAttachment(Index              : Integer;
                               const DestPathname : SString;
                               DeleteAfterCopy    : Boolean) : Integer;
const
  BUFSIZE = 32768;

type
  TBuffer = array[0..(BUFSIZE - 1)] of char;
  TBufp   = ^TBuffer;

var
  FromF, ToF : File;
  NumRead, NumWritten : Integer;
  bufp : TBufp;

{$IFDEF RESSTRING}
resourcestring
{$ELSE}
const
{$ENDIF RESSTRING}
  SIllegalAttachmentOperation = 'CopyAttachment called when NoAttachments = True !!';
  SAttachmentIndexRangeError = 'CopyAttachment : index for pathnames stringlist is out of bounds';
  SAttachmentNotFound = 'CopyAttachment : attachment not found !!';
  SAttachmentOutOfMemory = 'CopyAttachment : no memory for copy buffer';
  SAttachmentIOError = 'CopyAttachment : Input-Output error on copy operation';
begin
  { check if attachments present }
  if FNoAttachments = True then
    raise EMapiAttachmentError.Create(SIllegalAttachmentOperation);

  { is the index legal ? }
  if Index > (FAttPathNames.Count - 1) then
    raise EMapiAttachmentError.Create(SAttachmentIndexRangeError);

  { is the file there ? }
  if not FileExists(FAttPathNames.Strings[Index]) then
    raise EMapiAttachmentError.Create(SAttachmentNotFound);

  { allocate file copy buffer }
  try
    Bufp := New(TBufp);
  except
    raise EMapiAttachmentError.Create(SAttachmentOutOfMemory);
  end;

  try                          { protect buffer allocation }
    try                        { catch all I-O errors }
      AssignFile(FromF, FAttPathNames.Strings[Index]);
      AssignFile(ToF, DestPathName);

      Reset(FromF, 1);
      try                      { make sure we close inputfile }
        Rewrite(ToF, 1);
        try                    { and outputfile too }
          repeat
            BlockRead(FromF, Bufp^, BUFSIZE, NumRead);
            BlockWrite(ToF, Bufp^, NumRead, NumWritten);
          until (NumRead = 0) or (NumWritten <> NumRead);
        finally
          CloseFile(ToF);
        end;
      finally
        CloseFile(FromF);
      end;

      if DeleteAfterCopy then
        SysUtils.DeleteFile(FattPathNames.Strings[Index]);

    except
      raise EMapiAttachmentError.Create(SAttachmentIOError);
    end;

  finally
    Dispose(Bufp);
  end;

  Result := 0;
end;


{ Delete e-mail message with FMessageId }
{---------------------------------------}

function TEmail.DeleteMail: Integer;
var
  szMessageID : PChar;
  flLogoff    : Boolean;
  MapiResult  : ULONG;
  flFLags     : ULONG;

begin
  CheckMapi;

  { 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;
  try
    if FMessageId = '' then
    begin
      Result := MAPI_E_INVALID_MESSAGE;

      DoMapiError(Result);

      exit;
    end;
    szMessageId := Stralloc(MsgIdSize);
    StrPcopy(SzMessageId, FMessageId);

    flFlags := 0;
    MapiResult := MapiDeleteMail(hSession, 0, szMessageId, flFlags, 0);
    if MapiResult <> SUCCESS_SUCCESS then
    begin
      Result := MapiResult;

      DoMapiError(Result);

      exit;
    end;

    FMessageId := '';      { has become invalid }

    Result := SUCCESS_SUCCESS;

  finally
    StrDispose(szMessageID);
    { Auto logoff, if no session was active. }
    if flLogoff = True then Logoff;
  end;
end;


{ make a copy of the message body and store pointer to it in TEmail }
{-------------------------------------------------------------------}

function TEmail.SetLongText(pLongText: PChar): Integer;
begin
  { free existing text, check for nil is implicit in StrDispose }
  StrDispose(FpLongText);
  FText := '';

  { the Delphi 3.01 online documentation is wrong in