dxmessagebaseservercore.pas

Well known and usefull component for delphi 7

         End;
         fEventArray.Delete(0);
      End;
   End;
   inherited Destroy;
end;

Procedure TDXMessageBaseServerCore.AddBasicEvent(Command:String;EventProc:MessageBaseTBasicEvent);
Var
   PBasicEvent:PMessageBaseBasicEvent;
   Loop:Integer;

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

Procedure TDXMessageBaseServerCore.AddSimpleEvent(Command:String;EventProc:MessageBaseTSimpleEvent);
Var
   PSimpleEvent:PMessageBaseSimpleEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PMessageBaseSimpleEvent(fEventArray[Loop]).Command=Command then Begin
         PMessageBaseSimpleEvent(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 TDXMessageBaseServerCore.AddRangeEvent(Command:String;EventProc:MessageBaseTRangeEvent);
Var
   PRangeEvent:PMessageBaseRangeEvent;
   Loop:Integer;

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

Procedure TDXMessageBaseServerCore.SetOnCommandLOGIN(value:MessageBaseTBasicEvent);
Begin
   fOnCommandLOGIN:=Value;
   AddBasicEvent('LOGIN',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandFORMAT(value:MessageBaseTBasicEvent);
Begin
   fOnCommandFORMAT:=Value;
   AddBasicEvent('FORMAT',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandMESSAGES(value:MessageBaseTSimpleEvent);
Begin
   fOnCommandMESSAGES:=Value;
   AddSimpleEvent('MESSAGES',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandGETMSG(value:MessageBaseTBasicEvent);
Begin
   fOnCommandGETMSG:=Value;
   AddBasicEvent('GETMSG',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandDELMSG(value:MessageBaseTBasicEvent);
Begin
   fOnCommandDELMSG:=Value;
   AddBasicEvent('DELMSG',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandADDMSG(value:MessageBaseTSimpleEvent);
Begin
   fOnCommandADDMSG:=Value;
   AddSimpleEvent('ADDMSG',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandMSGHDRS(value:MessageBaseTRangeEvent);
Begin
   fOnCommandMSGHDRS:=Value;
   AddRangeEvent('MSGHDRS',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandMSGBODY(value:MessageBaseTBasicEvent);
Begin
   fOnCommandMSGBODY:=Value;
   AddBasicEvent('MSGBODY',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandEDITMSG(value:MessageBaseTBasicEvent);
Begin
   fOnCommandEDITMSG:=Value;
   AddBasicEvent('EDITMSG',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandRESCAN(value:MessageBaseTSimpleEvent);
Begin
   fOnCommandRESCAN:=Value;
   AddSimpleEvent('RESCAN',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandAREAS(value:MessageBaseTSimpleEvent);
Begin
   fOnCommandAREAS:=Value;
   AddSimpleEvent('AREAS',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandNEWAREA(value:MessageBaseTBasicEvent);
Begin
   fOnCommandNEWAREA:=Value;
   AddBasicEvent('NEWAREA',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandDELAREA(value:MessageBaseTBasicEvent);
Begin
   fOnCommandDELAREA:=Value;
   AddBasicEvent('DELAREA',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandGETAREA(value:MessageBaseTBasicEvent);
Begin
   fOnCommandGETAREA:=Value;
   AddBasicEvent('GETAREA',Value);
End;

Procedure TDXMessageBaseServerCore.SetOnCommandHELP(value:MessageBaseTSimpleEvent);
Begin
   fOnCommandHELP:=Value;
   AddSimpleEvent('HELP',Value);
End;

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

  procedure NotHandled(Cmd:String);
  begin
     ClientThread.Socket.Writeln('500 UNKNOWN COMMAND:'+Cmd);
  end;

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 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;
         sCmd:=UpperCase(Fetch(S,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PMessageBaseBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PMessageBaseBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PMessageBaseBasicEvent(fEventArray[Loop]).EventProcedure) then
                       MessageBaseTBasicEvent(PMessageBaseBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,s);
                  2:if Assigned(PMessageBaseSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       MessageBaseTSimpleEvent(PMessageBaseSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PMessageBaseRangeEvent(fEventArray[Loop]).EventProcedure) then
                       MessageBaseTRangeEvent(PMessageBaseRangeEvent(fEventArray[Loop]).EventProcedure)(ClientThread,Fetch(S,#32,False),S);
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End;
         If sCMD='QUIT' then Exit; // 2.0
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,S,WasHandled);
         end;
         if not WasHandled then NotHandled(sCMD);
      end;
   end;
end;

Procedure TDXMessageBaseServerCore.ForceAbort;
Begin
   fbForceAbort:=True;
End;

end.