dximap4servercore.pas

Well known and usefull component for delphi 7

unit DXIMAP4ServerCore;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXIMAP4ServerCore
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2003
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2003
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (4th Generation Code)
// ========================================================================
//  Description: implements IMAP4 Email Protocol
// ========================================================================
///////////////////////////////////////////////////////////////////////////////

uses
  Classes,
  DXServerCore;

{$I DXSock.def}

type
  IMAPTSimpleEvent = procedure(ClientThread: TDXClientThread; Tag: string) of object;
  IMAPTBasicEvent = procedure(ClientThread: TDXClientThread; Tag: string; Parm: string) of object;
  IMAPTComplexEvent = procedure(ClientThread: TDXClientThread; Tag: string; Parm1, Parm2: string) of object;
  IMAPTOtherEvent = procedure(ClientThread: TDXClientThread; Tag: string; Command: string; Parm: string;Var Handled: Boolean) of object;

  TDXIMAP4ServerCore = class(TDXServerCore)
  private
    fOnCommandCAPABILITY: IMAPTSimpleEvent;
    fOnCommandNOOP: IMAPTSimpleEvent;
    fOnCommandLOGOUT: IMAPTSimpleEvent;
    fOnCommandAUTHENTICATE: IMAPTBasicEvent;
    fOnCommandLOGIN: IMAPTComplexEvent;
    fOnCommandSELECT: IMAPTBasicEvent;
    fOnCommandEXAMINE: IMAPTBasicEvent;
    fOnCommandCREATE: IMAPTBasicEvent;
    fOnCommandDELETE: IMAPTBasicEvent;
    fOnCommandRENAME: IMAPTComplexEvent;
    fOnCommandSUBSCRIBE: IMAPTBasicEvent;
    fOnCommandUNSUBSCRIBE: IMAPTBasicEvent;
    fOnCommandLIST: IMAPTComplexEvent;
    fOnCommandLSUB: IMAPTComplexEvent;
    fOnCommandSTATUS: IMAPTComplexEvent;
    fOnCommandAPPEND: IMAPTComplexEvent;
    fOnCommandCHECK: IMAPTSimpleEvent;
    fOnCommandCLOSE: IMAPTSimpleEvent;
    fOnCommandEXPUNGE: IMAPTSimpleEvent;
    fOnCommandSEARCH: IMAPTComplexEvent;
    fOnCommandFETCH: IMAPTComplexEvent;
    fOnCommandSTORE: IMAPTComplexEvent;
    fOnCommandCOPY: IMAPTComplexEvent;
    fOnCommandUID: IMAPTComplexEvent;
    fOnCommandOther: IMAPTOtherEvent;
  protected
    Procedure SetOnCommandCAPABILITY(value: IMAPTSimpleEvent);
    Procedure SetOnCommandNOOP(value: IMAPTSimpleEvent);
    Procedure SetOnCommandLOGOUT(value: IMAPTSimpleEvent);
    Procedure SetOnCommandAUTHENTICATE(value: IMAPTBasicEvent);
    Procedure SetOnCommandLOGIN(value: IMAPTComplexEvent);
    Procedure SetOnCommandSELECT(value: IMAPTBasicEvent);
    Procedure SetOnCommandEXAMINE(value: IMAPTBasicEvent);
    Procedure SetOnCommandCREATE(value: IMAPTBasicEvent);
    Procedure SetOnCommandDELETE(value: IMAPTBasicEvent);
    Procedure SetOnCommandRENAME(value: IMAPTComplexEvent);
    Procedure SetOnCommandSUBSCRIBE(value: IMAPTBasicEvent);
    Procedure SetOnCommandUNSUBSCRIBE(value: IMAPTBasicEvent);
    Procedure SetOnCommandLIST(value: IMAPTComplexEvent);
    Procedure SetOnCommandLSUB(value: IMAPTComplexEvent);
    Procedure SetOnCommandSTATUS(value: IMAPTComplexEvent);
    Procedure SetOnCommandAPPEND(value: IMAPTComplexEvent);
    Procedure SetOnCommandCHECK(value: IMAPTSimpleEvent);
    Procedure SetOnCommandCLOSE(value: IMAPTSimpleEvent);
    Procedure SetOnCommandEXPUNGE(value: IMAPTSimpleEvent);
    Procedure SetOnCommandSEARCH(value: IMAPTComplexEvent);
    Procedure SetOnCommandFETCH(value: IMAPTComplexEvent);
    Procedure SetOnCommandSTORE(value: IMAPTComplexEvent);
    Procedure SetOnCommandCOPY(value: IMAPTComplexEvent);
    Procedure SetOnCommandUID(value: IMAPTComplexEvent);
  public
    constructor Create(AOwner:TComponent); {$IFNDEF OBJECTS_ONLY} override; {$ENDIF}
    destructor Destroy; override;
    procedure SayHello(ClientThread:TDXClientThread;Header:String);
    procedure SayGoodbye(ClientThread:TDXClientThread;Footer:String);
    procedure ProcessSession(ClientThread: TDXClientThread);
    Procedure AddSimpleEvent(Command:String;EventProc:IMAPTSimpleEvent);
    Procedure AddBasicEvent(Command:String;EventProc:IMAPTBasicEvent);
    Procedure AddComplexEvent(Command:String;EventProc:IMAPTComplexEvent);
  published
    property OnCommandCAPABILITY: IMAPTSimpleEvent read fOnCommandCAPABILITY
                                                   write SetOnCommandCAPABILITY;
    property OnCommandNOOP: IMAPTSimpleEvent read fOnCommandNOOP
                                             write SetOnCommandNOOP;
    property OnCommandLOGOUT: IMAPTSimpleEvent read fOnCommandLOGOUT
                                               write SetOnCommandLOGOUT;
    property OnCommandAUTHENTICATE: IMAPTBasicEvent read fOnCommandAUTHENTICATE
                                                    write SetOnCommandAUTHENTICATE;
    property OnCommandLOGIN: IMAPTComplexEvent read fOnCommandLOGIN
                                               write SetOnCommandLOGIN;
    property OnCommandSELECT: IMAPTBasicEvent read fOnCommandSELECT
                                              write SetOnCommandSELECT;
    property OnCommandEXAMINE: IMAPTBasicEvent read fOnCommandEXAMINE
                                               write SetOnCommandEXAMINE;
    property OnCommandCREATE: IMAPTBasicEvent read fOnCommandCREATE
                                              write SetOnCommandCREATE;
    property OnCommandDELETE: IMAPTBasicEvent read fOnCommandDELETE
                                              write SetOnCommandDELETE;
    property OnCommandRENAME: IMAPTComplexEvent read fOnCommandRENAME
                                                write SetOnCommandRENAME;
    property OnCommandSUBSCRIBE: IMAPTBasicEvent read fOnCommandSUBSCRIBE
                                                 write SetOnCommandSUBSCRIBE;
    property OnCommandUNSUBSCRIBE: IMAPTBasicEvent read fOnCommandUNSUBSCRIBE
                                                   write SetOnCommandUNSUBSCRIBE;
    property OnCommandLIST: IMAPTComplexEvent read fOnCommandLIST
                                              write SetOnCommandLIST;
    property OnCommandLSUB: IMAPTComplexEvent read fOnCommandLSUB
                                              write SetOnCommandLSUB;
    property OnCommandSTATUS: IMAPTComplexEvent read fOnCommandSTATUS
                                                write SetOnCommandSTATUS;
    property OnCommandAPPEND: IMAPTComplexEvent read fOnCommandAPPEND
                                                write SetOnCommandAPPEND;
    property OnCommandCHECK: IMAPTSimpleEvent read fOnCommandCHECK
                                              write SetOnCommandCHECK;
    property OnCommandCLOSE: IMAPTSimpleEvent read fOnCommandCLOSE
                                              write SetOnCommandCLOSE;
    property OnCommandEXPUNGE: IMAPTSimpleEvent read fOnCommandEXPUNGE
                                                write SetOnCommandEXPUNGE;
    property OnCommandSEARCH: IMAPTComplexEvent read fOnCommandSEARCH
                                                write SetOnCommandSEARCH;
    property OnCommandFETCH: IMAPTComplexEvent read fOnCommandFETCH
                                               write SetOnCommandFETCH;
    property OnCommandSTORE: IMAPTComplexEvent read fOnCommandSTORE
                                               write SetOnCommandSTORE;
    property OnCommandCOPY: IMAPTComplexEvent read fOnCommandCOPY
                                              write SetOnCommandCOPY;
    property OnCommandUID: IMAPTComplexEvent read fOnCommandUID
                                             write SetOnCommandUID;
    property OnCommandOther: IMAPTOtherEvent read fOnCommandOther
                                             write fOnCommandOther;
  end;

