⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 《Delphi7编程100例》代码,书配资料
💻 PAS
字号:
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
          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
                        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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -