Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Доработка TService, Внедрение HandlerEx 
V
    Опции темы
kami
Дата 28.5.2012, 23:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Попробую рассказать, как я «доработал» стандартный модуль SvcMgr.pas для того, чтобы он отвечал последним реалиям работы в Windows. Сразу оговорюсь – я не претендую на полноту изложения. Эта тема (до статьи, конечно, не дотягивает, хотя бы из-за вольности и неточности формулировок) рассчитана на тех, кто знает о том, что такое MSDN, может создавать потоки в Delphi и работать с ними, имеет общее представление о сервисах и исходниках VCL. Гуру вряд ли найдут для себя что-то полезное, но если помогут исправить ошибки изложения, то заранее большое спасибо. К сожалению, много материала останется «за кадром», но с учетом требования к «знанию, что такое MSDN» самостоятельное изучение не должно оказаться трудным. По ходу изложения опускаться до комментирования каждой строчки я считаю излишним, хотя иногда буду smile . Примечание – текст писался за один день, «на одном дыхании», так что критиковать прошу только по существу.

Краткий «экскурс в историю»:
Думаю, каждый, кто недавно столкнулся с необходимостью написать сервис, обратил внимание на то, что уже установленные на компьютере службы имеют такие параметры как «Описание», «Параметры восстановления» и т.п. К сожалению, имеющимися средствами Delphi их установить невозможно. А так хотелось бы. Кроме того, службы могут воспринимать сообщения о смене пользователя, о подключении/отключении устройств и т.д. Это так же не предусмотрено в Delphi.

Здесь я постараюсь рассказать, как устранить этот недостаток. Опорная версия Delphi – 2010. Посему, чтобы избежать недоразумений, расскажу как и что изменялось, чтобы владельцы других версий Delphi (в большей части это касается до-юникодных) также могли воспользоваться преимуществами «апгрейда».

Добавлено через 17 секунд
ПОЭТАПНАЯ МОДЕРНИЗАЦИЯ.
Подготовительные мероприятия.
В первую очередь нам понадобится создать новый сервис (зачем – расскажу в конце). Сохраните созданный проект куда-нибудь в отдельную папку, чтобы облегчить себе дальнейшую работу.
Кроме того, понадобится исходник SvcMgr.pas. Откройте его непосредственно в Delphi (для версии 2010 этот файл лежит в папке $(BDS)\Source\Win32\vcl\) и сохраните как SvcMgrEx.pas в папку с созданным проектом сервиса. Менять будем в основном этот файл, чтобы не портить генофонд Delphi.
В созданном модуле сервиса (Unit1.pas) и в .dpr файле в uses заменить SvcMgr на SvcMgrEx.
В принципе, подготовительные мероприятия закончились, можно приступать.
В дальнейшем, если не оговорено особо, весь код будет относиться именно к SvcMgrEx.pas.

От простого – к сложному. SvcMgrEx.pas
Сперва постараемся сделать так, чтобы наш сервис мог выполнять то, что чаще всего встречается в вопросах – менять свое описание и действия при сбое.
За эти вещи в Windows отвечает функция ChangeServiceConfig2, находящаяся в библиотеке advapi32. Рассматривать будем ее юникодный вариант, так как Ansi-вариант обладал какими-то глюками. Сейчас уже не вспомню, что это были за глюки, но – лучше не рисковать.
Во-первых, нужно объявить эту функцию. Прототип объявим в interface-секции модуля, место определите сами, я сделал это перед
Код

var
  Application: TServiceApplication = nil;

Объявляем:
Код

type
  TChangeServiceConfig2 = function(scHandle: SC_HANDLE; dwInfoLevel: DWord; lpInfo: pointer): BOOL; stdcall;
var
  advapi32: THandle; // хендл библиотеки, содержащей нужную функцию
  ChangeServiceConfig2: TChangeServiceConfig2; // ну и сама функция

Но – объявить мало, нужно еще получить ее адрес. Для этого вносим изменения в initialization. После изменений она будет выглядеть как-то так:
Код

initialization
advapi32 := LoadLibrary('advapi32.dll');
if advapi32 <> 0 then
  begin
    ChangeServiceConfig2 := GetProcAddress(advapi32, 'ChangeServiceConfig2W');
  end
else
  begin
    ChangeServiceConfig2 := nil;
  end;
InitApplication;

finalization
DoneApplication;
FreeLibrary(advapi32);
end.


Начало положено. Теперь разберемся с параметрами ChangeServiceConfig2:
1.    scHandle: хендл сервиса, параметры которого подлежат изменению. В самом сервисе он неизвестен, придется его получить.
2.    dwInfoLevel: определяет что именно нужно изменить. Возможные варианты этого параметра – чуть ниже.
3.    lpInfo: указатель на новые данные изменяемого параметра. Что именно должно содержаться здесь – зависит от dwInfoLevel.
Объявим константы, которые воспринимаются в dwInfoLevel. С двумя разберемся здесь, остальные оставляю на самостоятельное изучение. Место можете выбрать сами, но желательно – в секции interface модуля SvcMgrEx:
Код

  // коды, воспринимаемые в ChangeServiceConfig2, параметр dwInfoLevel
const
  SERVICE_CONFIG_DESCRIPTION = 1;
  SERVICE_CONFIG_FAILURE_ACTIONS = 2;
  SERVICE_CONFIG_DELAYED_AUTO_START_INFO = 3;
  SERVICE_CONFIG_FAILURE_ACTIONS_FLAG = 4;
  SERVICE_CONFIG_SERVICE_SID_INFO = 5;
  SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO = 6;
  SERVICE_CONFIG_PRESHUTDOWN_INFO = 7;


Каждому из кодов соответствует своя структура, передаваемая через параметр lpInfo. Объявим их все сразу (рядом с константами для dwInfoLevel), чтобы по нескольку раз не возвращаться к этому:
Код

// ==========================================================================
  // ========= новые объявления типов WinAPI для ChangeConfigService2, параметр lpInfo ======
  // =========================================================================
type
// для SERVICE_CONFIG_DESCRIPTION
  _SERVICE_DESCRIPTION = record
    lpDescription: PWideChar;
  end;
  SERVICE_DESCRIPTION = _SERVICE_DESCRIPTION;
  TServiceDescription = _SERVICE_DESCRIPTION;
  PServiceDescription = ^_SERVICE_DESCRIPTION;

// для SERVICE_CONFIG_FAILURE_ACTIONS
  SC_ACTION_TYPE = (SC_ACTION_NONE, SC_ACTION_RESTART, SC_ACTION_REBOOT, SC_ACTION_RUN_COMMAND);
  _SC_ACTION = record
    Type_:SC_ACTION_TYPE;
    Delay: DWord;
  end;
  SC_ACTION = _SC_ACTION;
  TSC_Action = _SC_ACTION;
  PSC_Action = ^_SC_ACTION;

  _SERVICE_FAILURE_ACTIONS = record
    dwResetPeriod: DWord;
    lpRebootMsg: PWideChar;
    lpCommand: PWideChar;
    cActions: DWord;
    lpsaActions: PSC_Action;
  end;
  SERVICE_FAILURE_ACTIONS = _SERVICE_FAILURE_ACTIONS;
  TServiceFailureActions = _SERVICE_FAILURE_ACTIONS;
  P_SERVICE_FAILURE_ACTIONS = ^_SERVICE_FAILURE_ACTIONS;
  PServiceFailureActions = ^_SERVICE_FAILURE_ACTIONS;


