dxmessagebaseservercore.pas

Well known and usefull component for delphi 7

unit DXMessageBaseServerCore;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXMessageBaseServerCore
//       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: *Example* Of how to build a centralized MessageBase Server
// ========================================================================
// MessageBase Listener, Top Layer descendant of DXserverCore, modified to
// support different message base formats for our server components. You can
// use it as it stands and support NNTP, SMTP, POP3, IMAP4 etc. Or you can
// add your own hooks to expand to also support proprietary messaging systems!
///////////////////////////////////////////////////////////////////////////////

uses
  Classes,
  DXServerCore;

{$I DXSock.def}

Type
  MessageBaseTBasicEvent = procedure(ClientThread:TDXClientThread;Parm1:string) of object;
  MessageBaseTRangeEvent = procedure(ClientThread:TDXClientThread;First,Last:string) of object;
  MessageBaseTSimpleEvent = procedure(ClientThread:TDXClientThread) of object;
  MessageBaseTOtherEvent = procedure(ClientThread:TDXClientThread;Command,Parms:String;var Handled:Boolean) of object;

  TDXMessageBaseServerCore = class(TDXServerCore)
  private
    fOnCommandLOGIN:MessageBaseTBasicEvent;       // LOGIN ACCOUNT PASSWORD}
    fOnCommandFORMAT:MessageBaseTBasicEvent;      // FORMAT [NNTP|EMAIL]}
    fOnCommandMESSAGES:MessageBaseTSimpleEvent;   // MESSAGES}
    fOnCommandGETMSG:MessageBaseTBasicEvent;      // GETMSG NUMBER}
    fOnCommandDELMSG:MessageBaseTBasicEvent;      // DELMSG NUMBER}
    fOnCommandADDMSG:MessageBaseTSimpleEvent;     // ADDMSG}
    fOnCommandMSGHDRS:MessageBaseTRangeEvent;     // MSGHDRS LONUMBER HINUMBER}
    fOnCommandMSGBODY:MessageBaseTBasicEvent;     // MSGBODY NUMBER}
    fOnCommandEDITMSG:MessageBaseTBasicEvent;     // EDITMSG NUMBER}
    fOnCommandRESCAN:MessageBaseTSimpleEvent;     // RESCAN}
    fOnCommandAREAS:MessageBaseTSimpleEvent;      // AREAS}
    fOnCommandNEWAREA:MessageBaseTBasicEvent;     // NEWAREA FULLFOLDERNAME}
    fOnCommandDELAREA:MessageBaseTBasicEvent;     // DELAREA FULLFOLDERNAME}
    fOnCommandGETAREA:MessageBaseTBasicEvent;     // GETAREA FULLFOLDERNAME}
    fOnCommandHELP:MessageBaseTSimpleEvent;       // HELP}
    fOnCommandOther:MessageBaseTOtherEvent;
    fEventArray:TList;
    fbForceAbort:Boolean;
  protected
    Procedure SetOnCommandLOGIN(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandFORMAT(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandMESSAGES(value:MessageBaseTSimpleEvent);
    Procedure SetOnCommandGETMSG(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandDELMSG(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandADDMSG(value:MessageBaseTSimpleEvent);
    Procedure SetOnCommandMSGHDRS(value:MessageBaseTRangeEvent);
    Procedure SetOnCommandMSGBODY(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandEDITMSG(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandRESCAN(value:MessageBaseTSimpleEvent);
    Procedure SetOnCommandAREAS(value:MessageBaseTSimpleEvent);
    Procedure SetOnCommandNEWAREA(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandDELAREA(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandGETAREA(value:MessageBaseTBasicEvent);
    Procedure SetOnCommandHELP(value:MessageBaseTSimpleEvent);
  public
{$IFDEF OBJECTS_ONLY}
    constructor Create;
{$ELSE}
    constructor Create(AOwner:TComponent); override;
{$ENDIF}
    destructor Destroy; override;
    procedure ProcessSession(ClientThread:TDXClientThread);
    Procedure AddBasicEvent(Command:String;EventProc:MessageBaseTBasicEvent);
    Procedure AddSimpleEvent(Command:String;EventProc:MessageBaseTSimpleEvent);
    Procedure AddRangeEvent(Command:String;EventProc:MessageBaseTRangeEvent);
    Procedure ForceAbort;
  published
    property OnCommandLOGIN: MessageBaseTBasicEvent read fOnCommandLOGIN
                                                  write SetOnCommandLOGIN;
    property OnCommandFORMAT: MessageBaseTBasicEvent read fOnCommandFORMAT
                                                  write SetOnCommandFORMAT;
    property OnCommandMESSAGES: MessageBaseTSimpleEvent read fOnCommandMESSAGES
                                                  write SetOnCommandMESSAGES;
    property OnCommandGETMSG: MessageBaseTBasicEvent read fOnCommandGETMSG
                                                  write SetOnCommandGETMSG;
    property OnCommandDELMSG: MessageBaseTBasicEvent read fOnCommandDELMSG
                                                  write SetOnCommandDELMSG;
    property OnCommandADDMSG: MessageBaseTSimpleEvent read fOnCommandADDMSG
                                                  write SetOnCommandADDMSG;
    property OnCommandMSGHDRS: MessageBaseTRangeEvent read fOnCommandMSGHDRS
                                                  write SetOnCommandMSGHDRS;
    property OnCommandMSGBODY: MessageBaseTBasicEvent read fOnCommandMSGBODY
                                                  write SetOnCommandMSGBODY;
    property OnCommandEDITMSG: MessageBaseTBasicEvent read fOnCommandEDITMSG
                                                  write SetOnCommandEDITMSG;
    property OnCommandRESCAN: MessageBaseTSimpleEvent read fOnCommandRESCAN
                                                  write SetOnCommandRESCAN;
    property OnCommandAREAS: MessageBaseTSimpleEvent read fOnCommandAREAS
                                                  write SetOnCommandAREAS;
    property OnCommandNEWAREA: MessageBaseTBasicEvent read fOnCommandNEWAREA
                                                  write SetOnCommandNEWAREA;
    property OnCommandDELAREA: MessageBaseTBasicEvent read fOnCommandDELAREA
                                                  write SetOnCommandDELAREA;
    property OnCommandGETAREA: MessageBaseTBasicEvent read fOnCommandGETAREA
                                                  write SetOnCommandGETAREA;
    property OnCommandHELP: MessageBaseTSimpleEvent read fOnCommandHELP
                                                  write SetOnCommandHELP;
    property OnCommandOther: MessageBaseTOtherEvent read fOnCommandOther
                                         write fOnCommandOther;
  end;

implementation

Uses
   DXSock,
   DXString;

Type
  PMessageBaseBasicEvent=^TMessageBaseBasicEvent;
  TMessageBaseBasicEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:MessageBaseTBasicEvent;
  End;
  PMessageBaseSimpleEvent=^TMessageBaseSimpleEvent;
  TMessageBaseSimpleEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:MessageBaseTSimpleEvent;
  End;
  PMessageBaseRangeEvent=^TMessageBaseRangeEvent;
  TMessageBaseRangeEvent=record
     Tag:Integer;
     Command:String;
     EventProcedure:MessageBaseTRangeEvent;
  End;

///////////////////////////////////////////////////////////////////////////////
// COMMANDS INTERNAL TO THE SYSTEM
//   LOGIN    {server to server login - checks deny list}
//   FORMAT   {selects the messagebase format to use}
//   MESSAGES {number of messages available}
//   GETMSG   {download message number}
//   DELMSG   {delete message number}
//   ADDMSG   {upload message}
//   MSGHDRS  {returns a range of message headers - based upon FORMAT command}
//   MSGBODY  {returns a selected message body}
//   EDITMSG  {expects a message body to replace an existing msgbody}
//   RESCAN   {report changes from other threads/sessions}
//   AREAS    {report folders available - based upon FORMAT command}
//   NEWAREA  {creates a new folder if allowed}
//   DELAREA  {deletes a folder if allowed}
//   GETAREA  {selects a folder to access - if allowed}
//   HELP     {sends a list of "events/keywords" from fEventArray}
//
//   TRANSACTION MARKERS FOR COMMUNICATIONS:
//   200         {sucessful command - server is read/write mode}
//   201         {sucessful command - server is readonly}
//   202         {NEXT PARAMETER IS AN INTERGER (can have multple integers)}
//   205 <bytes> {server sending 'x bytes' to client}
//   206 <lines> {server sending 'x lines' to client}
//   500         {command failed - with a reason message}
///////////////////////////////////////////////////////////////////////////////

///////////////////////////////////////////////////////////////////////////////
//CREATE:
//       Define the Default Port number to Listen On.
///////////////////////////////////////////////////////////////////////////////
{$IFDEF OBJECTS_ONLY}
constructor TDXMessageBaseServerCore.Create;
{$ELSE}
constructor TDXMessageBaseServerCore.Create(AOwner:TComponent);
{$ENDIF}
begin
{$IFDEF OBJECTS_ONLY}
{$ELSE}
   inherited Create(AOwner);
{$ENDIF}
   ServerPort:=9001;
end;

///////////////////////////////////////////////////////////////////////////////
//DESTROY:
//        Destory this object.
///////////////////////////////////////////////////////////////////////////////
destructor TDXMessageBaseServerCore.Destroy;
Var
   PBasicEvent:PMessageBaseBasicEvent;
   PSimpleEvent:PMessageBaseSimpleEvent;
   PRangeEvent:PMessageBaseRangeEvent;

begin
   If Assigned(fEventArray) then Begin
      While fEventArray.Count>0 do Begin
         Case PMessageBaseBasicEvent(fEventArray[0]).Tag of
            1:Begin
              PBasicEvent:=fEventArray[0];
              Dispose(PBasicEvent);
            End;
            2:Begin
              PSimpleEvent:=fEventArray[0];
              Dispose(PSimpleEvent);
            End;
            3:Begin
              PRangeEvent:=fEventArray[0];
              Dispose(PRangeEvent);
            End;