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

=== Инсталляция/удаление сервисов под NT ===
{ **** UBPFD *********** by kladovka.net.ru ****
>> Инсталляция/удаление сервисов под NT.
Функции для создавания и удаления 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
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;
ID: 02245