Hi Grant
Debugging a service application can be difficult so I generally create a console application which creates and manages a single object which in turn creates and manages my DB Server, my Web server, my control application, etc.
These server objects typically operate under their own “Listener” threads interacting with the main object only for logging and errors.
Once you have this application running and debugged then create your service application and
- In ServiceCreate - Create the Control object, Perhaps add a timer to monitor its status and log changes
- In ServiceStart Log the start
- In ServiceContinue Check the status of the Control Object and recreate if necessary
- In ServiceStop Free and nil the Control Object;
At any time you can revert to the console application to improve or debug functionality.
A cut down version of a Console Application
Var
ServerObject: TServerMonitorTCpViaIndy;
sl,s:string;
StatusCount,Timercount :integer;
Begin
ServerObject := TServerMonitorTCpViaIndy.Create(nil);
Try
while ServerObject.IsActive do
begin
if Timercount > 30 then
begin
Timercount := 0;
inc(StatusCount);
sl := ServerObject.IsTCPAppServer.ReadLogMessage;
if sl <> '' then
writeln(sl)
else
writeln('ping ' + FormatDateTime('nn:ss', Now));
if StatusCount > 30 then
begin
writeln(#13#10);
writeln(#13#10);
s := ServerObject.ReportSomething;
writeln(s);
writeln(#13#10);
writeln(#13#10);
s := ServerObject.IsTCPAppServer.CurrentAddressDetails;
writeln(s);
StatusCount := 0;
end;
end;
// Sleep(30000);
Sleep(1000);
inc(Timercount);
end;
Finally
ServerObject.Free;
End;
except
on E: Exception do
begin
writeln(E.ClassName, ': ', E.Message);
Sleep(60000);
end;
end;
Sleep(10000);
end.
An example of the Control Object definition.
TServerMonitorTCpViaIndy = class(Tobject)
private
FIsTCPAppServer: TIsIndyApplicationServer;
FTsting:TIsMonitorTCPAppServer;
FWebTestServer: TTestInnovaWebServerObj;
// FLogFile: TLogFile;
FOnCloseRequest: TSrvMonEvent;
FAvailablelogs, FAvailablelogHints: TStringList;
FIsActive, FInCreateTestServer, FInLogMessage: Boolean;
FTCPMonitorPort: word;
fDbFilename: string;
FServiceNameDb, FServiceNameIndyDb, FServiceNameApache: string;
FLogProc: TAnsiLogProcedure;
FNextStatusLogTime: TDateTime;
procedure LoadIniFile;
procedure SetIsActive(const Value: Boolean);
function GetIsActive: Boolean;
Procedure LogStatusWhenRequired;
public
Constructor Create(AOnCloseRequest: TSrvMonEvent);
Destructor Destroy; Override;
Function IsTCPAppServer: TIsIndyApplicationServer;
Function TestPoll: AnsiString;
Function WebTestServer: TTestInnovaWebServerObj;
Function ServiceLogFileName: AnsiString;
Procedure LogAMessage(const AMessage: AnsiString);
Function AddLogOrTextFile(AFileName, AHint: String): Boolean;
Property IsActive: Boolean read GetIsActive write SetIsActive;
Property LogProc: TAnsiLogProcedure Read FLogProc Write FLogProc;
end;
And its Destructor
destructor TServerMonitorTCpViaIndy.Destroy;
begin
try
LogAMessage(Formatdatetime('dd/mm dddd hh:nn:ss', now) +
' Closing Server');
if Assigned(FOnCloseRequest) then
FOnCloseRequest(Self);
FOnCloseRequest := nil;
FreeAndNil(FIsTCPAppServer);
FreeAndNil(FWebTestServer);
FreeAndNil(FTsting);
// FreeAndNil(FLogFile);
finally
inherited;
end;
end;
My servers generally inherit from TIdTcpServer
TIsIndyApplicationServer = class(TIdTcpServer)
Allocating my own functions to OnConnect, OnExecute, OnContextCreated;
And Extending TIdServerContext
TIsIndyTCPServerContext = class(TIdServerContext)
Private
FTcpRef: TISIndyTCPSvrSession;
FDestroying: Boolean;
Function RawTcpRef: TISIndyTCPSvrSession;
Public
Destructor Destroy; override;
Function TcpRef: TISIndyTCPSvrSession;
Procedure ReleaseOldRef;
end;
constructor TIsIndyApplicationServer.Create(AOwner: TComponent);
begin
FListLock := TCriticalSection.Create;
FBusyLock := TCriticalSection.Create;
Inherited;
ContextClass := TIsIndyTCPServerContext;
OnConnect := IsIdTCPSrvrConnect;
OnExecute := IsIdTCPSvrSessionExecute;
OnContextCreated := IsIdTCPSrvrContextCreated;
LoadServerIniData;
end;
procedure TIsIndyApplicationServer.IsIdTCPSvrSessionExecute
(AContext: TIdContext);
Var
LContext: TIsIndyTCPServerContext;
LConnection: TIdTCPConnection;
TcpCtx: TISIndyTCPSvrSession;
s: String;
begin
if AContext = nil then
exit;
Try
LContext := LocalContext(AContext);
TcpCtx := nil;
if LContext = nil then
ISIndyUtilsException(Self, '#IsIdTCPSvrSessionExecute Nil Local Context')
else
TcpCtx := LContext.RawTcpRef;
if TcpCtx = nil then
begin
ISIndyUtilsException(Self, '#IsIdTCPSvrSessionExecute Nil TcpCtx');
exit;
end;
LConnection := LContext.Connection;
if TcpCtx.FConnection <> LConnection then
begin
if LConnection = nil then
ISIndyUtilsException(Self,
'#IsIdTCPSvrSessionExecute Comtext Nil Coonection')
else
ISIndyUtilsException(Self, '#IsIdTCPSvrSessionExecute Wrong TcpCtx ::' +
TcpCtx.TextID);
exit;
end;
if LConnection <> nil then
// while LConnection.Connected do
if LConnection.Connected then
begin
if FResetStartTime > 0.01 then
if FResetStartTime < now then
FResetStartTime := 0.0
else
begin
ISIndyUtilsException(Self, '# Closing ResetStartTime=' +
FormatDateTime('dd hh:nn:ss.zzz', FResetStartTime));
LConnection.Disconnect;
Sleep(1000);
exit;
end;
if TcpCtx <> nil then
If not TcpCtx.ProcessNextTransaction Then
Begin
if GblLogAllChlOpenClose then
begin
AddLogMessage(TcpCtx.TextID, 'End Run Channel');
ISIndyUtilsException(Self, '#Failed ProcessNextTransaction');
end;
TcpCtx.CloseGracefully;
Sleep(1000);
end;
end;
Except
On E: Exception do
Begin
Try
AddLogMessage('Server IsIdTCPSvrSessionExecute Ex:', E.Message);
if TcpCtx <> nil then
TcpCtx.LogAMessage('Execute Error:' + E.Message);
if LContext.Connection <> nil then
if LContext.Connection.Connected then
AContext.Connection.Disconnect;
Except
On ee: Exception do
Begin
Try
AddLogMessage('Double Exeption:', ee.Message);
Except
end;
end;
end;
End;
End;
end;
procedure TIsIndyApplicationServer.IsIdTCPSrvrConnect(AContext: TIdContext);
Var
LContext: TIsIndyTCPServerContext;
ThisSession: TISIndyTCPSvrSession;
begin
Try
LContext := LocalContext(AContext);
LContext.ReleaseOldRef;
ThisSession := LContext.TcpRef;
ThisSession.FServerObject := Self;
Inc(FServerTcpSessions);
ThisSession.OnLogMsg := AddLogMessage;
ThisSession.OnAnsiStringAction := OnSessionAnsiStringAction;
ThisSession.OnStringAction := OnSessionStringAction;
ThisSession.OnSimpleRemoteAction := OnSessionSimpleRemoteAction;
if cLogAll then
AddLogMessage('Server', 'On Connect::' + IntToStr(FServerTcpSessions));
if FResetStartTime > 0.01 then
if FResetStartTime > now then
FResetStartTime := 0.0
else
LContext.FTcpRef.CloseGracefully;
// accept no calls in reset period;
if FResetStartTime < 0.001 then
If ThisSession.AcceptStart then
Begin
if GblLogAllChlOpenClose then
begin
ISIndyUtilsException(Self, LContext.FTcpRef.TextID + '# Run Channel');
AddLogMessage(LContext.FTcpRef.TextID, 'Run Channel');
end;
end
else
LContext.FTcpRef.CloseGracefully;
Except
On E: Exception do
Begin
ISIndyUtilsException(Self, E, 'IsIdTCPSrvrConnect');
AddLogMessage('Server', 'OnConnect Error:' + E.Message);
end;
end;
end;
procedure TIsIndyApplicationServer.IsIdTCPSrvrContextCreated
(AContext: TIdContext);
begin
Inc(GlobalContext);
end;
Hope this helps