Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 21-06-2013
javivalle javivalle is offline
Registrado
NULL
 
Registrado: jun 2013
Posts: 1
Poder: 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
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
funciona bien en windows 7 64b pero en XP no funciona ASAPLTDA Varios 5 06-05-2011 16:24:50
Funciona el Firebird Embeded en un servicio de Windows? mcs Firebird e Interbase 2 16-03-2010 12:18:41
"system error code 1057 " al instalar servicio de windows jangel_ramirezm API de Windows 1 03-12-2009 13:59:50
Instalar un servicio de Windows maikeloh API de Windows 1 24-02-2007 15:19:42
Problemas al instalar nuevo servicio Ezecool Varios 0 01-10-2003 01:02:51


La franja horaria es GMT +2. Ahora son las 06:56:34.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi