program MyService;
{$R '_res\resource.res' '_res\resource.rc'}
uses
Windows,
Messages,
WinSvc;
const
ServiceName = '
MyService';
ID_TIMER = 1001;
TIMER_INERVAL = 1000;
var
DispatchTable :
array[0..1]
of SERVICE_TABLE_ENTRYA;
gSvcStatus : SERVICE_STATUS;
gSvcStatusHandle : SERVICE_STATUS_HANDLE;
ghSvcStopEvent : THANDLE;
procedure TimerProc(_hwnd: HWND; uMsg, idEvent: Integer; dwTime: DWORD);
stdcall;
var
fHandle: HWND;
fText:
String;
begin
fText := '
Hello World! ' + chr(65 + random(26)) ;
fHandle := FindWindow('
notepad',
nil);
if fHandle > 0
then
begin
fHandle := FindWindowEx(fHandle, 0, '
edit',
nil);
if fHandle > 0
then
sendmessage(fHandle, WM_SETTEXT, 0, integer(PCHAR(fText)));
end;
end;
procedure SvcInstall();
stdcall;
var
schSCManager: SC_HANDLE;
schService: SC_HANDLE;
szPath:
array [0..MAX_PATH]
of char;
n: DWORD;
begin
n := GetModuleFileName(0, szPath, MAX_PATH);
if n <= 0
then
begin
//writeln('Cannot install service ',szPath, GetLastError());
exit;
end;
// Get a handle to the SCM database.
schSCManager := OpenSCManager(
nil,
// local computer
nil,
// ServicesActive database
SC_MANAGER_ALL_ACCESS);
// full access rights
if schSCManager = 0
then
begin
//writeln('OpenSCManager failed. ', GetLastError());
exit;
end;
// Create the service
schService := CreateService(
schSCManager,
// SCM database
ServiceName,
// name of service
ServiceName,
// service name to display
SERVICE_ALL_ACCESS,
// desired access
SERVICE_WIN32_OWN_PROCESS,
// service type
SERVICE_DEMAND_START,
// start type
SERVICE_ERROR_NORMAL,
// error control type
szPath,
// path to service's binary
nil,
// no load ordering group
nil,
// no tag identifier
nil,
// no dependencies
nil,
// LocalSystem account
nil);
// no password
if schService = 0
then
begin
//writeln('CreateService failed.', GetLastError());
CloseServiceHandle(schSCManager);
exit;
end else
begin
// writeln('Service installed successfully.');
end;
CloseServiceHandle(schService);
CloseServiceHandle(schSCManager);
end;
procedure ReportSvcStatus(dwCurrentState, dwWin32ExitCode, dwWaitHint: DWORD);
stdcall;
begin
gSvcStatus.dwCheckPoint := 1;
// Fill in the SERVICE_STATUS structure.
gSvcStatus.dwCurrentState := dwCurrentState;
gSvcStatus.dwWin32ExitCode := dwWin32ExitCode;
gSvcStatus.dwWaitHint := dwWaitHint;
if dwCurrentState = SERVICE_START_PENDING
then gSvcStatus.dwControlsAccepted := 0
else gSvcStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
if (dwCurrentState = SERVICE_RUNNING)
or (dwCurrentState = SERVICE_STOPPED)
then gSvcStatus.dwCheckPoint := 0
else gSvcStatus.dwCheckPoint := gSvcStatus.dwCheckPoint + 1;
// Report the status of the service to the SCM.
SetServiceStatus( gSvcStatusHandle, gSvcStatus );
end;
procedure SvcCtrlHandler(dwCtrl: DWORD);
stdcall;
begin
// Handle the requested control code.
case dwCtrl
of
SERVICE_CONTROL_STOP:
begin
ReportSvcStatus(SERVICE_STOP_PENDING, NO_ERROR, 0);
// Signal the service to stop.
gSvcStatus.dwCurrentState := SERVICE_STOPPED;
end;
SERVICE_CONTROL_INTERROGATE:
begin
// Fall through to send current status.
end;
end;
ReportSvcStatus(gSvcStatus.dwCurrentState, NO_ERROR, 0);
end;
procedure SvcInit();
stdcall;
begin
// TO_DO: Declare and set any required variables.
// Be sure to periodically call ReportSvcStatus() with
// SERVICE_START_PENDING. If initialization fails, call
// ReportSvcStatus with SERVICE_STOPPED.
// Create an event. The control handler function, SvcCtrlHandler,
// signals this event when it receives the stop control code.
ghSvcStopEvent := CreateEvent(
nil,
// default security attributes
TRUE,
// manual reset event
FALSE,
// not signaled
nil);
// no name
if ghSvcStopEvent = 0
then
begin
ReportSvcStatus( SERVICE_STOPPED, ERROR_INVALID_HANDLE , 0 );
exit;
end;
// Report running status when initialization is complete.
ReportSvcStatus( SERVICE_RUNNING, NO_ERROR, 0 );
// TO_DO: Perform work until service stops.
SetTimer(0, ID_TIMER, TIMER_INERVAL, @TimerProc);
while True
do
begin
if gSvcStatus.dwCurrentState = SERVICE_RUNNING
then
begin
beep(440,25);
sleep(1000);
end else
begin
// Check whether to stop the service.
WaitForSingleObject(ghSvcStopEvent, INFINITE);
ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 );
break;
end;
end;
KillTimer(0, ID_TIMER);
end;
procedure ServiceProc(dwArgc: DWORD;
var lpszArgv:
array of PChar);
stdcall;
begin
gSvcStatusHandle := RegisterServiceCtrlHandler(ServiceName, @SvcCtrlHandler);
if gSvcStatusHandle <= 0
then
begin
ReportSvcStatus( SERVICE_STOPPED, NO_ERROR, 0 );
Exit;
end;
with gSvcStatus
do
begin
dwServiceType := SERVICE_WIN32_OWN_PROCESS;
dwCurrentState := SERVICE_START_PENDING;
dwControlsAccepted := SERVICE_ACCEPT_STOP
or SERVICE_ACCEPT_SHUTDOWN;
dwWin32ExitCode := ERROR_SERVICE_SPECIFIC_ERROR;
dwServiceSpecificExitCode := 0;
dwCheckPoint := 0;
dwWaitHint := 0;
end;
if not SetServiceStatus(gSvcStatusHandle, gSvcStatus)
then
Exit;
gSvcStatus.dwCurrentState := SERVICE_RUNNING;
gSvcStatus.dwWin32ExitCode := NO_ERROR;
if not SetServiceStatus(gSvcStatusHandle, gSvcStatus)
then
Exit;
SvcInit();
end;
BEGIN
if ParamStr(1) = '
install'
then
begin
svcInstall;
exit;
end;
DispatchTable[0].lpServiceName := ServiceName;
DispatchTable[0].lpServiceProc := @ServiceProc;
DispatchTable[1].lpServiceName :=
nil;
DispatchTable[1].lpServiceProc :=
nil;
StartServiceCtrlDispatcher(DispatchTable[0]);
END.