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

Delphi , Программа и Интерфейс , Процессы и Сервисы

Автор: Alex Kantchev
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Инсталляция/удаление сервисов под НТ.

Функции для создавания и удаления 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;

Это компонент Delphi, который обеспечивает функции для создания и удаления NT-сервисов. Автор кода - Алекс Канчев.

Функция CreateNTService принимает два параметра: ExecutablePath, это полный путь к исполняемому файлу, от которого будет создан NT-сервис, и ServiceName, это имя сервиса, которое будет отображаться в управлении сервисами. Функция возвращает булевое значение, указывающее, была ли операция успешной.

Функция DeleteNTService принимает один параметр: ServiceName, это имя сервиса для удаления. Функция также возвращает булевое значение, указывающее, была ли операция успешной.

Рассмотрим код:

CreateNTService

1. Открывает управление сервисами с помощью функции OpenSCManager.
2. Создает новый сервис с помощью функции CreateService, передавая handle управления сервисами, имя сервиса и путь к исполняемому файлу как параметры.
3. Если создание успешно, устанавливает переменную FuncRetVal в значение true.
4. Иначе, устанавливает FuncRetVal в значение false.

DeleteNTService

1. Открывает управление сервисами с помощью функции OpenSCManager.
2. Открывает сервис для удаления с помощью функции OpenService, передавая handle управления сервисами и имя сервиса как параметры.
3. Удаляет сервис с помощью функции DeleteService, передавая handle сервиса как параметр.
4. Если удаление успешно, устанавливает переменную FunctRetVal в значение true.
5. Иначе, устанавливает FuncRetVal в значение false.

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

Код предоставляет два примера процедур: Button1Click и Button2Click. Эти процедуры демонстрируют, как использовать функции CreateNTService и DeleteNTService.

В процедуре Button1Click:

• Создает новый NT-сервис с именем, основанным на заголовке приложения.
• Если создание успешно, отображает сообщение об ошибке, указывающее, что сервис был создан.
• Иначе, отображает сообщение об ошибке с кодом ошибки Win32.
• В процедуре Button2Click:
  • Удаляет существующий NT-сервис с именем, основанным на заголовке приложения и суффиксом ('1').
  • Если удаление успешно, отображает сообщение об ошибке, указывающее, что сервис был удален.
  • Иначе, отображает сообщение об ошибке с кодом ошибки Win32.

В целом, этот код обеспечивает полезные функции для управления NT-сервисами в приложениях Delphi.

Представлен код на языке Delphi для создания и удаления сервисов под операционной системой Windows NT.

Комментарии и вопросы

:: Главная :: Процессы и Сервисы ::