// для  SERVICE_CONFIG_DELAYED_AUTO_START_INFO
  _SERVICE_DELAYED_AUTO_START_INFO = record
    fDelayedAutostart: BOOL;
  end;
  SERVICE_DELAYED_AUTO_START_INFO = _SERVICE_DELAYED_AUTO_START_INFO;
  TServiceDelayedAutoStartInfo = _SERVICE_DELAYED_AUTO_START_INFO;
  PSERVICE_DELAYED_AUTO_START_INFO = ^_SERVICE_DELAYED_AUTO_START_INFO;
  PServiceDelayedAutoStartInfo = ^_SERVICE_DELAYED_AUTO_START_INFO;

// для SERVICE_CONFIG_FAILURE_ACTIONS_FLAG
  _SERVICE_FAILURE_ACTIONS_FLAG = record
    fFailureActionsOnNonCrashFailures: BOOL;
  end;
  SERVICE_FAILURE_ACTIONS_FLAG = _SERVICE_FAILURE_ACTIONS_FLAG;
  TServiceFailureActionsFlag = _SERVICE_FAILURE_ACTIONS_FLAG;
  PSERVICE_FAILURE_ACTIONS_FLAG = ^_SERVICE_FAILURE_ACTIONS_FLAG;
  PServiceFailureActionsFlag = ^_SERVICE_FAILURE_ACTIONS_FLAG;


// для SERVICE_CONFIG_SERVICE_SID_INFO
  _SERVICE_SID_INFO = record
    dwServiceSidType: DWord;
  end;
  SERVICE_SID_INFO = _SERVICE_SID_INFO;
  TServiceSIDInfo = _SERVICE_SID_INFO;
  PSERVICE_SID_INFO = ^_SERVICE_SID_INFO;
  PServiceSIDInfo = ^_SERVICE_SID_INFO;


// для SERVICE_CONFIG_PRESHUTDOWN_INFO
  _SERVICE_PRESHUTDOWN_INFO = record
    dwPreshutdownTimeout: DWord;
  end;
  SERVICE_PRESHUTDOWN_INFO = _SERVICE_PRESHUTDOWN_INFO;
  TServicePreshutdownInfo = _SERVICE_PRESHUTDOWN_INFO;
  PSERVICE_PRESHUTDOWN_INFO = ^_SERVICE_PRESHUTDOWN_INFO;
  PServicePreshutdownInfo = ^_SERVICE_PRESHUTDOWN_INFO;


// для  SERVICE_CONFIG_REQUIRED_PRIVILEGES_INFO
  _SERVICE_REQUIRED_PRIVILEGES_INFO = record
    pmszRequiredPrivileges: PWideChar;
  end;
  SERVICE_REQUIRED_PRIVILEGES_INFO = _SERVICE_REQUIRED_PRIVILEGES_INFO;
  TServiceRequiredPrivilegesInfo = _SERVICE_REQUIRED_PRIVILEGES_INFO;
  PSERVICE_REQUIRED_PRIVILEGES_INFO = ^_SERVICE_REQUIRED_PRIVILEGES_INFO;
  PServiceRequiredPrivilegesInfo = ^_SERVICE_REQUIRED_PRIVILEGES_INFO;

  // ================================================================================
  // ===================== некоторые виды lpEventData из HandlerEx ==================
  // ================================================================================
  tagWTSSESSION_NOTIFICATION = record
    cbSize: DWORD;
    dwSessionId: DWORD;
  end;
  WTSSESSION_NOTIFICATION = tagWTSSESSION_NOTIFICATION;
  PWTSSESSION_NOTIFICATION = ^tagWTSSESSION_NOTIFICATION;
  TWtsSessionNotification = tagWTSSESSION_NOTIFICATION;
  PWtsSessionNotification = PWTSSESSION_NOTIFICATION;

  _SERVICE_TIMECHANGE_INFO = record
    liNewTime: LARGE_INTEGER;
    liOldTime: LARGE_INTEGER;
  end;
  SERVICE_TIMECHANGE_INFO = _SERVICE_TIMECHANGE_INFO;
  TServiceTimechangeInfo = _SERVICE_TIMECHANGE_INFO;
  PServiceTimechangeInfo = ^_SERVICE_TIMECHANGE_INFO;
  PSERVICE_TIMECHANGE_INFO = ^_SERVICE_TIMECHANGE_INFO;

  // ==================================================================================
  // ======================= конец новых объявлений типов=============================
  // ==================================================================================


Теперь – самое интересное.
Объявим новое public – свойство для TService (надеюсь, ни для кого не является секретом, что нажав Ctrl+Shift+C, когда курсор находится внутри описания класса, Delphi сгенерирует нужные методы и приватные поля):
Код

TService = class(TDataModule)

public

  property Description: String read FDescription write SetDescription;



И реализацию сеттера:
Код

procedure TService.SetDescription(const Value: String);
var
  Desc: TServiceDescription;
  hSCM, hService: THandle;
begin
  if Assigned(ChangeServiceConfig2) then
    if GetServiceHandles(hSCM, hService) then
      begin
        Desc.lpDescription := AllocMem(Length(Description) * SizeOf(WideChar) + SizeOf(WideChar));
        // обратите внимание, что приведена реализация для Unicode версий Delphi, т.е. начиная с D2009
        // для Ansi-версий нужно преобразование String>PWideChar, найдите его сами
        Move(Description[1], Desc.lpDescription^, Length(Description) * SizeOf(Char));
        if ChangeServiceConfig2(hService, SERVICE_CONFIG_DESCRIPTION, @Desc) then
          FDescription := Value;

        FreeMem(Desc.lpDescription);

        FreeServiceHandles(hSCM, hService);
      end;
end;


Вроде, по коду всё должно быть понятно, за исключением Get и FreeServiceHandles. Эти методы предназначены для получения и освобождения хендла сервиса, который необходим для работы ChangeServiceConfig2. Реализация этих методов такая:
Код

function TService.GetServiceHandles(var SCManagerHandle, ServiceHandle: THandle): Boolean;
begin
  Result := False;
  SCManagerHandle := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if SCManagerHandle <> 0 then
    begin
      ServiceHandle := OpenService(SCManagerHandle, PChar(Name), SERVICE_ALL_ACCESS);
      if ServiceHandle <> 0 then
        Result := True
      else
        CloseServiceHandle(SCManagerHandle);
    end;
end;

procedure TService.FreeServiceHandles(SCManagerHandle, ServiceHandle: THandle);
begin
  CloseServiceHandle(ServiceHandle);
  CloseServiceHandle(SCManagerHandle);
end;


С описанием - всё.
Использовать – проще простого: в любом месте модуля сервиса (Unit1.pas) (думаю, лучше всего сделать это в OnAfterInstall) пишем:
Код

procedure TService1.ServiceAfterInstall(Sender: TService);
begin
  Description:='мой новый супер-сервис';
end;


