dxnetlinkservercore.pas

Well known and usefull component for delphi 7

   PBasicEvent.EventProcedure:=EventProc;
   fEventArray.Add(PBasicEvent);
End;

// Allows you to dynamically assign a new command to the
// \internal parser. This allows the servercore to support the
// 'pre-defined' OnCommand* events, plus you can add other
// commands dynamically at run-time in your application without
// requiring a source code modification to our components!
// 
// 
// 
// To make support easier for us, we ask that you use the
// Add*Event procedures to expand our code, reducing code
// changes when an upgrade is released!<B>
// 
// 
// 
// \Example Usage</B> AddSimpleEvent('DATE',MySpecialEvent3);
// 
// 
// 
// Summary
// Implement a new command to the internal dynamic parser.     
Procedure TDXNetLinkServerCore.AddSimpleEvent(Command:String;EventProc:NetLinkTSimpleEvent);
Var
   PSimpleEvent:PNetLinkSimpleEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PNetLinkSimpleEvent(fEventArray[Loop]).Command=Command then Begin
         PNetLinkSimpleEvent(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;

// Allows you to dynamically assign a new command to the
// \internal parser. This allows the servercore to support the
// 'pre-defined' OnCommand* events, plus you can add other
// commands dynamically at run-time in your application without
// requiring a source code modification to our components!
// 
// 
// 
// To make support easier for us, we ask that you use the
// Add*Event procedures to expand our code, reducing code
// changes when an upgrade is released!<B>
// 
// 
// 
// \Example Usage</B>
// AddComplexEvent('CDROMEX',MySpecialEvent2);
//
//
//
// Summary
// Implement a new command to the internal dynamic parser.
Procedure TDXNetLinkServerCore.AddComplexEvent(Command:String;EventProc:NetLinkTComplexEvent);
Var
   PComplexEvent:PNetLinkComplexEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PNetLinkComplexEvent(fEventArray[Loop]).Command=Command then Begin
         PNetLinkComplexEvent(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 TDXNetLinkServerCore.AddRealComplexEvent(Command:String;EventProc:NetLinkTRealComplexEvent);
Var
   PRealComplexEvent:PNetLinkRealComplexEvent;
   Loop:Integer;

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

Procedure TDXNetLinkServerCore.SetOnCommandSENDIM(value: NetLinkTComplexEvent);
Begin
   fOnCommandSENDIM:=Value;
   AddComplexEvent('SENDIM',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandMYSTATUS(value: NetLinkTBasicEvent);
Begin
   fOnCommandMYSTATUS:=Value;
   AddBasicEvent('MYSTATUS',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandADDCONTACT(value: NetLinkTBasicEvent);
Begin
   fOnCommandADDCONTACT:=Value;
   AddBasicEvent('ADDCONTACT',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandDELCONTACT(value: NetLinkTBasicEvent);
Begin
   fOnCommandDELCONTACT:=Value;
   AddBasicEvent('DELCONTACT',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandADDSERVICE(value: NetLinkTBasicEvent);
Begin
   fOnCommandADDSERVICE:=Value;
   AddBasicEvent('ADDSERVICE',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandDELSERVICE(value: NetLinkTBasicEvent);
Begin
   fOnCommandDELSERVICE:=Value;
   AddBasicEvent('DELSERVICE',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandSERVERSTATUS(value: NetLinkTSimpleEvent);
Begin
   fOnCommandSERVERSTATUS:=Value;
   AddSimpleEvent('SERVERSTATUS',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandWATCHLIST(value: NetLinkTSimpleEvent);
Begin
   fOnCommandWATCHLIST:=Value;
   AddSimpleEvent('WATCHLIST',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandALLSTATUS(value: NetLinkTSimpleEvent);
Begin
   fOnCommandALLSTATUS:=Value;
   AddSimpleEvent('ALLSTATUS',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandSERVICES(value: NetLinkTSimpleEvent);
Begin
   fOnCommandSERVICES:=Value;
   AddSimpleEvent('SERVICES',Value);
End;

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

Procedure TDXNetLinkServerCore.SetOnCommandALERT(value:NetLinkTRealComplexEvent);
Begin
   fOnCommandALERT:=Value;
   AddRealComplexEvent('ALERT',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandPING(value:NetLinkTSimpleEvent);
Begin
   fOnCommandPING:=Value;
   AddSimpleEvent('PING',Value);
End;

Procedure TDXNetLinkServerCore.SetOnCommandPONG(value:NetLinkTSimpleEvent);
Begin
   fOnCommandPONG:=Value;
   AddSimpleEvent('PONG',Value);
End;

// A built-in Routine to Call in your "onNewConnect", reduces
// problems if you do not know how the protocols work. Simply
// call this routine with a String containing the "Hello
// String", if blank this routine will just respond to the
// client "NetLink Server (Ready)", and the client will begin login.
// 
// 
// 
// Summary
// Simple wrapper to say hello.                                 
procedure TDXNetLinkServerCore.SayHello(ClientThread:TDXClientThread;Header,MOTD:TStream);
Begin
   If Assigned(Header) then Begin
{$IFDEF VER100}
      ClientThread.Socket.SendFromStream(Header);
{$ELSE}
      ClientThread.Socket.SendFrom(Header);
{$ENDIF}
   End
   Else Begin
      ClientThread.Socket.Writeln('NetLink Server Ready.');
   End;
   If Assigned(MOTD) then Begin
{$IFDEF VER100}
      ClientThread.Socket.SendFromStream(MOTD);
{$ELSE}
      ClientThread.Socket.SendFrom(MOTD);
{$ENDIF}
   End;
   ClientThread.Socket.Writeln('Proceed with login');
   ClientThread.Socket.Writeln('.');
End;

// A built-in Routine to Call at the end of your "OnNewConnect",
// this will send a String "Footer", or the defacto "Goodbye."
// to the client program. This should be the last piece of code
// in your onNewConnect. Remember the onDisconnect is not a good
// place to send any output - as the client could have
// disconnected already!
// 
// 
// 
// Summary
// Simple wrapper to say goodbye.                               
procedure TDXNetLinkServerCore.SayGoodbye(ClientThread:TDXClientThread;Footer:TStream);
Begin
   If Assigned(Footer) then
{$IFDEF VER100}
      ClientThread.Socket.SendFromStream(Footer)
{$ELSE}
      ClientThread.Socket.SendFrom(Footer)
{$ENDIF}
   Else
      ClientThread.Socket.Writeln('Goodbye, please come back soon!');
   ClientThread.Socket.Writeln('.');
End;

// If you want this CORE to process the parsing, you should call
// this from your "OnNewConnect" implementation. This should be
// right after your call to SayHello (optional).
// 
// 
// 
// Summary
// Call the "Defacto" dynamic command parser for this protocol. 
procedure TDXNetLinkServerCore.ProcessSession(ClientThread:TDXClientThread);
var
   s, sCmd: string;
   Loop:Integer;
   WasHandled:Boolean;
   OutData:Pointer;
   Okay:Boolean;
   ServiceID,
   Msg,
   WebSite:String;

begin
   fbForceAbort:=False;
   with ClientThread.Socket do begin
      while connected do begin
         Okay:=False;
         While not Okay do Begin
            if fbForceAbort then exit;
            s:=ReadLn(Timeout);
            If LastReadTimeout then Begin
               If Assigned(fOnCommandTimeout) then
                  fOnCommandTimeout(ClientThread)
               Else
                  Exit;
            End
            Else
               If Not Connected then Exit
               Else Okay:=True;
         End;
         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,NetlinkStrDelim,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PNetLinkBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PNetLinkBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PNetLinkBasicEvent(fEventArray[Loop]).EventProcedure) then
                       NetLinkTBasicEvent(PNetLinkBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
                  2:if Assigned(PNetLinkSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       NetLinkTSimpleEvent(PNetLinkSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PNetLinkComplexEvent(fEventArray[Loop]).EventProcedure) then
                       NetLinkTComplexEvent(PNetLinkComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,Uppercase(Fetch(S,NetlinkStrDelim,False)),S);
                  4:if Assigned(PNetLinkRealComplexEvent(fEventArray[Loop]).EventProcedure) then Begin
                       ServiceID:=Fetch(S,NetlinkStrDelim,False);
                       Msg:=Fetch(S,NetlinkStrDelim,False);
                       WebSite:=Fetch(S,NetlinkStrDelim,False);
                       NetLinkTRealComplexEvent(PNetLinkRealComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,ServiceID,Msg,WebSite,S);
                  End;
               End;
               WasHandled:=True;
            End
            Else Inc(Loop);
         End;
         if sCMD='QUIT' then Exit;
         If Not WasHandled then Begin
            if assigned(OnCommandOther) then
               OnCommandOther(ClientThread,sCmd,s,WasHandled);
         end;
         if not WasHandled then
            Writeln('-CMD(' + sCMD + ')');
      end;
   end;
end;


end.