{$REGION 'TimeOutHandler Thread'}
procedure TTimeOutHandler.setTimeOutMessage(Value : TTimeOutMessage);
var
i : Integer;
begin
FTimeOutMsg.ApplId:=Value.ApplId;
FTimeOutMsg.ApplExe:=Value.ApplExe;
FTimeOutMsg.ApplService:=Value.ApplService;
FTimeOutMsg.ApplIP:=Value.ApplIP;
FTimeOutMsg.ThreadId:=Value.ThreadId;
FTimeOutMsg.CodePartId:=Value.CodePartId;
FTimeOutMsg.StackCount:=Value.StackCount;
setLength(FTimeOutMsg.Stack,Value.StackCount);
for i := 0
to length(value.Stack) - 1
do
FTimeOutMsg.Stack[i]:=Value.Stack[i];
FStep:= thsConnectService;
end;
procedure TTimeOutHandler.executeStateMachine;
var
schService,
//Service Handle
schSCManager:Integer;
//Service Manager Handle;
StackString,
EmailText: TStringlist;
ActionText,
ListString:
String;
i : integer;
function GuardianStopService: boolean;
var
ServiceState: SERVICE_STATUS;
//Service State
begin
Result:=True;
// Get the Services State
Result:= QueryServiceStatus( schService, ServiceState);
// is the Service allready stopped?
if Result
then
if ServiceState.dwCurrentState > SERVICE_STOPPED
then begin
if ( ServiceState.dwCurrentState = SERVICE_STOP_PENDING )
then begin
Sleep( ServiceState.dwWaitHint );
Result:= QueryServiceStatus( schService, ServiceState);
if Result
then
Result := ServiceState.dwCurrentState = SERVICE_STOPPED;
end
else begin
result:= ControlService( schService, SERVICE_CONTROL_STOP, ServiceState );
if ( ServiceState.dwCurrentState = SERVICE_STOP_PENDING )
then begin
Sleep( ServiceState.dwWaitHint );
Result:= QueryServiceStatus( schService, ServiceState);
if Result
then
Result := ServiceState.dwCurrentState = SERVICE_STOPPED;
end;
end;
end;
end;
//function
function GuardianStartService: boolean;
var
ServiceState: SERVICE_STATUS;
//Service State
CheckCount : Integer;
Args :
String;
SvArgs : PAnsiChar;
begin
Args:='
';
SvArgs:=PAnsiChar(Args);
// Start the Service
result:=StartService(schService,0,SvArgs);
{ // Get the Services State
if Result then
Result:= QueryServiceStatus( schService, ServiceState);
// wait maximum 10s to get the Service in running state;
CheckCount:=0;
if Result then begin
while ((ServiceState.dwCurrentState = SERVICE_START_PENDING)
or (CheckCount<9) and result) do begin
inc(CheckCount);
sleep(1000);
Result:= QueryServiceStatus( schService, ServiceState);
end;
if result then
result :=ServiceState.dwCurrentState = SERVICE_RUNNING;
end;}
end;
//function
function GuardianOpenService(TimeOutMsg: TTimeOutMessage):Boolean;
var
Par1,
Par2,
Args :
String;
SvArgs : PAnsiChar;
i: Integer;
begin
Args:=char(0);
SvArgs:=PChar(Args);
// Par1:=char(0);
Par1:=TimeOutMsg.ApplIP+char(0);
Par2:=TimeOutMsg.ApplService+char(0);
Result:=True;
//get Service Manager Handle:
schSCManager := OpenSCManager(PChar(Par1),SERVICES_ACTIVE_DATABASE,SC_MANAGER_ALL_ACCESS);
Result:=
not(schSCManager = 0);
//get Service Handle
if Result
then begin
schService := OpenService(schSCManager,PChar(Par2), SERVICE_ALL_ACCESS);
result:=
not(schService = 0);
end
else
i:=GetLastError;
end;
begin
while not Terminated
do begin
case FStep
of
{$REGION 'thsConnectService'}
thsConnectService:
begin
ActionText:='
Tried: ';
if not FTimeoutActions.RestartService
then
FStep:=thsKillExecutable
else begin
ActionText:=ActionText+'
restart Service: ';
if FTimeOutMsg.ApplService <> '
'
then begin
if GuardianOpenService(FTimeOutMsg)
then
FStep:=thsStopService
else begin
FStep:=thsKillExecutable;
ActionText:=ActionText+'
couldn''
t connect to Service Manager!';
end;
end
else begin
ActionText:=ActionText+'
Have no Service Name!';
FStep:=thsKillExecutable;
end;
end;
end;
{$ENDREGION}
{$REGION 'thsStopService'}
thsStopService:
begin
sleep(5000);
if GuardianStopService
then
FStep:= thsStartService
else begin
ActionText:=ActionText+'
Couldn''
t stop the Service!';
FStep:=thsKillExecutable;
End;
end;
{$ENDREGION}
{$REGION 'thsStartService'}
thsStartService:
begin
sleep(5000);
if GuardianStartService
then begin
FStep:= thsSendMail;
ActionText:=ActionText+'
sucessfull';
end
else begin
ActionText:=ActionText+'
Couldn''
t start the Service!';
FStep:=thsKillExecutable;
End;
end;
{$ENDREGION}
{$REGION 'thsKillExecutable'}
thsKillExecutable:
Begin
FStep:= thsSendMail;
End;
{$ENDREGION}
{$REGION 'thsSendMail'}
thsSendMail:
if not FTimeoutActions.SendMail
then
FStep:=thsTerminateThread
else begin
EmailText:=TStringlist.Create;
with EmailText
do begin
Delimiter:=#13;
Clear;
append('
Application Timeout happens:');
append('
============================');
append('
Local Server Time: '+DateTimeToStr(now));
append('
Application Computer IP: '+FTimeOutMsg.ApplIP);
append('
Application Executable Name: '+FTimeOutMsg.ApplExe);
append('
Application Service Name: '+FTimeOutMsg.ApplService);
append('
Application Internal Id: '+inttostr(FTimeOutMsg.ApplId));
if FTimeOutMsg.ThreadId>-1
then begin
append('
Application internal Thread Id: '+IntToStr(FTimeOutMsg.ThreadId));
if FTimeOutMsg.CodePartId>-1
then begin
append('
Application Thread Codepart Id: '+IntToStr(FTimeOutMsg.CodePartId));
append('
The Codepart was not left of refreshed after the preset time interval');
append('
Stack of entered codeparts:');
for i := 0
to FTimeOutMsg.StackCount - 1
do begin
append('
Level( '+IntToStr(i) +'
):'+IntToStr(FTimeOutMsg.Stack[i]));
end;
end
else begin
append('
The Applications Thread doesn''
t send the its idle signal after the preset time interval');
end;
end
else
append('
The Application doesn''
t send the application idle signal after the preset time interval');
append(ActionText);
end;
Form1.sendEmail(EmailText);
EmailText.Free;
FStep:= thsTerminateThread;
end;
{$ENDREGION}
{$REGION 'thsTerminateThread'}
thsTerminateThread: terminate;
{$ENDREGION}
end;
end;
end;
procedure TTimeOutHandler.execute();
begin
// inherited execute;
executeStateMachine;
end;
{$ENDREGION}