Добавлено через 3 минуты и 49 секунд
Теперь – о действиях сервиса при сбое.
За них отвечает структура SERVICE_FAILURE_ACTIONS:
    dwResetPeriod: через какое количество секунд сбрасывается счетчик сбоев сервиса
    lpRebootMsg: сообщение, которое будет выведено перед перезагрузкой компьютера, если сервис будет аварийно завершен. Учитывается, если одним из действий при сбое сервиса будет указана перезагрузка;
    lpCommand: командная строка для запуска приложения, если сервис будет аварийно завершен. Учитывается, если при сбое сервиса одним из действий будет указан запуск приложения;
    cActions: количество действий в lpsaActions
    lpsaActions: указатель на массив действий, предпринимаемых при сбое сервиса. Если посмотреть в менеджере служб на закладку «Восстановление» любой службы, все вопросы должны отпасть сами собой. Если нет – отправляю вас читать MSDN.

Сам метод:
Код

function TService.SetFailureActions(ResetPeriod: DWord; RebootMSG, Command: String; Actions: array of TSC_Action): boolean;
var
  sfa: TServiceFailureActions;
  hSCM, hService: THandle;
  tmpActions: array of TSC_Action;
  i: Integer;
begin
  Result:=False;
  if Assigned(ChangeServiceConfig2) then
    if GetServiceHandles(hSCM, hService) then
      begin
        // к сожалению, Actions содержит мусор между полями.
        // если передавать в ChangeServiceConfig2 непосредственно параметр Actions,
        // то будет возвращено "Неверный параметр". Посему - нужно заполнить
        // промежутки между полями TSC_Action нулями.
        SetLength(tmpActions, Length(Actions));
        if Length(Actions)<>0 then
          begin
            FillChar(tmpActions[0], Length(Actions)*SizeOf(TSC_Action), 0);
            for i := 0 to Length(Actions)-1 do
              begin
                tmpActions[i].Type_ := Actions[i].Type_;
                tmpActions[i].Delay := Actions[i].Delay;
              end;
          end;

        sfa.dwResetPeriod := ResetPeriod;
        sfa.lpRebootMsg := PChar(RebootMSG);
        sfa.lpCommand := PChar(Command);
        sfa.cActions := Length(tmpActions);
        sfa.lpsaActions := Pointer(tmpActions);

        Result:=ChangeServiceConfig2(hService, SERVICE_CONFIG_FAILURE_ACTIONS, @sfa);

        FreeServiceHandles(hSCM, hService);
      end;
end;


Вызов, опять-таки, достаточно прост. Дополним тот же метод в модуле сервиса (Unit1.pas):
Код

procedure TService1.ServiceAfterInstall(Sender: TService);
var
  ac: array[0..0] of SC_ACTION; // действие при сбое у нас будет одно
begin
  Self.Description:='myService - cool';

  ac[0].Type_:=SC_ACTION_RESTART; // сервис будет перезапускаться
  ac[0].Delay:=1000; // через одну секунду
  SetFailureActions(1, '', '', ac);
end;


Добавлено через 5 минут и 3 секунды
С простыми вещами разобрались. Перейдем к более сложному, но и более интересному – получению сервисом дополнительных сообщений (или контрольных кодов) о смене сессии, подключении/отключении устройств и так далее.

SvcMgrEx.pas.
Большое лирическое отступление, необходимое для понимания вносимых изменений (с некоторыми прегрешениями против истины для простоты изложения).
Сервис получает указания от SCM или других приложений через специальную функцию - Handler. C небольшой натяжкой ее можно сравнить с оконной функцией десктопного приложения. Через Handler сервис получает команды на остановку, постановку на паузу и продолжение работы, завершение работы и запрос статуса. Также через Handler могут передаваться другие команды, определяемые пользователем (они посылаются через функцию ControlService). То, что сервис не смог обработать самостоятельно, то есть – не знает о таких командах, он отдает в protected-метод DoCustomControl на откуп программисту. Полный перечень команд, пересылаемых в Handler смотрите в MSDN.
Сама функция – Handler находится в каждом модуле сервиса, создаваемого с помощью команды File =>New =>Service. Выглядит она так:
Код

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

Windows «знает» только об этой функции – она указывается системе при запуске сервиса. Все команды сервису пересылаются именно через нее. Как видно из кода, сервис обрабатывает полученную команду в методе Controller. Если посмотреть «внутрь» этого метода, то увидим следующее:
Код

procedure TService.Controller(CtrlCode: DWord);
begin
  PostThreadMessage(ServiceThread.ThreadID, CM_SERVICE_CONTROL_CODE, CtrlCode, 0);
  if ServiceThread.Suspended then
    ServiceThread.Resume;
end;

Оказывается, сервис просто переправляет полученную команду потоку ServiceThread и при необходимости «пробуждает» этот поток. Это сделано не случайно: Microsoft очень настоятельно рекомендует не задерживать обработку полученных команд и возвратить управление системе как можно быстрее. Настоящая обработка команды будет идти позже, когда управление будет передано ServiceThread-у. Именно из ServiceThread-а будут вызываться события, относящиеся к принятой команде, к примеру OnContinue, OnStop и так далее. В том числе в дополнительном потоке будет вызвано событие OnExecute, которое, правда, не требует команды от системы. 
Промежуточный вывод – практически весь код любого создаваемого в Delphi сервиса работает в дополнительном потоке. Полный вывод делайте сами, если еще не прочитали статью «Многопоточность – как это делается в Delphi» - настоятельно рекомендую ознакомиться с ней.

К сожалению, нам для полноценной работы сервиса Handler-функция не подойдет. Она не в состоянии воспринять большинство из того, что нас интересует. Поэтому придется воспользоваться другим обработчиком – HandlerEx. Он регистрируется функцией RegisterServiceCtrlHandlerEx, которая объявлена в той же библиотеке – advapi32.dll (в отличие от обычного Handler – обработчика, который регистрируется функцией RegisterServiceCtrlHandler). Значит, опять изменения в SvcMgrEx.pas. Новый код буду показывать рядом с уже введенным, чтобы не останавливаться на том «а куда его писать»:
Объявляем и получаем функцию:
Код

TRegisterServiceCtrlHandlerEx = function(lpServiceName: PChar; lpHandlerProc: TFarProc;
    lpContext: pointer): SERVICE_STATUS_HANDLE; stdcall;
  TChangeServiceConfig2 = function(scHandle: SC_HANDLE; dwInfoLevel: DWord; lpInfo: pointer): BOOL; stdcall;
……………………………………………
var
  advapi32: THandle;
  RegisterServiceCtrlHandlerEx: TRegisterServiceCtrlHandlerEx;
……………………………………………
initialization

advapi32 := LoadLibrary('advapi32.dll');
if advapi32 <> 0 then
  begin
    RegisterServiceCtrlHandlerEx := GetProcAddress(advapi32, 'RegisterServiceCtrlHandlerExW');
    ChangeServiceConfig2 := GetProcAddress(advapi32, 'ChangeServiceConfig2W');
  end
else
  begin
    RegisterServiceCtrlHandlerEx := nil;
    ChangeServiceConfig2 := nil;
  end;
InitApplication;

finalization
DoneApplication;
FreeLibrary(advapi32);
end.


Кроме этого, нужно объявить и HandlerEx. Рекомендую найти в SvcMgr.pas объявление TServiceController и написать новое определение рядом. У меня получилось так:
Код

TServiceController = procedure(CtrlCode: DWord); stdcall;
  {$IFEND} // это остаток от условной директивы про CLR. Если у вас такого нет – писать не надо.
  TServiceControllerEx = function(dwControl: DWord; dwEventType: DWord; lpEventData, lpContext: pointer): BOOL; stdcall;

