Mixing classes with objects is an advanced subject.
You use both, but you seem not to understand the consequences of that.
Although such a model is feasible you run a high risk of being ignored, simply because there is too much to explain to get it working.
I will have a look tomorrow,
I don't know why you want to use objects at all. They lack virtual destructors and other advantages classes offer.
Here is one possible architecture that might fit.
I have not implemented all the methods of TServer to save space, and there are lots of dummy classes just to avoid me installing the library units you will need. But I hope you get the general idea.
unit unitUtils; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Video; type TLogMessage = record Text: String; ForeColor: Word; BackColor: Word; TimeStamp: TTimeStamp; Prefix: String; end; TLTcp = class end; TLSocket = class end; TOutputLog = String; TVideoCapabilities = record cap1: Word; end; //Data Storage Types TInputCommand = record Command: String; ArgString: String; HasArguments: Boolean; end; TInputData = record InputString: String; InputBuffer: Array of String; InputBufferIndex: Integer; InputBufferSelected: Boolean; end; TJSONClass = class // end; { TBaseHandler } TBaseHandler = class private FStringID: String; public constructor Create(aStringID: String); property StringID: String read FStringID; procedure HandleIt(aString: String); virtual; abstract; procedure HandleIt(aJSON: TJSONClass); virtual; abstract; end; TBaseHandlerClass = class of TBaseHandler; { TConsoleHandler } TConsoleHandler = class(TBaseHandler) procedure HandleIt(aString: String); override; end; { TProtocolCommandHandler } TProtocolCommandHandler = class(TBaseHandler) procedure HandleIt(aJSON: TJSONClass); override; end; { TProtocolStatusHandler } TProtocolStatusHandler = class(TBaseHandler) procedure HandleIt(aJSON: TJSONClass); override; end; { TBaseModule } TBaseModule = class private FHandlerList: TFPList; // list of handlers public constructor Create; destructor Destroy; override; procedure Update; virtual; abstract; procedure Init; virtual; abstract; procedure Exit; virtual; abstract; procedure AddHandler(aHandlerClass: TBaseHandlerClass; const aStringID: String); end; { TServer = class(TBaseModule) private tcpServer: TLTcp; ListenAddress: String; ListenPort: Integer; procedure tcpOnAccept(aSocket: TLSocket); procedure tcpOnConnect(aSocket: TLSocket); procedure tcpOnError(const msg: String; aSocket: TLSocket); procedure tcpOnReceive(aSocket: TLSocket); procedure tcpOnDisconnect(aSocket: TLSocket); procedure tcpOnCanSend(aSocket: TLSocket); public constructor Create; destructor Destroy; override; procedure Exit; override; procedure Init; override; procedure Update; override; function startListening(Address: String; Port: Integer): Boolean; //start the tcp server function stopListening: Boolean; end; } TConsole = class(TBaseModule) private InputData: TInputData; OutputLog: TOutputLog; procedure Draw; function CheckCommandString(const cmdString: String): TInputCommand; procedure getKeyboardInput; public Capabilities: TVideoCapabilities; constructor Create; destructor Destroy; override; procedure Exit; override; procedure Init; override; procedure Update; override; procedure UpdateDrawInfo; procedure SendConsoleCommand(const cmdString: String); //send command to console procedure WriteLogMessage(const Message: String; foreColor: Byte = White; backColor: Byte = Black; prefixString: String = 'MAIN/INFO'); end; var Console: TConsole = Nil; //Server: TServer = Nil; implementation { TConsole } procedure TConsole.Draw; begin end; function TConsole.CheckCommandString(const cmdString: String): TInputCommand; begin end; procedure TConsole.getKeyboardInput; begin end; constructor TConsole.Create; begin inherited Create; end; destructor TConsole.Destroy; begin inherited Destroy; end; procedure TConsole.Exit; begin end; procedure TConsole.Init; begin end; procedure TConsole.Update; begin end; procedure TConsole.UpdateDrawInfo; begin end; procedure TConsole.SendConsoleCommand(const cmdString: String); begin end; procedure TConsole.WriteLogMessage(const Message: String; foreColor: Byte; backColor: Byte; prefixString: String); begin end; { TBaseModule } constructor TBaseModule.Create; begin FHandlerList := TFPList.Create; end; destructor TBaseModule.Destroy; var i: Integer; begin for i := 0 to FHandlerList.Count-1 do if TBaseHandler(FHandlerList[i]) is TConsoleHandler then TConsoleHandler(FHandlerList[i]).Free else if TBaseHandler(FHandlerList[i]) is TProtocolCommandHandler then TProtocolCommandHandler(FHandlerList[i]).Free else if TBaseHandler(FHandlerList[i]) is TProtocolStatusHandler then TProtocolStatusHandler(FHandlerList[i]).Free else Assert(True,'programmer error'); FHandlerList.Free; inherited Destroy; end; procedure TBaseModule.AddHandler(aHandlerClass: TBaseHandlerClass; const aStringID: String); begin FHandlerList.Add(aHandlerClass.Create(aStringID)); end; { TProtocolStatusHandler } procedure TProtocolStatusHandler.HandleIt(aJSON: TJSONClass); begin with aJSON do begin end; end; { TProtocolCommandHandler } procedure TProtocolCommandHandler.HandleIt(aJSON: TJSONClass); begin with aJSON do begin end; end; { TConsoleHandler } procedure TConsoleHandler.HandleIt(aString: String); begin case aString of 'command1': begin end; 'command2': begin end; end; end; { TBaseHandler } constructor TBaseHandler.Create(aStringID: String); begin FStringID := aStringID; end; initialization Console := TConsole.Create; Console.AddHandler(TConsoleHandler, 'command1'); Console.AddHandler(TConsoleHandler, 'command2'); // etc {Server := TServer.Create; Server.AddHandler(TProtocolCommandHandler, 'protocol1'); // etc } finalization Console.Free; // Server.Free; end.
I don't know why you want to use objects at all. They lack virtual destructors and other advantages classes offer.
Here is one possible architecture that might fit.
I have not implemented all the methods of TServer to save space, and there are lots of dummy classes just to avoid me installing the library units you will need. But I hope you get the general idea.
unit unitUtils; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Video; type TLogMessage = record Text: String; ForeColor: Word; BackColor: Word; TimeStamp: TTimeStamp; Prefix: String; end; TLTcp = class end; TLSocket = class end; TOutputLog = String; TVideoCapabilities = record cap1: Word; end; //Data Storage Types TInputCommand = record Command: String; ArgString: String; HasArguments: Boolean; end; TInputData = record InputString: String; InputBuffer: Array of String; InputBufferIndex: Integer; InputBufferSelected: Boolean; end; TJSONClass = class // end; { TBaseHandler } TBaseHandler = class private FStringID: String; public constructor Create(aStringID: String); property StringID: String read FStringID; procedure HandleIt(aString: String); virtual; abstract; procedure HandleIt(aJSON: TJSONClass); virtual; abstract; end; TBaseHandlerClass = class of TBaseHandler; { TConsoleHandler } TConsoleHandler = class(TBaseHandler) procedure HandleIt(aString: String); override; end; { TProtocolCommandHandler } TProtocolCommandHandler = class(TBaseHandler) procedure HandleIt(aJSON: TJSONClass); override; end; { TProtocolStatusHandler } TProtocolStatusHandler = class(TBaseHandler) procedure HandleIt(aJSON: TJSONClass); override; end; { TBaseModule } TBaseModule = class private FHandlerList: TFPList; // list of handlers public constructor Create; destructor Destroy; override; procedure Update; virtual; abstract; procedure Init; virtual; abstract; procedure Exit; virtual; abstract; procedure AddHandler(aHandlerClass: TBaseHandlerClass; const aStringID: String); end; { TServer = class(TBaseModule) private tcpServer: TLTcp; ListenAddress: String; ListenPort: Integer; procedure tcpOnAccept(aSocket: TLSocket); procedure tcpOnConnect(aSocket: TLSocket); procedure tcpOnError(const msg: String; aSocket: TLSocket); procedure tcpOnReceive(aSocket: TLSocket); procedure tcpOnDisconnect(aSocket: TLSocket); procedure tcpOnCanSend(aSocket: TLSocket); public constructor Create; destructor Destroy; override; procedure Exit; override; procedure Init; override; procedure Update; override; function startListening(Address: String; Port: Integer): Boolean; //start the tcp server function stopListening: Boolean; end; } TConsole = class(TBaseModule) private InputData: TInputData; OutputLog: TOutputLog; procedure Draw; function CheckCommandString(const cmdString: String): TInputCommand; procedure getKeyboardInput; public Capabilities: TVideoCapabilities; constructor Create; destructor Destroy; override; procedure Exit; override; procedure Init; override; procedure Update; override; procedure UpdateDrawInfo; procedure SendConsoleCommand(const cmdString: String); //send command to console procedure WriteLogMessage(const Message: String; foreColor: Byte = White; backColor: Byte = Black; prefixString: String = 'MAIN/INFO'); end; var Console: TConsole = Nil; //Server: TServer = Nil; implementation { TConsole } procedure TConsole.Draw; begin end; function TConsole.CheckCommandString(const cmdString: String): TInputCommand; begin end; procedure TConsole.getKeyboardInput; begin end; constructor TConsole.Create; begin inherited Create; end; destructor TConsole.Destroy; begin inherited Destroy; end; procedure TConsole.Exit; begin end; procedure TConsole.Init; begin end; procedure TConsole.Update; begin end; procedure TConsole.UpdateDrawInfo; begin end; procedure TConsole.SendConsoleCommand(const cmdString: String); begin end; procedure TConsole.WriteLogMessage(const Message: String; foreColor: Byte; backColor: Byte; prefixString: String); begin end; { TBaseModule } constructor TBaseModule.Create; begin FHandlerList := TFPList.Create; end; destructor TBaseModule.Destroy; var i: Integer; begin for i := 0 to FHandlerList.Count-1 do if TBaseHandler(FHandlerList[i]) is TConsoleHandler then TConsoleHandler(FHandlerList[i]).Free else if TBaseHandler(FHandlerList[i]) is TProtocolCommandHandler then TProtocolCommandHandler(FHandlerList[i]).Free else if TBaseHandler(FHandlerList[i]) is TProtocolStatusHandler then TProtocolStatusHandler(FHandlerList[i]).Free else Assert(True,'programmer error'); FHandlerList.Free; inherited Destroy; end; procedure TBaseModule.AddHandler(aHandlerClass: TBaseHandlerClass; const aStringID: String); begin FHandlerList.Add(aHandlerClass.Create(aStringID)); end; { TProtocolStatusHandler } procedure TProtocolStatusHandler.HandleIt(aJSON: TJSONClass); begin with aJSON do begin end; end; { TProtocolCommandHandler } procedure TProtocolCommandHandler.HandleIt(aJSON: TJSONClass); begin with aJSON do begin end; end; { TConsoleHandler } procedure TConsoleHandler.HandleIt(aString: String); begin case aString of 'command1': begin end; 'command2': begin end; end; end; { TBaseHandler } constructor TBaseHandler.Create(aStringID: String); begin FStringID := aStringID; end; initialization Console := TConsole.Create; Console.AddHandler(TConsoleHandler, 'command1'); Console.AddHandler(TConsoleHandler, 'command2'); // etc {Server := TServer.Create; Server.AddHandler(TProtocolCommandHandler, 'protocol1'); // etc } finalization Console.Free; // Server.Free; end.
Hey, i looked through it again and I have a question:The other handler types are all descendants of TBaseHandler, so they are compatible classes by definition. This means you have to do rather tedious interrogation to discover the actual handler class at runtime, to use methods specific to a particular class. See the Destroy method for an example. But that bit of tedious boilerplate code means you have then have the power of polymorphism at your disposal: you can call the appropriate (virtual) method of the handler.
In the procedure TBaseModule.AddHandler you have aHandlerClass of type TBaseHandlerClass as a parameter, but how can you then use the other handler types here?
And when the pointer gets added to the list, it's also just the aHandlerClass class, does the create return a pointer to the class instance?Yes, and that reference is stored for future use in the list.