dximap4servercore.pas

Well known and usefull component for delphi 7

   New(PBasicEvent);
   PBasicEvent.Tag:=1;      // Denotes Event in fEventArray is a TBasicEvent!
   PBasicEvent.Command:=Command;
   PBasicEvent.EventProcedure:=EventProc;
   fEventArray.Add(PBasicEvent);
End;

Procedure TDXIMAP4ServerCore.AddSimpleEvent(Command:String;EventProc:IMAPTSimpleEvent);
Var
   PSimpleEvent:PIMAPSimpleEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PIMAPSimpleEvent(fEventArray[Loop]).Command=Command then Begin
         PIMAPSimpleEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PSimpleEvent);
   PSimpleEvent.Tag:=2;      // Denotes Event in fEventArray is a TSimpleEvent!
   PSimpleEvent.Command:=Command;
   PSimpleEvent.EventProcedure:=EventProc;
   fEventArray.Add(PSimpleEvent);
End;

Procedure TDXIMAP4ServerCore.AddComplexEvent(Command:String;EventProc:IMAPTComplexEvent);
Var
   PComplexEvent:PIMAPComplexEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PIMAPComplexEvent(fEventArray[Loop]).Command=Command then Begin
         PIMAPComplexEvent(fEventArray[Loop]).EventProcedure:=EventProc;
         Exit;
      End
      Else Inc(Loop);
   End;
   New(PComplexEvent);
   PComplexEvent.Tag:=3;      // Denotes Event in fEventArray is a TComplexEvent!
   PComplexEvent.Command:=Command;
   PComplexEvent.EventProcedure:=EventProc;
   fEventArray.Add(PComplexEvent);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandCAPABILITY(value: IMAPTSimpleEvent);