TServiceControllerEx – это и есть прототип нашей будущей HandlerEx-функции, а TServiceController – объявленный изначально Handler.

Ну хорошо, «регистратор» и прототип HandlerEx объявлены. Но толку от этого пока мало – нужно «сказать» Delphi, что нас больше не интересует Handler, а мы хотим использовать HandlerEx. Естественно – если функция RegisterServiceCtrlHandlerEx была найдена, в противном случае нужно продолжить использовать «стандартный» Handler. Для этого сделаем следующее:
1.    Объявляем новые константы и обработчик команд сервиса в protected-секции. После изменений код будет выглядеть примерно так:

Код

  // коды, которые при приеме попадают в DoCustomControlEx.
  // Естественно, если возможность их приема определена в TService.AllowAdditionalControls
  // (с этим разберемся позже).
const
  SERVICE_CONTROL_DEVICEEVENT = $0B;
  SERVICE_CONTROL_HARDWAREPROFILECHANGE = $0C;
  SERVICE_CONTROL_POWEREVENT = $0D;
  SERVICE_CONTROL_SESSIONCHANGE = $0E;
  SERVICE_CONTROL_TIMECHANGE = $10;
  SERVICE_CONTROL_TRIGGEREVENT = $20;

TService = class(TDataModule)
……………….
  protected
………………
    procedure Controller(CtrlCode: DWord);  // эта строка была.
    function ControllerEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean;

………………
Реализацию метода ControllerEx пока оставим пустой, немного не до него сейчас

2.    Там же, но уже в public-секции объявим еще один метод:
Код

TService = class(TDataModule)
……………….
public
……………….
    function GetServiceController: TServiceController; virtual; abstract; // это было
    function GetServiceControllerEx: TServiceControllerEx; virtual;


Реализация GetServiceControllerEx выглядит просто:
Код

function TService.GetServiceControllerEx: TServiceControllerEx;
begin
  Result := nil;
end;

Почему nil? А вдруг вам будет нужна обычная реализация сервиса, без всяких дополнительных возможностей? Тогда в своем модуле сервиса можно будет просто не объявлять ничего, и пользоваться стандартным кодом VCL.
3.    Модернизируем модуль сервиса (Unit1.pas):
Код

type
  TService1 = class(TService)
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override; // это было
    function GetServiceControllerEx: TServiceControllerEx; override;
…………………………………………
Implementation
……………………..
function ServiceControllerEx(dwControl: DWord; dwEventType: DWord; lpEventData, lpContext: pointer): BOOL; stdcall;
begin
  Result := Service1.ControllerEx(dwControl, dwEventType, lpEventData, lpContext);
end;

function TService1.GetServiceControllerEx: TServiceControllerEx;
begin
  Result := ServiceControllerEx;
end;
………………………………..

Подготовительные мероприятия завершены.
4.    Теперь – модернизируем непосредственно код (в SvcMgrEx.pas), который говорит Windows использовать нужный нам обработчик. Этот код находится в методе TService.Main. Особенностей модернизации будет несколько: во-первых, может не быть функции RegisterServiceCtrlHandlerEx, во-вторых – вы в модуле сервиса можете не перекрыть функцию TService1.GetServiceControllerEx. В обоих случаях использовать «расширенную версию» контроллера нельзя.
Код

procedure TService.Main(Argc: DWord; Argv: PLPSTR);
type
  PPCharArray = ^TPCharArray;
  TPCharArray = array [0 .. 1024] of PChar;
var
  I: Integer;
  Controller: TServiceController;
  ControllerEx: TServiceControllerEx;
begin
………………
  ControllerEx := GetServiceControllerEx(); // пытаемся получить адрес функции, которая будет
  // выступать в качестве HandlerEx. (смотри п.3).
  // если метод GetServiceControllerEx не перекрыт в модуле сервиса, 
  // то оригинальный метод, объявленный в п.2 вернет nil.
  if Assigned(ControllerEx) and Assigned(RegisterServiceCtrlHandlerEx) then
    begin // если всё объявлено, регистрируем расширенный обработчик
      FStatusHandle := RegisterServiceCtrlHandlerEx(PChar(Name), @ControllerEx, nil);
    end
  else
    begin // иначе – действуем по умолчанию, этот код присутствовал в оригинальном SvcMgr
      Controller := GetServiceController();
      FStatusHandle := RegisterServiceCtrlHandler(PChar(Name), @Controller);
    end;
………………………..
end;


Добавлено через 11 минут и 49 секунд
Итак, что мы имеем на текущий момент? Давайте рассмотрим всё накодированное в порядке использования:
Во-первых, когда сервис инсталлирован в системе, то при старте (опустим всякие «промежуточные» методы) вызывается метод TService.Main (см. пункт 4). В нем проверяется выполнение условий по наличию нужных нам функций (т.е. наличие RegisterServiceCtrlHandlerEx, в модуле сервиса (Unit1.pas) объявлена функция ServiceControllerEx и указатель на нее возвращается методом GetServiceControllerEx). Если всё удачно, то обработчиком команд сервиса назначается функция ServiceControllerEx, объявленная в модуле Unit1.pas. Если же нет, то обработчиком остается «стандартная» функция ServiceController,
C запуском сервиса разобрались. Теперь – о порядке работы сервиса при получении какой-либо команды.
Когда системе нужно передать что-либо сервису, она вызывает функцию ServiceControllerEx, объявленную в модуле Unit1.pas. Смотрим п.3 – единственной задачей этой функции является передача всех полученных параметров в метод ControllerEx нашего сервиса. А его мы в п.1 оставили пустым. Настало время заняться им вплотную. Причем – действовать будем по образу и подобию метода TService.Controller (я говорил раньше о рекомендациях Microsoft по поводу скорейшего возвращения из обработчика, будь то Handler или HandlerEx). Но для начала – нужно еще несколько подготовительных мероприятий.
Основная проблема на текущем этапе в том, что в метод ControllerEx основные параметры передаются системой по указателю. Если пытаться передать параметры так же, как это сделано в методе TService.Controller – через PostThreadMessage, то во-первых не хватит параметров для передачи, а во-вторых эти указатели потеряют свою силу сразу после выхода из ServiceControllerEx, практически со 100% вероятностью – до того, как отправленное сообщение достигнет ServiceThread.
Значит, нужны обходные маневры. Определяемся со стратегией. Во-первых, для правильной передачи нужно скопировать себе всё то, что передается системой по указателю (и не забыть потом освободить выделенную под копии память). И во-вторых, для того, чтобы была возможность передать внутрь ServiceThread-а всё, что сообщила нам Windows, нужно определить свое сообщение со своей структурой.

PM MAIL WWW   Вверх
kami
Дата 28.5.2012, 23:30 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Новые объявления в SvcMgrEx.pas:
Код

const
  CM_SERVICE_CONTROL_CODE = WM_USER + 1; // это объявление было, его использует TService.Controller
  CM_SERVICE_CONTROL_CODE_EX = WM_USER + WM_USER; // а это – наше сообщение, которое будет использоваться в TService.ControllerEx.

