Email服务器

开发平台：
Delphi

uCheckEmail.pas：源码内容
							unit uCheckEmail;
interface
uses Classes,SysUtils,Windows,uCheckEmailThread,ExtCtrls,Forms;
const DEF_DETECT_INTERVAL=1000*60*15; //15分钟检查一次 
type
    {自动检测新邮件,仅当最小化时检测新邮件,仅启动时检测新邮件,从不检测新邮件}
  TEmailDetectOption=(edoAuto,edoAppMin,edoAppRun,edoNerverDetect);
  TAppState=(asInit,asRestore,asMin,asClose);
  PEmailDetect=^TEmailDetect;
  TEmailDetect=record
    EmailAccount:TAccount;
    EmailDetectOption:TEmailDetectOption;
  end;
 //---------------------------检查某一个邮箱----------------------------
  TCheckOneEmail=class   
  private
    FEmailDetect:TEmailDetect;
    FTimer:TTimer;
    FDetectCount:Integer; //检测了多少次
    FExpectedCount:Integer; //想要检测多少次
    FOldUIDLs:TStrings;
    FOnNewEmailArrive:TNewEmailArrive;
    FChecker:TCheckEmailThread;
    FDetecting:Boolean; //是否正在检查
    procedure SetOldUIDLs(const Value: TStrings);
    procedure ThreadOnTerminate(Sender:TObject);
  protected
    procedure  OnTimer(Sender:TObject);
  public
    constructor Create;
    destructor Destroy;override;
    procedure DetectOnce; //只检测一次
    procedure DetectRepeat;//重复检测
    procedure StopDetect;//停止检测
    property  OldUIDLs:TStrings  read FOldUIDLs write SetOldUIDLs;
    property  OnNewEmailArrive:TNewEmailArrive  read FOnNewEmailArrive write FOnNewEmailArrive;
    property  EmailDetect:TEmailDetect  read FEmailDetect write FEmailDetect;
    property  Detecting:Boolean  read FDetecting write FDetecting;
  end;
  //------------------------------------------------------------------------
  TEmailDetects=array of TEmailDetect;
  TOnEnterState=procedure (Sender:TObject;Runing:Boolean)of Object;
  TCheckEmail=class
  private
    FEmailDetects:TEmailDetects;
    FEmailCheckList:TThreadList;
    FOnNewEmailArrive:TNewEmailArrive;
    FOnEnterState:TOnEnterState;
    FOldUIDLs:TStrings;
    procedure SetOldUIDLs(const Value: TStrings);
  protected
    procedure ReadEmailDetects;
    
    procedure StopDetect;
    function FindChecker(EmailAccount:string):TCheckOneEmail;
  public
    constructor Create;
    destructor Destroy;override;
    procedure CreateChecker;
    procedure EnterState(AppState:TAppState);
    property  OldUIDLs:TStrings  read FOldUIDLs write SetOldUIDLs;
    property  OnNewEmailArrive:TNewEmailArrive  read FOnNewEmailArrive write FOnNewEmailArrive;
    property OnEnterState:TOnEnterState read FOnEnterState write FOnEnterState;
  end;
implementation
uses uCommon, uMyXml;
{ TCheckEmail }
procedure TCheckEmail.EnterState(AppState: TAppState);
var
  C:TCheckOneEmail;
  I:Integer;
  HadRun:Boolean;
begin
  HadRun:=False;
  for I:=0 to Length(FEmailDetects)-1 do
  begin
    C:=FindChecker(FEmailDetects[I].EmailAccount.EmailAccount);
    if  C=nil then Continue;
    if C.Detecting then   C.StopDetect;
    case C.EmailDetect.EmailDetectOption of //邮箱的“检查新邮件”属性
      edoAuto: //自动检查
        C.DetectRepeat;
      edoAppMin:  //窗口最小化时检查
      begin
        if AppState=asMin then
          C.DetectRepeat
        else
          C.StopDetect;
      end;
      edoAppRun:    //启动程序时检查
      begin
        if AppState=asInit then
          C.DetectOnce
        else
          C.StopDetect;
      end;
      edoNerverDetect:;  //从不检查
    else ;
    end;
    if not HadRun then HadRun:=C.Detecting;
  end;
  if Assigned(FOnEnterState) then  FOnEnterState(self,HadRun);
end;
constructor TCheckEmail.Create;
begin
  FOldUIDLs:=TStringList.Create;
  FEmailCheckList:=TThreadList.Create;
  ReadEmailDetects;
