Il me semble que cette source est sur le site... (Je l'avais récupérée, mais je ne sais plus où...). Attention, je crois bien qu'il te faut une élévation de privilège (w7) en exécution, et ouvrir Delphi en administrateur pour le debug....
{
*----------------------------------------------*
Utilisation de la librairie WinSVC
et des services Windows.
*----------------------------------------------*
}
unit UServicesNT;
{.DATA}
interface
uses Windows, WinSVC;
function ServiceCreate(SrvName : string; Libelle : string; Chemin : string; Machine : string = '') : Boolean;
function ServiceOpen(SrvName : string; Machine : string = '') : Cardinal;
function ServiceRemove(SrvName : string; Machine : string = '') : Boolean;
function ServiceStart (SrvName : string; Machine : string = '') : Boolean;
function ServiceStop (SrvName : string; Machine : string = '') : Boolean;
function ServiceState(SrvName : string; out oiState : Cardinal; Machine : string = '') : string;
{.CODE}
implementation
{ Ouvre un service }
function ServiceOpen(SrvName : string; Machine : string = '') : Cardinal;
var
H_SC : SC_Handle;
begin
if (Machine = '')
then H_SC := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS)
else H_SC := OpenSCManager(PChar(Machine), nil, SC_MANAGER_ALL_ACCESS);
if (SrvName = '')
then result := H_SC
else Result := OpenService(H_SC, PChar(SrvName), SC_MANAGER_ALL_ACCESS);
end;
{ Créé un service }
function ServiceCreate(SrvName : string; Libelle : string; Chemin : string; Machine : string = '') : Boolean;
var
H_SC : SC_Handle;
H_Sr : SC_Handle;
begin
Result := False;
H_SC := ServiceOpen( '', Machine);
if (H_SC > 0) then begin
H_Sr := CreateService( H_SC,
PChar( SrvName ),
PChar( Libelle ),
SC_MANAGER_ALL_ACCESS,
SERVICE_WIN32_OWN_PROCESS,
SERVICE_AUTO_START,
SERVICE_ERROR_IGNORE,
PChar( Chemin ),
nil,
nil,
nil,
nil,
nil );
Result := (H_Sr > 0);
CloseServiceHandle(H_Sr);
CloseServiceHandle(H_SC);
end;
end;
{ Supprime un service }
function ServiceRemove(SrvName : string; Machine : string = '') : Boolean;
var
SrvHandle : Cardinal;
begin
Result := False;
SrvHandle := ServiceOpen(SrvName, Machine);
try
Result := DeleteService(SrvHandle);
finally
CloseServiceHandle(SrvHandle);
end;
end;
{ Démarre un service }
function ServiceStart(SrvName : string; Machine : string = '') : Boolean;
var
SrvHandle : Cardinal;
ServiceArgVectors : PAnsiChar;
SrvState : _SERVICE_STATUS;
begin
Result := False;
ServiceArgVectors := nil;
SrvHandle := ServiceOpen(SrvName, Machine);
try
Result := (StartService(SrvHandle, 0, PWideChar(ServiceArgVectors)));
finally
CloseServiceHandle(SrvHandle);
end;
end;
{ Arrête un service }
function ServiceStop(SrvName : string; Machine : string = '') : Boolean;
var
SrvHandle : Cardinal;
ServiceArgVectors : PAnsiChar;
SrvState : _SERVICE_STATUS;
begin
Result := False;
ServiceArgVectors := nil;
SrvHandle := ServiceOpen(SrvName, Machine);
try
Result := ControlService(SrvHandle, SERVICE_CONTROL_STOP, SrvState);
(*
Si çà vous interesse, les différents autres status sont :
- SERVICE_CONTROL_STOP
- SERVICE_CONTROL_PAUSE
- SERVICE_CONTROL_CONTINUE
- SERVICE_CONTROL_INTERROGATE
- SERVICE_CONTROL_SHUTDOWN
*)
finally
CloseServiceHandle(SrvHandle);
end;
end;
{ Renvoi l'etat actuel du service }
function ServiceState(SrvName : string; out oiState : Cardinal; Machine : string = '') : string;
var
SrvHandle : Cardinal;
SrvState : _SERVICE_STATUS;
begin
SrvHandle := ServiceOpen(SrvName, Machine);
try
if not (QueryServiceStatus(SrvHandle, SrvState)) then begin
oiState := 0;
Result := 'Inexistant';
end
else begin
oiState := SrvState.dwCurrentState;
case oiState of
SERVICE_CONTINUE_PENDING : Result := 'Relancé après une opération continue';
SERVICE_PAUSE_PENDING : Result := 'Relancé après une opération pause';
SERVICE_PAUSED : Result := 'Pause';
SERVICE_RUNNING : Result := 'Démarré';
SERVICE_START_PENDING : Result := 'Démarrage';
SERVICE_STOP_PENDING : Result := 'Arrêt';
SERVICE_STOPPED : Result := 'Arrêté';
else Result := 'Etat du service inconnu ou service inexistant !';
end;
end;
finally
CloseServiceHandle( SrvHandle );
end;
end;
end.