TServiceExMsg = record  // а эту структуру будем использовать для передачи нужных параметров
    lpEventData: pointer;  // из ControllerEx в ServiceThread
    lpContext: pointer;
  end;
  PServiceExMsg = ^TServiceExMsg;


Пора перейти к реализации метода ControllerEx и передаче содержимого четырех параметров, исходя из выбранной стратегии:
Код

function TService.ControllerEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean;
var
  CM_Message: DWord;
  pSvcMsg: PServiceExMsg;
  Size: DWord;
  PPowSettings: PPOWERBROADCAST_SETTING;
begin
  CM_Message := CM_SERVICE_CONTROL_CODE_EX + dwControl;
  // параметр dwControl на приемном конце будет вычисляться в обратном порядке.

  pSvcMsg := AllocMem(SizeOf(TServiceExMsg)); // резервируем место под нашу структуру.
  pSvcMsg.lpContext := lpContext; // lpContext передаем без изменений и копирования.
  // так как изначально, в методе TService.Main в нем был указан nil.
  // это так сказать «задел на будущее», если вдруг решите передавать какие-либо данные через него.

// а вот с lpEventData придется немного повозиться – дело в том, что каждому dwControl
// соответствует своя структура в lpEventData и у каждой – свой набор параметров и размер.
// посему – каждый разбираем по отдельности.
  if Assigned(lpEventData) then
    begin
      case dwControl of
        SERVICE_CONTROL_DEVICEEVENT:
          begin
            Move(lpEventData^, Size, SizeOf(DWord)); // в структуре DEV_BROADCAST_HDR
            // первым идет размер структуры, DWORD
            pSvcMsg.lpEventData := AllocMem(Size);
            Move(lpEventData^, pSvcMsg.lpEventData^, Size);
          end;
        SERVICE_CONTROL_POWEREVENT:
          begin
            if (dwEventType = PBT_POWERSETTINGCHANGE) then
              begin
                PPowSettings := lpEventData;
                Size := SizeOf(POWERBROADCAST_SETTING) + PPowSettings.DataLength - 1;
                pSvcMsg.lpEventData := AllocMem(Size);
                Move(PPowSettings^, pSvcMsg.lpEventData^, Size);
              end;
          end;
        SERVICE_CONTROL_SESSIONCHANGE:
          begin
            Move(lpEventData^, Size, SizeOf(DWord));
            // в структуре WTSSESSION_NOTIFICATION
            // первым идет размер структуры, DWORD
            pSvcMsg.lpEventData := AllocMem(Size);
            Move(lpEventData^, pSvcMsg.lpEventData^, Size);
          end;
        SERVICE_CONTROL_TIMECHANGE:
          begin
            Size := SizeOf(_SERVICE_TIMECHANGE_INFO);
            pSvcMsg.lpEventData := AllocMem(Size);
            Move(lpEventData^, pSvcMsg.lpEventData^, Size);
          end;
      else
        pSvcMsg.lpEventData := nil;
      end;
    end
  else
    pSvcMsg.lpEventData := nil;
  // наконец, всё скопировано и занесено в структуру pSvcMsg. Можно отправлять сообщение
  // в ServiceThread и возвращать управление системе.
  PostThreadMessage(ServiceThread.ThreadID, CM_Message, dwEventType, Integer(pSvcMsg));
  if ServiceThread.Suspended then
    ServiceThread.Resume;
  Result := True;
end;

Вот как-то так. Всё что нужно – отправлено потоку нашего сервиса и в то же время управление быстро возвращено системе. Но, отправить – это же только пол-дела, нужно теперь это всё принять и обработать. Для этого «влезаем» в метод, который ответственный за прием сообщений от ServiceController[Ex]:
Код

procedure TServiceThread.ProcessRequests(WaitForMessage: Boolean);
…………………………………
          if msg.Message = CM_SERVICE_CONTROL_CODE then
            begin
……………………..// здесь оставляем всё без изменений
            end
          else
            if msg.Message >= CM_SERVICE_CONTROL_CODE_EX then
              ServiceControlEx(msg)
            else
              DispatchMessage(msg);
…………………………………..


Особое внимание обратите на вложенность begin-end – в этом методе два раза встречается DispatchMessage.

Добавлено @ 23:31

Осталось объявить private-метод TServiceThread.ServiceControlEx, который мы задействовали в изменившемся обработчике полученных сообщений. Как видно, часть кода благополучно перекочевала сюда из TServiceThread.ProcessRequests:
Код

procedure TServiceThread.ServiceControlEx(msg: TMsg);
var
  svcMsg: PServiceExMsg;
  OldStatus: TCurrentStatus;
  ActionOK: Boolean;
  ErrorMsg: String;
begin
  msg.Message := msg.Message - CM_SERVICE_CONTROL_CODE_EX; // в методе TService.ControllerEx мы добавляли 
// к коду dwControl эту константу для передачи. Теперь – обратная операция
  svcMsg := PServiceExMsg(msg.lParam);
  try
    OldStatus := FService.Status;
    try
      ActionOK := True;
      case msg.Message of
        SERVICE_CONTROL_STOP:
          ActionOK := FService.DoStop;
        SERVICE_CONTROL_PAUSE:
          ActionOK := FService.DoPause;
        SERVICE_CONTROL_CONTINUE:
          ActionOK := FService.DoContinue;
        SERVICE_CONTROL_SHUTDOWN:
          FService.DoShutdown;
        SERVICE_CONTROL_INTERROGATE:
          FService.DoInterrogate;
      else
      // если это не стандартный код управления сервисом, то отдадим его вместе со всеми параметрами
       // на дополнительную обработку
        ActionOK := FService.DoCustomControlEx(msg.Message, msg.wParam, svcMsg.lpEventData, svcMsg.lpContext);
      end;
      if not ActionOK then
        FService.Status := OldStatus;
    except
      on E: Exception do
        begin
          if msg.Message <> SERVICE_CONTROL_SHUTDOWN then
            FService.Status := OldStatus;
          if msg.Message in [1 .. 5] then
            ErrorMsg := Format(SServiceFailed, [ActionStr[Integer(msg.Message)], E.Message])
          else
            ErrorMsg := Format(SCustomError, [msg.Message, E.Message]);
          FService.LogMessage(ErrorMsg);
        end;
    end;
  finally 
    // освобождаем память, выделенную для скопированных параметров.
    if Assigned(svcMsg.lpEventData) then
      FreeMem(svcMsg.lpEventData);
    FreeMem(svcMsg);
  end;
end;

Теперь – объявить «пользовательскую» обработку тех кодов управления, которые не прошли «стандартную» обработку, и основную часть изменений можно считать выполненной:
Код

TService = class(TDataModule)
………………………
protected
……………………....
    function DoCustomControl(CtrlCode: DWord): Boolean; virtual;  // это было, встроенный метод
    // обработки кодов, полученных в Handler, если они не обработаны в ServiceThread
    function DoCustomControlEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean; virtual; 
    // а это – наш, новый, с кучей дополнительных параметров
………………………


И его реализация:
Код

function TService.DoCustomControlEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean;
begin
  Result := True;
end;


Как использовать:
В модуле сервиса (Unit1.pas) перекрываем метод DoCustomControlEx и …всё. Дальнейшее зависит от того, что именно передано в параметре dwControl и что сказано в MSDN в описании HandlerEx. Рассмотрим на примере узнавания о смене сессии:
Код

