dxdispatchdatasetservercore.pas

Well known and usefull component for delphi 7

         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 TDXDispatchDatasetServerCore.AddSimpleEvent(Command:String;EventProc:DISPATCHTSimpleEvent);
Var
   PSimpleEvent:PDISPATCHSimpleEvent;
   Loop:Integer;

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

Procedure TDXDispatchDatasetServerCore.AddComplexEvent(Command:String;EventProc:DISPATCHTComplexEvent);
Var
   PComplexEvent:PDISPATCHComplexEvent;
   Loop:Integer;

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

Procedure TDXDispatchDatasetServerCore.SetOnCommandHELO(value:DISPATCHTComplexEvent);
Begin
   fOnCommandHELO:=Value;
   AddComplexEvent('HELO',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandCONNECT(value:DISPATCHTComplexEvent);
Begin
   fOnCommandCONNECT:=Value;
   AddComplexEvent('CONNECT',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandSQL(value:DISPATCHTBasicEvent);
Begin
   fOnCommandSQL:=Value;
   AddBasicEvent('SQL',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandSQLEXEC(value:DISPATCHTBasicEvent);
Begin
   fOnCommandSQLEXEC:=Value;
   AddBasicEvent('SQLEXEC',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandACKD(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandACKD:=Value;
   AddSimpleEvent('ACKD',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandNACK(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandNACK:=Value;
   AddSimpleEvent('NACK',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandOPEN(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandOPEN:=Value;
   AddSimpleEvent('OPEN',Value);
End;

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

Procedure TDXDispatchDatasetServerCore.SetOnCommandFIELDS(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandFIELDS:=Value;
   AddSimpleEvent('FIELDS',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandFETCH(value:DISPATCHTBasicEvent);
Begin
   fOnCommandFETCH:=Value;
   AddBasicEvent('FETCH',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandFETCHROWS(value:DISPATCHTComplexEvent);
Begin
   fOnCommandFETCHROWS:=Value;
   AddComplexEvent('FETCHROWS',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandQUIT(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandQUIT:=Value;
   AddSimpleEvent('QUIT',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandPOST(value:DISPATCHTComplexEvent);
Begin
   fOnCommandPOST:=Value;
   AddComplexEvent('POST',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandFIRST(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandFIRST:=Value;
   AddSimpleEvent('FIRST',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandLAST(value:DISPATCHTSimpleEvent);
Begin
   fOnCommandLAST:=Value;
   AddSimpleEvent('LAST',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandDETAILSQL(value:DISPATCHTBasicEvent);
Begin
   fOnCommandDETAILSQL:=Value;
   AddBasicEvent('DETAILSQL',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandDETAILOPEN(value:DISPATCHTBasicEvent);
Begin
   fOnCommandDETAILOPEN:=Value;
   AddBasicEvent('DETAILOPEN',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandDETAILCLOSE(value:DISPATCHTBasicEvent);
Begin
   fOnCommandDETAILCLOSE:=Value;
   AddBasicEvent('DETAILCLOSE',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandDETAILFIELDS(value:DISPATCHTBasicEvent);
Begin
   fOnCommandDETAILFIELDS:=Value;
   AddBasicEvent('DETAILFIELDS',Value);
End;

Procedure TDXDispatchDatasetServerCore.SetOnCommandDETAILFETCH(value:DISPATCHTBasicEvent);
Begin
   fOnCommandDETAILFETCH:=Value;
   AddBasicEvent('DETAILFETCH',Value);
End;

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

begin
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      StartTime:=TimeCounter+fiTimeout;
      while Connected do begin
         if fbForceAbort then Break;
         S:=ReadWithSize;
         If Not ValidSocket then Break;
         If S='' then Continue;
         If StartTime<TimeCounter then break; // timeout, no activity.
         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(FetchByChar(S,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PDISPATCHBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PDISPATCHBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PDISPATCHBasicEvent(fEventArray[Loop]).EventProcedure) then
                       DISPATCHTBasicEvent(PDISPATCHBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
                  2:if Assigned(PDISPATCHSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       DISPATCHTSimpleEvent(PDISPATCHSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PDISPATCHComplexEvent(fEventArray[Loop]).EventProcedure) then Begin
                       S2:=FetchByChar(S,#32,False);
                       DISPATCHTComplexEvent(PDISPATCHComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S2,S);
                  End;
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End; {while}
         If sCMD='QUIT' then Break; {terminate}
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,S,WasHandled);
         end;
         if not WasHandled then
            WriteWithSize('500 COMMAND ERROR - command not recognized (' + CMD + ')');
         StartTime:=TimeCounter+fiTimeout;
      end; {while}
   end; {with}
end; {doExecute}

Function TDXDispatchDatasetServerCore.WriteResult(ClientThread:TDXClientThread;StatusCode:Integer;Rslt:String):Boolean;
Begin
   Result:=ClientThread.Socket.WriteWithSize(IntToCommaStr(StatusCode)+#32+Rslt);
End;

Function TDXDispatchDatasetServerCore.Writeln(ClientThread:TDXClientThread;Rslt:String):Boolean;
Begin
   Result:=ClientThread.Socket.WriteWithSize(Rslt);
End;

procedure Register;
begin
   RegisterComponents('BPDX MultiTier', [TDXDispatchDatasetServerCore]);
end;

end.