dxbbsservercore.pas

Well known and usefull component for delphi 7

// Add*Event procedures to expand our code, reducing code
// changes when an upgrade is released!<B>
// 
// 
// 
// \Example Usage</B> AddBasicEvent('CDROM',MySpecialEvent);
// 
//
// 
// Summary
// Implement a new command to the internal dynamic parser.     
Procedure TDXBBSServerCore.AddBasicEvent(Command:String;EventProc:BBSTBasicEvent);
Var
   PBasicEvent:PBBSBasicEvent;
   Loop:Integer;

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

// 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 TDXBBSServerCore.AddSimpleEvent(Command:String;EventProc:BBSTSimpleEvent);
Var
   PSimpleEvent:PBBSSimpleEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PBBSSimpleEvent(fEventArray[Loop]).Command=Command then Begin
         PBBSSimpleEvent(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 TDXBBSServerCore.AddComplexEvent(Command:String;EventProc:BBSTComplexEvent);
Var
   PComplexEvent:PBBSComplexEvent;
   Loop:Integer;

Begin
   Command:=Uppercase(Command);
   Loop:=0;
   While Loop<fEventArray.Count do Begin
      If PBBSComplexEvent(fEventArray[Loop]).Command=Command then Begin
         PBBSComplexEvent(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 TDXBBSServerCore.SetOnCommandAUTH(value:BBSTComplexEvent);
Begin
   fOnCommandAUTH:=Value;
   AddComplexEvent('AUTH',Value);
End;

Procedure TDXBBSServerCore.SetOnCommandMENU(value: BBSTBasicEvent);
Begin
   fOnCommandMENU:=Value;
   AddBasicEvent('MENU',Value);
End;

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

Procedure TDXBBSServerCore.SetOnCommandPONG(value:BBSTSimpleEvent);
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 "BBS Server (Ready)", and the client will begin login.
// 
// 
// 
// Summary
// Simple wrapper to say hello.
procedure TDXBBSServerCore.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('BBS 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 TDXBBSServerCore.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 TDXBBSServerCore.ProcessSession(ClientThread:TDXClientThread);
var
   s, sCmd: string;
   Loop:Integer;
   WasHandled:Boolean;
   OutData:Pointer;
   Okay:Boolean;

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 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;
         sCmd:=UpperCase(Fetch(s,#32,False));
         Loop:=0;
         WasHandled:=False;
         While (Loop<fEventArray.Count) and (Not WasHandled) do Begin
            If PBBSBasicEvent(fEventArray[Loop]).Command=sCMD then Begin
               Case PBBSBasicEvent(fEventArray[Loop]).Tag of
                  1:if Assigned(PBBSBasicEvent(fEventArray[Loop]).EventProcedure) then
                       BBSTBasicEvent(PBBSBasicEvent(fEventArray[Loop]).EventProcedure)(ClientThread,S);
                  2:if Assigned(PBBSSimpleEvent(fEventArray[Loop]).EventProcedure) then
                       BBSTSimpleEvent(PBBSSimpleEvent(fEventArray[Loop]).EventProcedure)(ClientThread);
                  3:if Assigned(PBBSComplexEvent(fEventArray[Loop]).EventProcedure) then
                       BBSTComplexEvent(PBBSComplexEvent(fEventArray[Loop]).EventProcedure)(ClientThread,Uppercase(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,sCmd,s,WasHandled);
         end;
         if not WasHandled then
            Writeln('-CMD(' + sCMD + ')');
      end;
   end;
end;

end.