TService1 = class(TService)
……………….
  protected
    function DoCustomControlEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean; override;
………………………
function TService1.DoCustomControlEx(dwControl, dwEventType: DWord; lpEventData, lpContext: pointer): Boolean;
var
  sessionNotification: PWTSSESSION_NOTIFICATION;
  res: string;
begin
  if dwControl = SERVICE_CONTROL_SESSIONCHANGE then
    begin
      sessionNotification:=lpEventData;
      res:='сессия №'+IntToStr(sessionNotification.dwSessionId)+' ';
      case dwEventType of
        WTS_CONSOLE_CONNECT:
          res:=res+'подключена';
        WTS_CONSOLE_DISCONNECT:
          res:=res+'отключена';
        WTS_SESSION_LOGON:
          res:=res+'вход';
        WTS_SESSION_LOGOFF:
          res:=res+'выход';
      end;
      LogMessage(res);
    end;
end;


Техническую реализацию обработки расширенных кодов управления сервиса можно считать законченной – есть ServiceController (он же – HandlerEx) в модуле Unit1.pas; поступившие данные успешно копируются и передаются в ServiceThread, который в свою очередь, передает их в DoCustomControlEx, если они не относятся к запуску/остановке и т.п.

Добавлено через 2 минуты и 36 секунд
Но вот беда – воспринимать команды сервис может, а система их ему не пересылает. Всё дело в том, что мало объяснить Windows «я могу принимать расширенные команды» - это мы сделали, использовав RegisterServiceCtrlHandlerEx, нужно еще объявить «я хочу принимать такие и такие команды». Это разумно – представьте, какая нагрузка ляжет на систему, если все подряд сервисы будут получать абсолютно все сообщения, даже если они им не нужны.
Значит – еще одна модификация SvcMgr.pas.
В первую очередь, объявляем перечисляемый тип (я его объявил сразу после «некоторых видов lpEventData из HandlerEx»):
Код

  TAdditionalControls = (acSessionChange, acHardwareProfileChange, acPowerEvent, acTimeChange, acTriggerEvent);
  TAdditionalControlSet = set of TAdditionalControls;

Он содержит те дополнительные команды, которые может воспринимать сервис. Здесь нет acServiceControlDeviceEvent – средствами сервиса на эти события подписаться невозможно. Для того, чтобы получать события, связанные с устройствами, нужно вызывать RegisterDeviceNotification, а работа с ним выходит за рамки рассматриваемого сейчас.
В public-секции TService объявляем новое свойство:
Код

property AllowAdditionalControls: TAdditionalControlSet read FAdditionalControls write SetAdditionalControls default [];

и реализацию сеттера:
Код

procedure TService.SetAdditionalControls(const Value: TAdditionalControlSet);
begin
  FAdditionalControls := Value;
  ReportStatus;
end;

Кроме того, понадобится дополнение метода TService.GetNTControlsAccepted – именно в нем определяется, какие управляющие коды воспринимаются сервисом:
Код

function TService.GetNTControlsAccepted: Integer;
const
  AddControlsAccepted: array [ Low(TAdditionalControls) .. High(TAdditionalControls)] of Integer =
    (SERVICE_ACCEPT_SESSIONCHANGE, SERVICE_ACCEPT_HARDWAREPROFILECHANGE, SERVICE_ACCEPT_POWEREVENT,
    SERVICE_ACCEPT_TIMECHANGE, SERVICE_ACCEPT_TRIGGEREVENT);
var
  I: TAdditionalControls;
  ControllerEx: TServiceControllerEx;
begin
  Result := SERVICE_ACCEPT_SHUTDOWN;
  if AllowStop then
    Result := Result or SERVICE_ACCEPT_STOP;
  if AllowPause then
    Result := Result or SERVICE_ACCEPT_PAUSE_CONTINUE;
// вносим дополнения:
  ControllerEx := GetServiceControllerEx();
  if Assigned(ControllerEx) then // если определен HandlerEx
    for I := Low(TAdditionalControls) to High(TAdditionalControls) do
      if I in FAdditionalControls then
        Result := Result or AddControlsAccepted[I]; // добавляем к разрешенным кодам нужные «дополнительные».
end;

Воспринимаемые сервисом управляющие коды сообщаются Windows в методе ReportStatus, который мы вызываем в сеттере AllowAdditionalControls.

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

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  Self.AllowAdditionalControls:=[acSessionChange];
end;


После этого наш сервис начнет получать события о смене сессии, ее блокировке/разблокировке и т.д. в методе DoCustomControlEx. Реализацию этого метода, применительно к получению событий о смене сессии мы написали чуть выше.


Вот теперь – всё. Новый модуль готов.

ЗАКЛЮЧИТЕЛЬНЫЕ ОПЕРАЦИИ
Исключительно для удобства пользования предлагаю скомпилировать полученный проект, и если всё отлично, то:
1.    Скопировать полученный SvcMgrEx.pas в папку vcl, «положив» его рядом со стандартным SvcMgr.pas
2.    Скопировать файл SvcMgrEx.dcu в папку lib, положив его рядом с SvcMgr.dcu
3.    Внести в репозиторий получившийся проект (желательно – удалив код из событий, но сойдет как угодно).

Напоследок: архив с модулем SvcMrgEx.pas (еще раз хочу обратить внимание - работа шла в D2010) и проектом Service application.


Это сообщение отредактировал(а) kami - 28.5.2012, 23:32

Присоединённый файл ( Кол-во скачиваний: 58 )
Присоединённый файл  SvcMgrEx.zip 12,15 Kb
PM MAIL WWW   Вверх
drkot
Дата 1.6.2012, 16:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Во первых, хвала и вечная память, за проделанный труд. Пост полезен и заслуживает попасть в раздел статей.

Ну и немного критики... извините не могу без этого...
Цитата

Но – объявить мало, нужно еще получить ее адрес. Для этого вносим изменения в initialization. 


если придерживаться стратегии предложенной разработчиками Delphi, то логично добавлять функции в WinSvcЕх (WinSvc модуль с прототипами).
+ динамическая загрузка тоже усложняет код и несколько противоречит концепции Delphi. Имхо она оправдана в случае не гарантированного присутствия функции в библиотеке (например  при работе с различными версиями).

Дальше идет одно сплошное замечание. Поясню:
1) к моему сожалению вижу полное непонимание ОПП, в следствие все построено несколько не корректно в своей основе
2) работать в IDE с таким проектом в режиме автоматического создания и добавления невозможно
3)явный конфликт имен, что не позволит в одном проекте создать два сервиса (один простой другой расширенный)
4) ряд действий (например описание для сервиса) рациональнее добавлять как отдельный компонент 

Имхо, даже автоматическая (встроенная) регистрация сервиса сама по себе избыточна и может привести к конфликту если сервис был зарегистрирован внешним способом (не через встроенный регистратор).

Но все что написано мной есть лишь жалкий писк в сравнении с тем титаническим трудом который проделал автор. Но ОПП надо учить и применять, чтоб не получилось "100 метров колючей проволоки" в процессе расширения функциональности объектов.  smile 


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
kami
Дата 1.6.2012, 17:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
Имхо она оправдана в случае не гарантированного присутствия функции в библиотеке (например  при работе с различными версиями).

ChangeServiceConfig2 и RegisterServiceCtrlHandlerEx отсутствуют в Win2000

Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
то логично добавлять функции в WinSvcЕх

