Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Инсталляция / удаление сервисов под NT

01.01.2007
{ **** UBPFD *********** by kladovka.net.ru ****
>> Инсталляция/удаление сервисов под НТ.
 
Функции для создавания и удаления NT Services. Можно создать NT Service от текущее приложение. Параметры:
1. CreateNTService(ExecutablePath,ServiceName: String)
ExecutablePath - Полный путь к изполнимого файла от которого создавается NT Service
ServiceName - Имя сервиза которое отобразится в Service Control Manager
Результат:
true - если операциая завершена успешно
false - если есть ошибка. Можно произвести call то GetLastError чтобы информироваться об естество ошибки
2. DeleteNTService(ServiceName: String):boolean;
ServiceName - имя сервиза подлежающии удаления
Результат:
true - если операциая завершена успешно
false - если есть ошибка. Можно произвести call то GetLastError чтобы
информироваться об естество ошибки
 
Зависимости: WinSVC, Windows
Автор:       Alex Kantchev, stoma@bitex.bg
Copyright:   Собственное написание
Дата:        19 июня 2002 г.
********************************************** }
 
// CreateNTService(ExecutablePath,ServiceName: String)
// ExecutablePath - Полный путь к изполнимого файла от
// которого создавается NT Service
// ServiceName - Имя сервиза которое отобразится
// в Service Control Manager Результат:
//Результат:
// true - если операциая завершена успешно
// false - если есть ошибка. Можно произвести
// call то GetLastError чтобы информироваться об
// естество ошибки
function CreateNTService(ExecutablePath,ServiceName: String):boolean;
var
 hNewService
,hSCMgr: SC_HANDLE;
// Rights: DWORD;
 
FuncRetVal: Boolean;
begin
 
FuncRetVal := False;
 hSCMgr
:= OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);
 
if (hSCMgr <> 0 ) then
 
begin
   
//Custom service access rights may be built here
   
//we use GENERIC_EXECUTE which is combination of
   
//STANDARD_RIGHTS_EXECUTE, SERVICE_START, SERVICE_STOP,
   
//SERVICE_PAUSE_CONTINUE, and SERVICE_USER_DEFINED_CONTROL
   
//You can create own rights and use them as shown in the
   
//commented line below.
 
   
//Rights := STANDARD_RIGHTS_REQUIRED or SERVICE_START or SERVICE_STOP
   
// or SERVICE_QUERY_STATUS or SERVICE_PAUSE_CONTINUE or
   
// SERVICE_INTERROGATE;
 
   hNewService
:= CreateService(hSCMgr,PChar(ServiceName),PChar(ServiceName),
                                STANDARD_RIGHTS_REQUIRED
,SERVICE_WIN32_OWN_PROCESS,
                                SERVICE_DEMAND_START
,SERVICE_ERROR_NORMAL,
                               
PChar(ExecutablePath),nil,nil,nil,nil,nil);
   
CloseServiceHandle(hSCMgr);
   
if (hNewService <> 0) then
   
FuncRetVal := true
   
else
   
FuncRetVal := false;
 
end;
 
CreateNTService := FuncRetVal;
end;
 
// ***
 
//DeleteNTService(ServiceName: String):boolean;
// ServiceName - имя сервиза подлежающии удаления
//Результат:
// true - если операциая завершена успешно
// false - если есть ошибка. Можно произвести call то GetLastError чтобы
// информироваться об естество ошибки
 
function DeleteNTService(ServiceName: String):boolean;
var
 hServiceToDelete
,hSCMgr: SC_HANDLE;
 
RetVal: LongBool;
 
FunctRetVal: Boolean;
begin
 
FunctRetVal := false;
 hSCMgr
:= OpenSCManager(nil,nil,SC_MANAGER_CREATE_SERVICE);
 
if (hSCMgr <> 0 ) then
 
begin
   hServiceToDelete
:= OpenService(hSCMgr, PChar(ServiceName), SERVICE_ALL_ACCESS);
   
RetVal := DeleteService(hServiceToDelete);
   
CloseServiceHandle(hSCMgr);
   
FunctRetVal := RetVal;
 
end;
   
DeleteNTService := FunctRetVal;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
 tmpS
: String;
begin
   tmpS
:= 'Delphi_Service_'+Application.Title;
   
if (CreateNTService(Application.ExeName,tmpS)) then
     
MessageDlg('Service '+tmpS+' has been successfully created!',mtInformation,[mbOK],0)
   
else
     
MessageDlg('Unable to create service '+tmpS+' Win32 Error code: '+IntToStr(GetLastError),mtWarning,[mbOK],0);
end;
 
procedure TForm1
.Button2Click(Sender: TObject);
var
 tmpS
: String;
begin
 tmpS
:= 'Delphi_Service_'+Application.Title+'1';
 
if (DeleteNTService(tmpS)) then
     
MessageDlg('Service '+tmpS+' has been successfully deleted!',mtInformation,[mbOK],0)
 
else
     
MessageDlg('Unable to delete service '+tmpS+' Win32 Error code: '+IntToStr(GetLastError),mtWarning,[mbOK],0);
end;