Ver Mensaje Individual
  #1  
Antiguo 21-06-2013
javivalle javivalle is offline
Registrado
NULL
 
Registrado: jun 2013
Posts: 1
Reputación: 0
javivalle Va por buen camino
instalar servicio no funciona en windows 7

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
Responder Con Cita