buenas a todos, tengo el siguiente codigo que baje de la web
Código:
program Service;
uses
Windows,
WinSvc;
const
ServiceName: pchar = 'AFX Service';
DisplayName: pchar = 'AFX Demo Service';
var
Status: TServiceStatus;
StatusHandle: SERVICE_STATUS_HANDLE;
ServiceTable: array[0..1] of TServiceTableEntry;
Stopped: boolean;
Paused: boolean;
procedure ServiceMain;
begin
repeat
if not Paused then
begin
Beep(1000, 1000);
Sleep(1000);
end;
until Stopped;
end;
procedure ServiceCtrlHandler(Control: dword); stdcall;
begin
case Control of
SERVICE_CONTROL_STOP:
begin
Stopped := True;
Status.dwCurrentState := SERVICE_STOP_PENDING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_PAUSE:
begin
Paused := True;
Status.dwcurrentstate := SERVICE_PAUSED;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_CONTINUE:
begin
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
end;
SERVICE_CONTROL_INTERROGATE: SetServiceStatus(StatusHandle, Status);
SERVICE_CONTROL_SHUTDOWN: Stopped := True;
end;
end;
procedure ServiceCtrlDispatcher(dwArgc: dword; var lpszArgv: pchar); stdcall;
begin
StatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
if StatusHandle <> 0 then
begin
ZeroMemory(@Status, SizeOf(Status));
Status.dwServiceType := SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS;
Status.dwCurrentState := SERVICE_START_PENDING;
Status.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE;
Status.dwWaitHint := 1000;
SetServiceStatus(StatusHandle, Status);
Stopped := False;
Paused := False;
Status.dwCurrentState := SERVICE_RUNNING;
SetServiceStatus(StatusHandle, Status);
ServiceMain;
Status.dwCurrentState := SERVICE_STOPPED;
SetServiceStatus(StatusHandle, Status);
end;
end;
procedure UninstallService(ServiceName: pchar);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service := OpenService(SCManager, ServiceName, SERVICE_ALL_ACCESS);
ControlService(Service, SERVICE_CONTROL_STOP, Status);
DeleteService(Service);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
procedure InstallService(ServiceName, DisplayName: pchar; FileName: string);
var
SCManager: SC_HANDLE;
Service: SC_HANDLE;
Args: pchar;
begin
SCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if SCManager = 0 then Exit;
try
Service := CreateService(SCManager, ServiceName, DisplayName, SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS, SERVICE_AUTO_START, SERVICE_ERROR_IGNORE, pchar(FileName), nil, nil, nil, nil, nil);
Args := nil;
StartService(Service, 0, Args);
CloseServiceHandle(Service);
finally
CloseServiceHandle(SCManager);
end;
end;
begin
if ParamStr(1) = '/i' then
begin
InstallService(ServiceName, DisplayName, ParamStr(0));
end
else if ParamStr(1) = '/u' then
begin
UninstallService(ServiceName);
end
else
begin
ServiceTable[0].lpServiceName := ServiceName;
ServiceTable[0].lpServiceProc := @ServiceCtrlDispatcher;
ServiceTable[1].lpServiceName := nil;
ServiceTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(ServiceTable[0]);
end;
end.
como se ve en el codigo la funcion es hacer un beep cada un segundo para notificar que el servicio esta funcionado correctamente, en windows xp funciona de maravillas, pero en windows 7 no, ya probe ejecutarlo como administrador
uso delphi 2007
gracias por adelantado