Не спорю, но влезать еще и туда не хотелось.

Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
к моему сожалению вижу полное непонимание ОПП, в следствие все построено несколько не корректно в своей основе

Пожалуйста, поясните на чем-нибудь из выложенного кода.
Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
работать в IDE с таким проектом в режиме автоматического создания и добавления невозможно

Да. Если подскажете, как этого добиться - будет великолепно. Всё, что нашел в интернете - это как добавить в репозиторий форму. Кстати, будет очень даже неплохо, если подскажете, как заставить Delphi видеть новые published свойства в "обновленном" TService.
Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
явный конфликт имен, что не позволит в одном проекте создать два сервиса (один простой другой расширенный)

Не вижу в этом смысла, если честно. 
Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
 ряд действий (например описание для сервиса) рациональнее добавлять как отдельный компонент 

На вкус и цвет...
Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
Имхо, даже автоматическая (встроенная) регистрация сервиса сама по себе избыточна и может привести к конфликту если сервис был зарегистрирован внешним способом (не через встроенный регистратор).

Вообще не понял, поясните ?

PM MAIL WWW   Вверх
drkot
Дата 1.6.2012, 18:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
Пожалуйста, поясните на чем-нибудь из выложенного кода.

например это ОПП демонстрирует использование принципа наследования
Код

TServiceEx = class(TService)

public

  property Description: String read FDescription write SetDescription;


а то что у Вас приведено
Код

TService = class(TDataModule)

public

  property Description: String read FDescription write SetDescription;


это просто непонимание сути ОПП, Вы просто разрушаете имеющийся объект, вместо того чтобы создать наследника и расширить (и/или подменить) функционал.
Надеюсь что понятно изъяснился.   

Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
Не спорю, но влезать еще и туда не хотелось.

Обычно процедурный функционал отделяют от объектного, это повышает читаемость кода. Посмотрите модуль WinSvc. В частности на принцип описания функций, хотя бы для общего развития. 

Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
Не вижу в этом смысла, если честно. 

смысл в концепциях ОПП, одновременное использование SvcMgr и SvcMgrEx приведет к конфликту имен, причем к множественному.

Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
Вообще не понял, поясните ?

об этом Application.Installing





--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
drkot
Дата 1.6.2012, 19:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
На вкус и цвет...

справедливый аргумент.
Например TApplicationEvents, это добавочный компонент который упрощает работу событиями TApplication которые изначально недоступны в режиме дизайна.
Также и в случае описания сервиса, оно не является неотъемлемой частью объекта TService и не требуется для его работы, поэтому включать его в структуру нет необходимости, а вот использовать в качестве объекта расширения функционала при инсталляции наиболее уместно. ИМХО.

Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
Да. Если подскажете, как этого добиться - будет великолепно. Всё, что нашел в интернете - это как добавить в репозиторий форму.

если одним словом и не конкретно, то ToolAPI. К сожалению по этой теме фактически нет материалов, а то что есть относится к версии до 5-й включительно.
Можете посмотреть примеры по ToolAPI входящие в поставку с IDE. Если возникнут вопросы поднимайте тему с удовольствием приму участие. 

Цитата(kami @  1.6.2012,  17:55 Найти цитируемый пост)
как заставить Delphi видеть новые published свойства в "обновленном" TService

то что содержится в репозитории подгружено из зарегистрированных bpl, очень похоже на регистрацию новых компонентов. По сути регистрация компонентов это тоже ToolAPI.


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
kami
Дата 1.6.2012, 20:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Цитата(drkot @  1.6.2012,  18:45 Найти цитируемый пост)
это просто непонимание сути ОПП, Вы просто разрушаете имеющийся объект, вместо того чтобы создать наследника и расширить (и/или подменить) функционал.Надеюсь что понятно изъяснился.   

Более чем понятно. На счет "разрушаю" - сильно сказано smile .  Но в данном случае - не сработает это, ввиду хотя бы следующего:
Код

procedure TService.Main(Argc: DWord; Argv: PLPSTR);
..................
  FStatusHandle := RegisterServiceCtrlHandlerEx(PChar(Name), @ControllerEx, nil);
FStatusHandle - приватное поле, не имеющее выхода наружу ни в каком виде. Править сам генофонд? И подобных узких моментов - далеко не один, как например требующая изменений private function GetNTControlsAccepted. Если я не прав - помогите разобраться.


Цитата(drkot @  1.6.2012,  18:45 Найти цитируемый пост)
Обычно процедурный функционал отделяют от объектного, это повышает читаемость кода. Посмотрите модуль WinSvc. В частности на принцип описания функций, хотя бы для общего развития. 

На WinSvc смотрел не раз, честное слово smile Посмотрите и Вы, например, на Controls.pas, тогда думаю сойдемся на том, что ключевое слово здесь - обычно.

Цитата(drkot @  1.6.2012,  18:45 Найти цитируемый пост)
одновременное использование SvcMgr и SvcMgrEx приведет к конфликту имен, причем к множественному.
Вот это по-моему как раз не проблема. Получит программист "Incompatible types - 'TService' and 'TService' " - что в этом плохого? Будет знать, что пытается не то, что нужно использовать.
Сам не раз получал подобное, (в последний раз "Declaration of '...' differs from previous declaration")- из-за PLPSTR в WinSvc и PLPSTR в Windows.pas.

Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
Имхо, даже автоматическая (встроенная) регистрация сервиса сама по себе избыточна и может привести к конфликту если сервис был зарегистрирован внешним способом (не через встроенный регистратор).

Цитата(drkot @  1.6.2012,  18:45 Найти цитируемый пост)
об этом Application.Installing

Опять не понял. Ну выведется сообщение "сервис уже установлен/нет такого", и все. Или не выведется, смотря что там в командной строке прописать. По-моему, очень даже удобная вещь - запустил с нужным ключем, и не нужно знать про всякие CreateService и прочая.

Добавлено через 4 минуты и 43 секунды
Цитата(drkot @  1.6.2012,  19:16 Найти цитируемый пост)
Также и в случае описания сервиса, оно не является неотъемлемой частью объекта TService и не требуется для его работы, поэтому включать его в структуру нет необходимости, а вот использовать в качестве объекта расширения функционала при инсталляции наиболее уместно. ИМХО.

Тут мы с Вами не сошлись, мое имхо - описание сервиса это его неотъемлимая часть.

Цитата(drkot @  1.6.2012,  19:16 Найти цитируемый пост)
если одним словом и не конкретно, то ToolAPI. К сожалению по этой теме фактически нет материалов

Жаль, к сожалению - разбираться с этим пока нет большого желания (оно, думаю, появится только когда будет очень надо)...

Это сообщение отредактировал(а) kami - 1.6.2012, 20:13
PM MAIL WWW   Вверх
drkot
Дата 1.6.2012, 21:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
Получит программист "Incompatible types - 'TService' and 'TService' " - что в этом плохого? Будет знать, что пытается не то, что нужно использовать.

Плохо, то что он не сможет использовать одновременно два типа в одном приложении, на этом и был изначальный акцент.
Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
 из-за PLPSTR в WinSvc и PLPSTR в Windows.pas.

а это результат участия в разработке множества плохо (мало) взаимодействующих групп программистов.

Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
и не нужно знать про всякие CreateService и прочая.