implementation

Uses
   DXSock,
   DXString;

Type
  PIMAPBasicEvent=^TIMAPBasicEvent;
  TIMAPBasicEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:IMAPTBasicEvent;
  End;
  PIMAPSimpleEvent=^TIMAPSimpleEvent;
  TIMAPSimpleEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:IMAPTSimpleEvent;
  End;
  PIMAPComplexEvent=^TIMAPComplexEvent;
  TIMAPComplexEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:IMAPTComplexEvent;
  End;

///////////////////////////////////////////////////////////////////////////////
//   {Any state}
//   'CAPABILITY',                   {1}
//   'NOOP',                         {2}
//   'LOGOUT',                       {3}
//   {Non-authenticated state}
//   'AUTHENTICATE',                 {4}
//   'LOGIN',                        {5}
//   {Authenticated state}
//   'SELECT',                       {6}
//   'EXAMINE',                      {7}
//   'CREATE',                       {8}
//   'DELETE',                       {9}
//   'RENAME',                       {10}
//   'SUBSCRIBE',                    {11}
//   'UNSUBSCRIBE',                  {12}
//   'LIST',                         {13}
//   'LSUB',                         {14}
//   'STATUS',                       {15}
//   'APPEND',                       {16}
//   {Selected state}
//   'CHECK',                        {17}
//   'CLOSE',                        {18}
//   'EXPUNGE',                      {19}
//   'SEARCH',                       {20}
//   'FETCH',                        {21}
//   'STORE',                        {22}
//   'COPY',                         {23}
//   'UID'                           {24}
///////////////////////////////////////////////////////////////////////////////

constructor TDXIMAP4ServerCore.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   ServerPort:=143;
end;

destructor TDXIMAP4ServerCore.Destroy;
Var
   PBasicEvent:PIMAPBasicEvent;
   PSimpleEvent:PIMAPSimpleEvent;
   PComplexEvent:PIMAPComplexEvent;
begin
   If Assigned(fEventArray) then Begin
      While fEventArray.Count>0 do Begin
         Case PIMAPBasicEvent(fEventArray[0]).Tag of
            1:Begin
              PBasicEvent:=fEventArray[0];
              Dispose(PBasicEvent);
            End;
            2:Begin
              PSimpleEvent:=fEventArray[0];
              Dispose(PSimpleEvent);
            End;
            3:Begin
              PComplexEvent:=fEventArray[0];
              Dispose(PComplexEvent);
            End;
         End;
         fEventArray.Delete(0);
      End;
   End;
   inherited Destroy;
end;

Procedure TDXIMAP4ServerCore.AddBasicEvent(Command:String;EventProc:IMAPTBasicEvent);
Var
   PBasicEvent:PIMAPBasicEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PIMAPBasicEvent(fEventArray[Loop]).Command=Command then Begin
         PIMAPBasicEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;