unit1.~pas

来自「《Delphi实用程序100例》配套书源码盘」· ~PAS 代码 · 共 183 行

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, Buttons ,Mapi;

type
  TForm1 = class(TForm)
    lblProfile: TLabel;
    lblProfilePassword: TLabel;
    txtProfile: TEdit;
    txtPPassword: TEdit;
    btnUnread: TBitBtn;
    btnReadNext: TBitBtn;
    txtFrom: TEdit;
    txtTo: TEdit;
    txtSubject: TEdit;
    moBody: TMemo;
    statMAPI: TStatusBar;
    lblSubject: TLabel;
    lblTo: TLabel;
    lblFrom: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnUnreadClick(Sender: TObject);
    procedure btnReadNextClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
   Form1: TForm1;
   GlobalUnreadCount: integer;
   hSession: ULONG;
   szMessageID: PChar;
   szSeedMessageID: PChar;
   flFlags: ULONG;
   lppMapiMessage: PMapiMessage;

const
  MsgIDSize = 520; { max allow - I guess }
  RECIP_MAX = MaxInt div SizeOf(TMapiRecipDesc);

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
     szMessageId := StrAlloc(MsgIdSize);
     szSeedMessageID := StrAlloc(MsgIDSize);
     FillChar(szMessageID^, MsgIdSize, 0);
     FillChar(szSeedMessageID^, MsgIDSize, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
     StrDispose(szMessageID);
     StrDispose(szSeedMessageID);
end;

procedure TForm1.btnUnreadClick(Sender: TObject);
var
   hSession        : ULONG;
   szMessageID     : PChar;
   szSeedMessageID : PChar;
   flFlags         : ULONG;
   Count           : ULONG;
begin
     { With Windows Messaging, I found that if you got the wrong
       Profile name, it will use the Windows default. My profile
       below did not have a password so I left it blank. }
     if MAPILogon(0,PChar(txtProfile.Text),PChar(txtPPassword.Text),0,0,@hSession) = SUCCESS_SUCCESS then
     begin
          Count := 0;
          statMAPI.SimpleText := '';
          { if successful login then allocate message id's }
          szMessageID := StrAlloc(MsgIDSize); { MAPI 32bit !! }
          szSeedMessageID := StrAlloc(MsgIDSize); { MAPI 32bit !! }
          FillChar(szMessageID^, MsgIDSize, 0);
          FillChar(szSeedMessageID^, MsgIDSize, 0);
          flFlags := MAPI_UNREAD_ONLY;

          inc(flFlags, MAPI_LONG_MSGID);
          { counting unread messages }
          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;
          GlobalUnreadCount := Count;
          if Count > 0 then
             btnReadNext.Enabled := True;
          statMAPI.SimpleText := IntToStr(Count)+' 新邮件';
          StrDispose(szMessageID);
          StrDispose(szSeedMessageID);
          MAPILogoff(hSession,0,0,0);
     end;
end;

procedure TForm1.btnReadNextClick(Sender: TObject);
const
   tmpStr: PChar = ':';
var
   AnyStr: PChar;
begin
     if GlobalUnreadCount = 0 then exit;
     if MAPILogon(0,PChar(txtProfile.Text),PChar(txtPPassword.Text),0,0,@hSession) = SUCCESS_SUCCESS then
     begin
          { the following code is used to control what you want to see
            Danny lets you control by 1. having the ability to look at
            the message without marking it as read, 2. do/don't look at
            the attachment, and 3. Header only
          if FLeaveUnread   then flFlags := MAPI_PEEK;
          if FNOAttachments then flFlags := flFlags or MAPI_SUPPRESS_ATTACH;
          if FHeaderOnly    then flFlags := flFlags or MAPI_ENVELOPE_ONLY;
          }
          { I just want to read the mail for now and you can play around
            with attachment later }
          flFlags := MAPI_PEEK;
          if MapiFindNext( hSession, 0, nil, szSeedMessageID,
                        flFlags, 0, @szMessageID^) = SUCCESS_SUCCESS then
          begin
               { this is so you don't read the unread message again }
               if StrComp(szSeedMessageId, szMessageId) <> 0 then
               begin
                   StrCopy(szSeedMessageId,szMessageId);
                   if MapiReadMail(hSession, 0, szMessageId, flFlags,
                                   0, lppMapiMessage) <> SUCCESS_SUCCESS then
                   begin
                      MAPILogoff(hSession,0,0,0);
                      Exit;
                   end
                   else
                   begin
                        { this does not list MAPI_CC, MAPI_BCC, or other things
                          in the header. Experiment with those yourself...}

                        { filtering out the "SMTP:" in the header
                          i.e. SMTP:[e-mail] }
                        if lppMapiMessage.lpOriginator.ulRecipClass = MAPI_ORIG then
                        begin
                           if lppMapiMessage.lpOriginator.lpszAddress <> '' then
                           begin
                                txtFrom.Text :=lppMapiMessage.lpOriginator.lpszAddress;
                                AnyStr := StrPos(PChar(txtFrom.Text),tmpStr);
                                if AnyStr <> nil then
                                   Inc(AnyStr);
                                txtFrom.Text := lppMapiMessage.lpOriginator.lpszName+'<'+AnyStr+'>';
                           end;
                        end;
                        if lppMapiMessage.lpRecips.ulRecipClass = MAPI_TO then
                        begin
                           if lppMapiMessage.lpRecips.lpszAddress <> '' then
                           begin
                                txtTo.Text := lppMapiMessage.lpRecips.lpszAddress;
                                AnyStr := StrPos(PChar(txtTo.Text),tmpStr);
                                if AnyStr <> nil then
                                   Inc(AnyStr);
                                txtTo.Text := AnyStr;
                           end;
                        end;
                        txtSubject.Text := lppMapiMessage.lpszSubject;
                        moBody.Lines.Text := lppMapiMessage.lpszNoteText;
                        Dec(GlobalUnreadCount);
                        statMAPI.SimpleText := IntToStr(GlobalUnreadCount)+' 新邮件';
                   end;
               end;
          end;
          MAPILogoff(hSession,0,0,0);
     end;
end;

end.