только вот далеко не всегда это нужно, а в ряде случаев даже вредно (например при необходимости отслеживать процесс инсталяции/деинсталяции отдельным приложением). Хотя полностью согласен, что с точки зрения "не нужно знать" вариант идеальный.

Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
описание сервиса это его неотъемлимая часть.

Поясню, "описание сервиса" - это неотъемлемая часть процесса его регистрации и только. На работу сервиса "описание" (как и большинство propertys задаваемых в инспекторе объектов) никак не влияет. Регистрация сервиса не является частью его функционала и практически во всех сервисах написанных без помощи TServiceApplication отсутствует. Именно это и есть моя позиция. Поэтому и выведение в добавочный функционал.

Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
оно, думаю, появится только когда будет очень надо

На самом деле оно не просто очень надо, а просто overneed. Там можно такие штуки делать ... который заметно упрощают (автоматизируют) разработку
Хотя разбираться долго, и надо хорошо знать RTTI и интерфейсы.
Единственный минус (и причина по которой я забросил это направление), что от версии  к версии IDE сильно меняется и многие наработки требуют переделки под новые требования.

В остальном как вы и говорили "на вкус и цвет..." все фломастеры разные.
И все же главный мой тезис:
Цитата(drkot @  1.6.2012,  16:50 Найти цитируемый пост)
Во первых, хвала и вечная память, за проделанный труд. Пост полезен и заслуживает попасть в раздел статей.




--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
drkot
Дата 1.6.2012, 21:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(kami @  1.6.2012,  20:12 Найти цитируемый пост)
Если я не прав - помогите разобраться.

Вы правы на все 100%. Это "вина" разработчиков, они просто не предполагали что Вы будете менять и переопределять эти поля.
Выход из этой сложной ситуации достаточно прост... нужно в наследнике переопределить переменные и перекрыть методы. Конечно это грубо, но другого способа я не знаю. Может кто знает научит уму разуму.
Наиболее правильно привязывать к полям свойства, чтобы их можно было перекрывать в наследниках.

можно использовать например секцию protected вместо private.

Это сообщение отредактировал(а) drkot - 1.6.2012, 21:40


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
drkot
Дата 1.6.2012, 21:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



вот пример наследования по данным

Присоединённый файл ( Кол-во скачиваний: 23 )
Присоединённый файл  Projects.rar 1,35 Kb


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
kami
Дата 1.6.2012, 22:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 15
Всего: 72



Цитата(drkot @  1.6.2012,  21:31 Найти цитируемый пост)
Выход из этой сложной ситуации достаточно прост... нужно в наследнике переопределить переменные и перекрыть методы. 

Только подобрались к самому интересующему меня моменту, а именно - к обвинению меня в полном непонимании ООП. Думаю, самое время этим вопросом заняться вплотную.

То, что Вы предлагаете, только усложнит (причем - значительно) реализацию, и ничего простого в этом нет. Ознакомьтесь чуть более, чем поверхностно с тем, в какие методы вносятся изменения.

Переопределить переменные/поля, объявить свойства в наследнике можно, а вот с не-виртуальными методами (тот же TService.Main) как быть? Возьмем для примера только TService - чтобы сделать полноценного наследника, придется не только менять (и дублировать) многие его методы (а не некоторые, как в предложенном мной коде), но и искать нужные и менять в соответствующем наследнике методы TServiceApplication, которые тоже в большинстве своем тоже не-виртуальны. Упустили упоминание - и всё пропало.
В конечном итоге это приведет к запутыванию всех, включая самого автора "наследников" сервисных классов.

Цитата(drkot @  1.6.2012,  21:31 Найти цитируемый пост)
Наиболее правильно привязывать к полям свойства, чтобы их можно было перекрывать в наследниках.

Прописные истины smile

Добавлено @ 22:52
Цитата(drkot @  1.6.2012,  21:49 Найти цитируемый пост)
вот пример наследования по данным

Ваш пример как минимум не соответствует теме - если бы то, что подлежит изменению имело директивы virtual/dynamic, я бы не стал городить топик на несколько листов А4.

Это сообщение отредактировал(а) kami - 1.6.2012, 23:05
PM MAIL WWW   Вверх
drkot
Дата 2.6.2012, 00:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(kami @  1.6.2012,  22:49 Найти цитируемый пост)
virtual/dynamic

работать в данном случае будет и без директив. с ними просто правильнее 

Цитата(kami @  1.6.2012,  22:49 Найти цитируемый пост)
То, что Вы предлагаете, только усложнит (причем - значительно) реализацию

не буду спорить, ОПП вещь хитрая. Просто класс TService разработан как конечный и разработчики не позаботились о возможности его функционального расширения.

Раз уж мы тут устроили такую дискуссию потрачу время с пользой... переделаю TService, а Вы оцените...


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
northener
Дата 2.6.2012, 00:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1361
Регистрация: 2.9.2010

Репутация: нет
Всего: 20



Цитата(drkot @  1.6.2012,  21:13 Найти цитируемый пост)
Плохо, то что он не сможет использовать одновременно два типа в одном приложении, на этом и был изначальный акцент.

Почему не сможет? Разве префиксы запрещены?


--------------------
Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!
PM MAIL   Вверх
drkot
Дата 2.6.2012, 00:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Ищущий
***


Профиль
Группа: Завсегдатай
Сообщений: 1042
Регистрация: 5.5.2006

Репутация: нет
Всего: 8



Цитата(northener @  2.6.2012,  00:16 Найти цитируемый пост)
Почему не сможет? Разве префиксы запрещены?

ClassName это несколько больше чем простой тип или имя переменной и даже при удачной компиляции не гарантий что в runtime все пройдет гладко.
Скажем мне не совсем понятно как будут созданы два объекта (окна) имеющие одинаковый ClassName и различную реализацию. Насколько я знаю в RTTI не учитывается происхождение (модуль) класса, хотя могу ошибаться, все меняется.

Добавлено через 6 минут и 32 секунды
kami, а как Вы представляете работу 
Код

TService.SetDescription

в DesignMode? Что при каждом обновлении свойства будет проводится манипуляция по изменению описания? а если сервис не установлен в системе?


--------------------
Ошибка не становится истиной по причине широкого распространения,
как и Истина не становится Ошибкой из-за того, что никто её не видит.
PM   Вверх
northener
Дата 2.6.2012, 01:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1361
Регистрация: 2.9.2010

Репутация: нет
Всего: 20



Цитата(drkot @  2.6.2012,  00:36 Найти цитируемый пост)
Цитата(northener @  2.6.2012,  00:16 Найти цитируемый пост)
Почему не сможет? Разве префиксы запрещены?

ClassName это несколько больше чем простой тип или имя переменной и даже при удачной компиляции не гарантий что в runtime все пройдет гладко.
Скажем мне не совсем понятно как будут созданы два объекта (окна) имеющие одинаковый ClassName и различную реализацию. Насколько я знаю в RTTI не учитывается происхождение (модуль) класса, хотя могу ошибаться, все меняется.

В RTTI, возможно, (не знаю) и не учитывается nobless smile
Но  при чём тут RTTI, создание объекта и ClassName? Да и вообще runtime?


--------------------
Но только лошади летают вдохновенно.
Иначе лошади разбились бы мгновенно!
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »


 




[ Время генерации скрипта: 0.2270 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.