Begin
   fOnCommandCAPABILITY:=Value;
   AddSimpleEvent('CAPABILITY',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandNOOP(value: IMAPTSimpleEvent);
Begin
   fOnCommandNOOP:=Value;
   AddSimpleEvent('NOOP',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandLOGOUT(value: IMAPTSimpleEvent);
Begin
   fOnCommandLOGOUT:=Value;
   AddSimpleEvent('LOGOUT',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandAUTHENTICATE(value: IMAPTBasicEvent);
Begin
   fOnCommandAUTHENTICATE:=Value;
   AddBasicEvent('AUTHENTICATE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandLOGIN(value: IMAPTComplexEvent);
Begin
   fOnCommandLOGIN:=Value;
   AddComplexEvent('LOGIN',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandSELECT(value: IMAPTBasicEvent);
Begin
   fOnCommandSELECT:=Value;
   AddBasicEvent('SELECT',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandEXAMINE(value: IMAPTBasicEvent);
Begin
   fOnCommandEXAMINE:=Value;
   AddBasicEvent('EXAMINE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandCREATE(value: IMAPTBasicEvent);
Begin
   fOnCommandCREATE:=Value;
   AddBasicEvent('CREATE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandDELETE(value: IMAPTBasicEvent);
Begin
   fOnCommandDELETE:=Value;
   AddBasicEvent('DELETE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandRENAME(value: IMAPTComplexEvent);
Begin
   fOnCommandRENAME:=Value;
   AddComplexEvent('RENAME',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandSUBSCRIBE(value: IMAPTBasicEvent);
Begin
   fOnCommandSUBSCRIBE:=Value;
   AddBasicEvent('SUBSCRIBE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandUNSUBSCRIBE(value: IMAPTBasicEvent);
Begin
   fOnCommandUNSUBSCRIBE:=Value;
   AddBasicEvent('UNSUBSCRIBE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandLIST(value: IMAPTComplexEvent);
Begin
   fOnCommandLIST:=Value;
   AddComplexEvent('LIST',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandLSUB(value: IMAPTComplexEvent);
Begin
   fOnCommandLSUB:=Value;
   AddComplexEvent('LSUB',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandSTATUS(value: IMAPTComplexEvent);
Begin
   fOnCommandSTATUS:=Value;
   AddComplexEvent('STATUS',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandAPPEND(value: IMAPTComplexEvent);
Begin
   fOnCommandAPPEND:=Value;
   AddComplexEvent('APPEND',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandCHECK(value: IMAPTSimpleEvent);
Begin
   fOnCommandCHECK:=Value;
   AddSimpleEvent('CHECK',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandCLOSE(value: IMAPTSimpleEvent);
Begin
   fOnCommandCLOSE:=Value;
   AddSimpleEvent('CLOSE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandEXPUNGE(value: IMAPTSimpleEvent);
Begin
   fOnCommandEXPUNGE:=Value;
   AddSimpleEvent('EXPUNGE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandSEARCH(value: IMAPTComplexEvent);
Begin
   fOnCommandSEARCH:=Value;
   AddComplexEvent('SEARCH',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandFETCH(value: IMAPTComplexEvent);
Begin
   fOnCommandFETCH:=Value;
   AddComplexEvent('FETCH',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandSTORE(value: IMAPTComplexEvent);
Begin
   fOnCommandSTORE:=Value;
   AddComplexEvent('STORE',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandCOPY(value: IMAPTComplexEvent);
Begin
   fOnCommandCOPY:=Value;
   AddComplexEvent('COPY',Value);
End;

Procedure TDXIMAP4ServerCore.SetOnCommandUID(value: IMAPTComplexEvent);
Begin
   fOnCommandUID:=Value;
   AddComplexEvent('UID',Value);
End;

procedure TDXIMAP4ServerCore.SayHello(ClientThread:TDXClientThread;Header:String);
Begin
   If Header<>'' then ClientThread.Socket.Writeln('* OK '+Header)
   Else ClientThread.Socket.Writeln('* OK IMAP4 Server (ready).');
End;

procedure TDXIMAP4ServerCore.SayGoodbye(ClientThread:TDXClientThread;Footer:String);
Begin
   If Footer<>'' then ClientThread.Socket.Writeln('* BYE '+Footer)
   Else ClientThread.Socket.Writeln('* BYE Goodbye.');
End;

procedure TDXIMAP4ServerCore.ProcessSession(ClientThread: TDXClientThread);
var
  s, sTag, sCmd: string;
  WasHandled: Boolean;
  Loop:Integer;
  OutData:Pointer;

begin
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      while Connected do begin
         If fbForceAbort then Exit;
         S:=ReadLn(Timeout);
         If LastReadTimeout or Not ValidSocket then Exit;
         if s='' then continue;
         if assigned({$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}) then begin
            Loop:=FilterRead(@S[1],OutData,Length(S),ClientThread);
            SetLength(S,Loop);
            If Assigned(OutData) then Begin
               FastMove(TDXBSArray(OutData^),S[1],Loop);
{$IFDEF TLS_EDITION}OnReadFilter{$ELSE}OnFilter{$ENDIF}(ddFreePointer,nil,OutData,Loop,Loop,WasHandled,ClientThread) ;
            End;
         End;
         sTag:=UpperCase(Fetch(S,#32,False));
         sCmd:=UpperCase(Fetch(S,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PIMAPBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PIMAPBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PIMAPBasicEvent(fEventArray[Loop]).EventProcedure) then
                       IMAPTBasicEvent(PIMAPBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread, sTag, S);
                  2:if Assigned(PIMAPSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       IMAPTSimpleEvent(PIMAPSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread, sTag);
                  3:if Assigned(PIMAPComplexEvent(fEventArray[Loop]).EventProcedure) then
                       IMAPTComplexEvent(PIMAPComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread, sTag, Fetch(S,#32,False), S);
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End;
         If sCMD='QUIT' then Exit;
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread, sTag, sCmd, s, WasHandled);
         end;
         if not WasHandled then
            Writeln('500 command not recognized (' + sCMD + ')');
      end;
   end;
end;

end.