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

📄 idimap4server.pas

📁 Indy控件的使用源代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  10207: IdIMAP4Server.pas 
{
{   Rev 1.0    2002.11.12 10:42:10 PM  czhower
}
Unit IdIMAP4Server;

Interface
{
2002-Apr-21 - J. Berg
  -use fetch()
2000-May-18 - J. Peter Mugaas
  -Ported to Indy
2000-Jan-13 - MTL
  -Moved to new Palette Scheme (Winshoes Servers)
1999-Aug-26 - Ray Malone
  -Started unit
}

Uses
  Classes,
  IdAssignedNumbers,
  IdTCPServer;

Const
  IMAPCommands : Array [1..25] Of String =
  ({ Client Commands - Any State}
   'CAPABILITY',    {Do not Localize}
   'NOOP',    {Do not Localize}
   'LOGOUT',    {Do not Localize}
   { Client Commands - Non Authenticated State}
   'AUTHENTICATE',    {Do not Localize}
   'LOGIN',    {Do not Localize}
   { Client Commands - Authenticated State}
   'SELECT',    {Do not Localize}
   'EXAMINE',    {Do not Localize}
   'CREATE',    {Do not Localize}
   'DELETE',    {Do not Localize}
   'RENAME',    {Do not Localize}
   'SUBSCRIBE',    {Do not Localize}
   'UNSUBSCRIBE',    {Do not Localize}
   'LIST',    {Do not Localize}
   'LSUB',    {Do not Localize}
   'STATUS',    {Do not Localize}
   'APPEND',    {Do not Localize}
   { Client Commands - Selected State}
   'CHECK',    {Do not Localize}
   'CLOSE',    {Do not Localize}
   'EXPUNGE',    {Do not Localize}
   'SEARCH',    {Do not Localize}
   'FETCH',    {Do not Localize}
   'STORE',    {Do not Localize}
   'COPY',    {Do not Localize}
   'UID',    {Do not Localize}
   { Client Commands - Experimental/ Expansion}
   'X');    {Do not Localize}


Type
  TCommandEvent = procedure (Thread : TIdPeerThread; const Tag, CmdStr: String;
   var Handled: Boolean) of Object;

  TIdIMAP4Server = class ( TIdTCPServer )
  Protected
    fOnCommandCAPABILITY : TCommandEvent;
    fONCommandNOOP: TCommandEvent;
    fONCommandLOGOUT: TCommandEvent;
    fONCommandAUTHENTICATE: TCommandEvent;
    fONCommandLOGIN: TCommandEvent;
    fONCommandSELECT : TCommandEvent;
    fONCommandEXAMINE : TCommandEvent;
    fONCommandCREATE : TCommandEvent;
    fONCommandDELETE : TCommandEvent;
    fONCommandRENAME : TCommandEvent;
    fONCommandSUBSCRIBE : TCommandEvent;
    fONCommandUNSUBSCRIBE : TCommandEvent;
    fONCommandLIST : TCommandEvent;
    fONCommandLSUB : TCommandEvent;
    fONCommandSTATUS : TCommandEvent;
    fONCommandAPPEND : TCommandEvent;
    fONCommandCHECK : TCommandEvent;
    fONCommandCLOSE : TCommandEvent;
    fONCommandEXPUNGE : TCommandEvent;
    fONCommandSEARCH : TCommandEvent;
    fONCommandFETCH : TCommandEvent;
    fONCommandSTORE : TCommandEvent;
    fONCommandCOPY : TCommandEvent;
    fONCommandUID : TCommandEvent;
    fONCommandX : TCommandEvent;
    fOnCommandError : TCommandEvent;
    procedure DoCommandCAPABILITY ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    procedure DoCommandNOOP(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    procedure DoCommandLOGOUT ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandAUTHENTICATE ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandLOGIN ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandSELECT ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandEXAMINE ( Thread : TIdPeerThread; const Tag, CmdStr :String; var Handled : Boolean );
    Procedure DoCommandCREATE ( Thread : TIdPeerThread; const Tag, CmdStr :String; var Handled : Boolean );
    Procedure DoCommandDELETE ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandRENAME ( Thread : TIdPeerThread; const Tag, CmdStr :String; var Handled : Boolean);
    Procedure DoCommandSUBSCRIBE ( Thread : TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandUNSUBSCRIBE ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandLIST(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandLSUB(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandSTATUS(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandAPPEND(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandCHECK(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandCLOSE(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandEXPUNGE ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandSEARCH ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandFETCH ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandSTORE ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandCOPY ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandUID ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandX ( Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Procedure DoCommandError(Thread: TIdPeerThread; const Tag, CmdStr : String; var Handled : Boolean );
    Function DoExecute(Thread: TIdPeerThread): Boolean; override;
  public
    Constructor Create(AOwner: TComponent); Override;
  published
    Property ONCommandCAPABILITY : TCommandEvent Read fOnCommandCAPABILITY write fOnCommandCAPABILITY;
    Property ONCommandNOOP : TCommandEvent Read fONCommandNOOP write fONCommandNOOP;
    Property ONCommandLOGOUT : TCommandEvent Read fONCommandLOGOUT write fONCommandLOGOUT;
    Property ONCommandAUTHENTICATE : TCommandEvent Read fONCommandAUTHENTICATE write fONCommandAUTHENTICATE;
    Property ONCommandLOGIN : TCommandEvent Read fONCommandLOGIN write fONCommandLOGIN;
    Property ONCommandSELECT : TCommandEvent Read fONCommandSELECT write fONCommandSELECT;
    Property OnCommandEXAMINE :TCommandEvent Read fOnCommandEXAMINE write fOnCommandEXAMINE;
    property ONCommandCREATE  :  TCommandEvent Read fONCommandCREATE write fONCommandCREATE;
    property ONCommandDELETE  :  TCommandEvent Read fONCommandDELETE write fONCommandDELETE;
    property OnCommandRENAME : TCommandEvent Read fOnCommandRENAME write fOnCommandRENAME;
    property ONCommandSUBSCRIBE  :  TCommandEvent read fONCommandSUBSCRIBE write fONCommandSUBSCRIBE;
    property ONCommandUNSUBSCRIBE  :  TCommandEvent read fONCommandUNSUBSCRIBE write fONCommandUNSUBSCRIBE;
    property ONCommandLIST  :  TCommandEvent read fONCommandLIST write fONCommandLIST;
    property OnCommandLSUB : TCommandEvent read fOnCommandLSUB write fOnCommandLSUB;
    property ONCommandSTATUS  :  TCommandEvent read fONCommandSTATUS write fONCommandSTATUS;
    property OnCommandAPPEND : TCommandEvent read fOnCommandAPPEND write fOnCommandAPPEND;
    property ONCommandCHECK  :  TCommandEvent read fONCommandCHECK write fONCommandCHECK;
    property OnCommandCLOSE : TCommandEvent read fOnCommandCLOSE write fOnCommandCLOSE;
    property ONCommandEXPUNGE  :  TCommandEvent read fONCommandEXPUNGE write fONCommandEXPUNGE;
    property OnCommandSEARCH : TCommandEvent read fOnCommandSEARCH write fOnCommandSEARCH;
    property ONCommandFETCH  :  TCommandEvent read fONCommandFETCH write fONCommandFETCH;
    property OnCommandSTORE : TCommandEvent read fOnCommandSTORE write fOnCommandSTORE;
    property OnCommandCOPY : TCommandEvent read fOnCommandCOPY write fOnCommandCOPY;
    property ONCommandUID  :  TCommandEvent read fONCommandUID write fONCommandUID;
    property OnCommandX : TCommandEvent read fOnCommandX write fOnCommandX;
    property OnCommandError : TCommandEvent read fOnCommandError write fOnCommandError;
  end;

Implementation

Uses
  IdGlobal,
  SysUtils;

//--------------------Start of  TIdIMAP4Server Code ---------------------
//                     Started August 26, 1999
//------------------------------------------------------------------------------
Const
   cCAPABILITY   =  1;
   cNOOP         =  2;
   cLOGOUT       =  3;
   cAUTHENTICATE =  4;
   cLOGIN        =  5;
   cSELECT       =  6;
   cEXAMINE      =  7;
   cCREATE       =  8;
   cDELETE       =  9;
   cRENAME       = 10;
   cSUBSCRIBE    = 11;
   cUNSUBSCRIBE  = 12;
   cLIST         = 13;
   cLSUB         = 14;
   cSTATUS       = 15;
   cAPPEND       = 16;
   cCHECK        = 17;
   cCLOSE        = 18;
   cEXPUNGE      = 19;
   cSEARCH       = 20;
   cFETCH        = 21;
   cSTORE        = 22;
   cCOPY         = 23;
   cUID          = 24;
   cXCmd         = 25;

constructor TIdIMAP4Server.Create(AOwner: TComponent);
begin
  Inherited;
  DefaultPort := IdPORT_IMAP4;
end;

function TIdIMAP4Server.DoExecute(Thread: TIdPeerThread): Boolean;
var
  RcvdStr,
  ArgStr,
  sTag,
  sCmd : String;
  cmdNum : Integer;
  Handled : Boolean;

begin
  result := true;
  while Thread.Connection.Connected Do
  begin
    Handled := False;
    RcvdStr := Thread.Connection.ReadLn;
    ArgStr := RcvdStr;
    sTag := UpperCase ( Fetch ( ArgStr, CHAR32 ) );
    sCmd := UpperCase ( Fetch ( ArgStr, CHAR32 ) );
    CmdNum := Succ ( PosInStrArray ( Uppercase ( sCmd ), IMAPCommands ) );
    case CmdNum Of
      cCAPABILITY   : DoCommandCAPABILITY ( Thread, sTag, ArgStr, Handled );
      cNOOP         : DoCommandNOOP ( Thread, sTag, ArgStr, Handled );
      cLOGOUT       : DoCommandLOGOUT ( Thread, sTag, ArgStr, Handled );
      cAUTHENTICATE : DoCommandAUTHENTICATE ( Thread, sTag, ArgStr, Handled );
      cLOGIN        : DoCommandLOGIN ( Thread, sTag, ArgStr, Handled );
      cSELECT       : DoCommandSELECT ( Thread, sTag, ArgStr, Handled );
      cEXAMINE      : DoCommandEXAMINE ( Thread, sTag, ArgStr, Handled );
      cCREATE       : DoCommandCREATE ( Thread, sTag, ArgStr, Handled );
      cDELETE       : DoCommandDELETE ( Thread, sTag, ArgStr, Handled );
      cRENAME       : DoCommandRENAME ( Thread, sTag, ArgStr, Handled );
      cSUBSCRIBE    : DoCommandSUBSCRIBE ( Thread, sTag, ArgStr, Handled );
      cUNSUBSCRIBE  : DoCommandUNSUBSCRIBE ( Thread, sTag, ArgStr, Handled );
      cLIST         : DoCommandLIST ( Thread, sTag, ArgStr, Handled );
      cLSUB         : DoCommandLSUB ( Thread, sTag, ArgStr, Handled );
      cSTATUS       : DoCommandSTATUS ( Thread, sTag, ArgStr, Handled );
      cAPPEND       : DoCommandAPPEND ( Thread, sTag, ArgStr, Handled );
      cCHECK        : DoCommandCHECK ( Thread, sTag, ArgStr, Handled );
      cCLOSE        : DoCommandCLOSE ( Thread, sTag, ArgStr, Handled );
      cEXPUNGE      : DoCommandEXPUNGE ( Thread, sTag, ArgStr, Handled);
      cSEARCH       : DoCommandSEARCH ( Thread, sTag, ArgStr, Handled );
      cFETCH        : DoCommandFETCH ( Thread, sTag, ArgStr, Handled );
      cSTORE        : DoCommandSTORE ( Thread, sTag, ArgStr, Handled );
      cCOPY         : DoCommandCOPY ( Thread, sTag, ArgStr, Handled );
      cUID          : DoCommandUID ( Thread, sTag, ArgStr, Handled );
    else
      begin
        if ( Length ( SCmd ) > 0 ) and ( UpCase ( SCmd[1] ) = 'X' ) then    {Do not Localize}
        begin
          DoCommandX ( Thread, sTag, ArgStr, Handled );
        end //if ( Length ( SCmd ) > 0) and ( UpCase ( SCmd[1] ) = 'X' ) then    {Do not Localize}
        else

⌨️ 快捷键说明

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