end;
destructor TCheckEmail.Destroy;
begin
  StopDetect;
  FEmailCheckList.Free;
  FOldUIDLs.Free;
  WriteLog(#$D#$A'===DetectEmails End===');
  inherited;
end;
procedure TCheckEmail.CreateChecker;
var
  I:Integer;
  checkOne:TCheckOneEmail;
begin
  WriteLog(#$D#$A'===DetectEmails Begin=====');
  for I:=0 to Length(FEmailDetects)-1 do
  begin
    checkOne:=TCheckOneEmail.Create;
    checkOne.EmailDetect:=FEmailDetects[I];
    checkOne.OnNewEmailArrive:=Self.OnNewEmailArrive; //////////
    checkOne.OldUIDLs:=Self.FOldUIDLs;
    FEmailCheckList.Add(checkOne);
  end;
end;
function TCheckEmail.FindChecker(EmailAccount: string): TCheckOneEmail;
var
  L:TList;
  I:Integer;
begin
  Result:=nil;
  L:=FEmailCheckList.LockList;
  try
    for i:=0 to L.Count-1 do
      if CompareText(TCheckOneEmail(L[I]).EmailDetect.EmailAccount.EmailAccount,EmailAccount)=0 then
      begin
        Result:=TCheckOneEmail(L[I]);
        Break;
      end;
  finally
    FEmailCheckList.UnlockList;
  end;
end;
procedure TCheckEmail.ReadEmailDetects;
var
  xml:TAppXml;
  L:TList;
  I:Integer;
begin
  xml:=TAppXml.Create;
  try
    L:=TList.Create;
    try
      xml.GetAllEmailDetectOptions(L);
      SetLength(FEmailDetects,L.Count);
      for I:=0 to L.Count-1 do
      begin
        FEmailDetects[I]:=PEmailDetect(L[I])^;
        Dispose(PEmailDetect(L[I]));
      end;
    finally
      L.Free;
    end;
  finally
    xml.Free;
  end;
end;
procedure TCheckEmail.SetOldUIDLs(const Value: TStrings);
begin
  if FOldUIDLs<>Value then
    FOldUIDLs.Assign(Value);
end;
procedure TCheckEmail.StopDetect;
var
  I:Integer;
  L:TList;
begin
  L:= FEmailCheckList.LockList;
  try
    for I:=L.Count-1 downto 0 do
      TCheckOneEmail(L[I]).Free;
  finally
    FEmailCheckList.UnlockList;
  end;
end;
{ TCheckOneEmail }
constructor TCheckOneEmail.Create;
begin
  Ftimer:=TTimer.Create(nil);
  FTimer.Enabled:=False;
  FTimer.OnTimer:=OnTimer;
  FTimer.Interval:=DEF_DETECT_INTERVAL;
  FOldUIDLs:=TStringList.Create;
  FChecker:=nil;
  FDetecting:=False;
  FDetectCount:=0;
  FExpectedCount:=0;
end;
destructor TCheckOneEmail.Destroy;
begin
  if FChecker<>nil then FChecker.Terminate;
  FOldUIDLs.Free;
  FTimer.Enabled:=False;
  FTimer.Free;
  inherited;
end;
procedure TCheckOneEmail.DetectOnce;
begin
  FExpectedCount:=1;
  FTimer.Enabled:=True;
end;
procedure TCheckOneEmail.DetectRepeat;
begin
  FExpectedCount:=-1;
  FTimer.Enabled:=True;
end;
procedure TCheckOneEmail.OnTimer(Sender: TObject);
var
  arr:TAccounts;
begin
  Detecting :=True ;
  if FChecker<>nil then FChecker.Terminate;
  SetLength(arr,1);
  arr[0]:=FEmailDetect.EmailAccount;
  FChecker:=TCheckEmailThread.Create(arr,OldUIDLs);
  FChecker.OnNewEmailArrive:=OnNewEmailArrive;
  FChecker.OnTerminate:=ThreadOnTerminate;
  FChecker.Resume;
  Inc(FDetectCount);
  if FExpectedCount=-1 then Exit;   //重复执行检查
  if FExpectedCount<=FDetectCount then FTimer.Enabled:=False; //执行次数已到
end;
procedure TCheckOneEmail.SetOldUIDLs(const Value: TStrings);
begin
  if FOldUIDLs<> Value then
    FOldUIDLs.Assign(Value);
end;
procedure TCheckOneEmail.StopDetect;
begin
  FExpectedCount:=0;
  FDetectCount:=0;
  FTimer.Enabled:=False;
  if FChecker<>nil then FChecker.Terminate;
end;
procedure TCheckOneEmail.ThreadOnTerminate(Sender: TObject);
begin
  FChecker:=nil;
  FDetecting:=False;
end;
end.

						