unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,WinSvc,inifiles,
clTcpClient, clHttp, ExtCtrls,Shellapi;
type
TWorkThreadThread =
class(TThread)
private
procedure Check4Url;
public
procedure Execute;
override;
end;
TApacheWatcher =
class(TService)
http: TclHttp;
RestartTimer: TTimer;
procedure ServiceStart(Sender: TService;
var Started: Boolean);
procedure ServiceContinue(Sender: TService;
var Continued: Boolean);
procedure ServicePause(Sender: TService;
var Paused: Boolean);
procedure ServiceStop(Sender: TService;
var Stopped: Boolean);
procedure ServiceCreate(Sender: TObject);
procedure RestartTimerTimer(Sender: TObject);
private
WorkThreadThread:TWorkThreadThread;
procedure ReadInifile;
procedure WriteInifile;
procedure WriteLog(
const FLogMessage:
String);
procedure StartForeignService;
procedure StopForeignService;
procedure Restart;
procedure Check4Url;
{ Private-Deklarationen }
public
FErrors:Integer;
function GetServiceController: TServiceController;
override;
{ Public-Deklarationen }
end;
var
ApacheWatcher: TApacheWatcher;
G_SleepTime:Integer;
G_Log:
String;
G_ErrorCount:Integer;
G_IniFile :
String;
G_JobRunning:Boolean;
G_URL:
String;
G_ServiceName:WideString;
ss:SERVICE_STATUS;
type
TSStatus=Array[1..7]
of String;
Const
SStatus:TSStatus=('
SERVICE_STOPPED', '
SERVICE_START_PENDING', '
SERVICE_STOP_PENDING', '
SERVICE_RUNNING', '
SERVICE_CONTINUE_PENDING', '
SERVICE_PAUSE_PENDING', '
SERVICE_PAUSED');
implementation
{$R *.DFM}
Function TimeStamp:
String;
begin
Result := FormatDateTime('
yyyymmdd hh:nn:ss ',Now);
end;
Procedure CheckFileSize(
Const FN:
String;MaxLen:Integer);
var
sr:TSearchrec;
sl:TStringList;
begin
if FindFirst(FN,faAnyfile, sr)=0
then
begin
if SR.Size>MaxLen
then
begin
sl:=TStringList.Create;
sl.LoadFromFile(fn);
while length(SL.Text)>(MaxLen
div 2)
do
begin
sl.Delete(0);
end;
sl[0]:='
[clipped] '+TimeStamp;
sl.SaveToFile(FN);
end;
end;
FindClose(sr);
end;
Procedure TApacheWatcher.WriteLog(
Const FLogMessage:
String);
var
F:TextFile;
begin
if length(G_Log)>0
then
begin
try
AssignFile(F, G_Log);
if not Fileexists(G_Log)
then Rewrite(F)
else Append(F);
Writeln(F,TimeStamp+'
: '+FLogMessage);
CloseFile(F);
CheckFileSize(G_Log,500000);
except
end;
end;
end;
procedure TWorkThreadThread.Check4Url;
begin
ApacheWatcher.Check4Url;
end;
procedure TWorkThreadThread.Execute;
begin
while not Terminated
do
begin
try
Synchronize(Check4Url);
except
end;
Sleep(1000*G_SleepTime);
end;
end;
procedure ServiceController(CtrlCode: DWord);
stdcall;
begin
ApacheWatcher.Controller(CtrlCode);
end;
Procedure TApacheWatcher.Check4Url;
var
sl:TStringList;
begin
if not RestartTimer.Enabled
then
begin
sl:=TStringList.Create;
if (Length(G_URL)>0)
and (Length(G_ServiceName)>0)
then
begin
try
Http.Close;
Http.Get(G_URL, sl);
except
ON E:
Exception DO WriteLog(E.
Message);
end;
if Length(sl.Text) = 0
then inc(FErrors)
else
begin
FErrors := 0;
RestartTimer.Enabled := false;
end;
if FErrors > 0
then WriteLog('
Error # :' + IntToStr(FErrors));
if FErrors > G_ErrorCount
then Restart;
end;
sl.Free;
end;
end;
function TApacheWatcher.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TApacheWatcher.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
ReadInifile;
WriteLog('
Service continued');
WorkThreadThread.Resume;
Continued := True;
end;
procedure TApacheWatcher.ServiceCreate(Sender: TObject);
begin
G_Log:=ChangeFileExt(ParamStr(0) ,'
.log');
G_IniFile:=ChangeFileExt(ParamStr(0),'
.ini');
G_JobRunning:=false;
end;
procedure TApacheWatcher.ServicePause(Sender: TService;
var Paused: Boolean);
begin
WriteLog('
Service paused');
WorkThreadThread.Suspend;
Paused := True;
end;
procedure TApacheWatcher.ServiceStart(Sender: TService;
var Started: Boolean);
begin
ReadInifile;
WriteLog('
Service started');
WorkThreadThread:= TWorkThreadThread.Create(False);
Started := True;
end;
procedure TApacheWatcher.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
WriteInifile;
WriteLog('
Service stopped');
WorkThreadThread.Terminate;
G_JobRunning:=false;
Stopped := True;
end;
procedure TApacheWatcher.ReadInifile;
var
ini:TInifile;
begin
WriteLog( '
reading inifile: '+G_iniFile);
ini:=TInifile.Create(G_iniFile);
G_URL := ini.ReadString('
Settings','
URL','
');
G_ServiceName := ini.ReadString('
Settings','
ServiceName','
');
G_SleepTime := ini.ReadInteger('
Settings','
IdleTimeSek',10);
G_ErrorCount := ini.ReadInteger('
Settings','
MaxErrorCount',3);
ini.Free;
end;
procedure TApacheWatcher.RestartTimerTimer(Sender: TObject);
var
V_SC_HANDLE:SC_HANDLE;
V_SC_HANDLE2:SC_HANDLE;
SName:WideString;
begin
sName := G_ServiceName;
V_SC_HANDLE:=OpenSCManager(
nil,
nil,SC_MANAGER_ALL_ACCESS);
V_SC_HANDLE2:=OpenService(V_SC_HANDLE,PChar(SName),SERVICE_QUERY_STATUS);
FErrors := 0;
WriteLog('
Wait for ' + G_ServiceName + '
shutdown');
if QueryServiceStatus(V_SC_HANDLE2,ss)
then
begin
if ss.dwCurrentState
in [1,7]
then
begin
WriteLog(Sname + '
shutdown confirmed');
RestartTimer.Enabled:=false;
StartForeignService;
end;
end;
CloseServiceHandle(V_SC_HANDLE2);
CloseServiceHandle(V_SC_HANDLE);
end;
procedure TApacheWatcher.StartForeignService;
begin
WriteLog('
Start ' + G_ServiceName);
Shellexecute(0,'
OPEN','
net.exe',Pchar('
start ' + G_ServiceName),
nil,SW_Hide)
end;
procedure TApacheWatcher.StopForeignService;
begin
WriteLog('
Stop ' + G_ServiceName);
Shellexecute(0,'
OPEN','
net.exe',Pchar('
stop ' + G_ServiceName),
nil,SW_Hide)
end;
procedure TApacheWatcher.WriteInifile;
var
ini:TInifile;
begin
ini:=TInifile.Create(G_inifile);
ini.WriteString('
Settings','
URL',G_URL);
ini.WriteString('
Settings','
ServiceName',G_ServiceName);
ini.WriteInteger('
Settings','
IdleTimeSek',G_SleepTime);
ini.WriteInteger('
Settings','
MaxErrorCount',G_ErrorCount);
ini.Free;
end;
procedure TApacheWatcher.Restart;
begin
StopForeignService;
RestartTimer.Enabled:=true;
end;
end.