| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Глюк с завершением сервиса... [D7, Win2k, WinXP]

Rouse_ ©   (2004-08-11 11:39:00) 

Пишу 2 сервиса находящихся в одном ЕХЕ файле.
Делаю все по Рихтеру и Кнуту.
Заполняется массив типа TServiceTableEntry, последний элемент массива обнуляется.
Оба сервиса имеют тип SERVICE_WIN32_SHARE_PROCESS.
Вызывается StartServiceCtrlDispatcher.
Далее в MainProc каждого сервиса делаю RegisterServiceCtrlHandlerEx.
Каждый сервис при старте сначала оповещает SERVICE_START_PENDING и после него SERVICE_RUNNING.
При необходимости на запрос от SCM о SERVICE_CONTROL_INTERROGATE возвращается текущее
состояние через SetServiceStatus.
При завершении по SERVICE_CONTROL_STOP возвращаю SERVICE_STOPPED.

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

Все функции отрабатываются верно (проверял). Значит что-то я по всей видимости забыл сделать,
или где-то не правильно что-то определил или вызвал. Но что именно никак не могу найти.
Перечитал третью главу Рихтера и Кнута уже от корки до корки, перепроверил построчно весь код,
никак не могу найти где заковыка.

Ниже демо-код приложения содержащего два пустых сервиса, если бы не этот глюк с завершением,
то в принципе нормальная заготовка...

---

Rouse_   (2004-08-11 14:43:00) [1]

Фффух...

Спасибо Digitman-у за подсказку в каком направлении нужно копать...
Вот верный вариант кода:

// Главная процедура первого сервиса
procedure FirstMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := FirstContext;
 FirstStatusHandle := RegisterServiceCtrlHandlerEx(FirstName,
   @ServicesCtrlHandler, @Context);
 if (FirstStatusHandle <> 0) and FirstInitialize and FirstNotifyIsRunning then
  try
   while FirstStatus.dwCurrentState <> SERVICE_STOP do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end;
 finally
   SetServiceStatus(FirstStatusHandle, FirstStatus);
 end;
end;

// Главная процедура второго сервиса
procedure SecondMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := SecondContext;
 SecondStatusHandle := RegisterServiceCtrlHandlerEx(SecondName,
   @ServicesCtrlHandler, @Context);
 if (SecondStatusHandle <> 0) and SecondInitialize and SecondNotifyIsRunning then
  try
   while SecondStatus.dwCurrentState <> SERVICE_STOP do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end
 finally
   SetServiceStatus(SecondStatusHandle, SecondStatus);
 end;
end;

---

Rouse_   (2004-08-11 12:32:00) [2]

Изменил чтобы у каждого сервиса был свой CtrlHandler и вместо RegisterServiceCtrlHandlerEx вызов произвожу через RegisterServiceCtrlHandler (который продекларирован в WinSvc) тоже такая же пертушка...

// Через эту функцию с первым сервисом общается SCM
function FirstServiceCtrlHandler(dCode: DWORD): DWORD; stdcall;
begin
 case dCode of
   SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN:
     FirstStop;
   SERVICE_CONTROL_INTERROGATE:
     FirstNotifyIsRunning;
 end;
end;

// Через эту функцию со вторым сервисом общается SCM
procedure SecondServicesCtrlHandler(dCode: DWORD); stdcall;
begin
 case dCode of
   SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN:
     SecondStop;
   SERVICE_CONTROL_INTERROGATE:
     SecondNotifyIsRunning;
 end;
end;

// Главная процедура первого сервиса
procedure FirstMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := FirstContext;
 FirstStatusHandle := RegisterServiceCtrlHandler(FirstName,
   @FirstServiceCtrlHandler);
 if (FirstStatusHandle <> 0) and FirstInitialize and FirstNotifyIsRunning then
   while FirstStatus.dwCurrentState <> SERVICE_STOPPED do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end
end;

// Главная процедура второго сервиса
procedure SecondMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := SecondContext;
 SecondStatusHandle := RegisterServiceCtrlHandler(SecondName,
   @SecondServicesCtrlHandler);
 if (SecondStatusHandle <> 0) and SecondInitialize and SecondNotifyIsRunning then
   while SecondStatus.dwCurrentState <> SERVICE_STOPPED do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end
end;

---

Rouse_   (2004-08-11 11:59:00) [3]

> Делаю все по Рихтеру и Кнуту.
Рихтеру и Кларку, конечно :))

---

Rouse_   (2004-08-11 11:40:00) [4]

// Через эту функцию с нашими сервисами общается SCM
function ServicesCtrlHandler(dwControl, dwEventType: DWORD;
 lpEventData, lpContext: Pointer): DWORD; stdcall;
begin
 Result := 1;
 case DWORD(lpContext^) of
   FirstContext:
   begin
     case dwControl of
       SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN:
         FirstStop;
       SERVICE_CONTROL_INTERROGATE:
         FirstNotifyIsRunning;
     end;
   end;
   SecondContext:
   begin
     case dwControl of
       SERVICE_CONTROL_STOP, SERVICE_CONTROL_SHUTDOWN:
         SecondStop;
       SERVICE_CONTROL_INTERROGATE:
         SecondNotifyIsRunning;
     end;
   end;
 end;
end;

// Главная процедура первого сервиса
procedure FirstMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := FirstContext;
 FirstStatusHandle := RegisterServiceCtrlHandlerEx(FirstName,
   @ServicesCtrlHandler, @Context);
 if (FirstStatusHandle <> 0) and FirstInitialize and FirstNotifyIsRunning then
   while FirstStatus.dwCurrentState <> SERVICE_STOPPED do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end
end;

// Главная процедура второго сервиса
procedure SecondMainProc(ArgCount: DWORD; var Args: array of PChar); stdcall;
var
 Context: DWORD;
begin
 Context := SecondContext;
 SecondStatusHandle := RegisterServiceCtrlHandlerEx(SecondName,
   @ServicesCtrlHandler, @Context);
 if (SecondStatusHandle <> 0) and SecondInitialize and SecondNotifyIsRunning then
   while SecondStatus.dwCurrentState <> SERVICE_STOPPED do
   try
     // Собственно работа сервиса
     Sleep(10);
   except
     // Обработка ошибок сервиса
   end
end;

// Main
begin
 if ParamCount > 0 then
 begin
   // Инсталяция
   if AnsiUpperCase(ParamStr(1)) = '-INSTALL' then
   begin
     if not Install then ShowMsg(SysErrorMessage(GetLastError));
     Exit;
   end;
   // Деинсталяция
   if AnsiUpperCase(ParamStr(1)) = '-UNINSTALL' then
   begin
     if not Uninstall then ShowMsg(SysErrorMessage(GetLastError));
     Exit;
   end;
   // Работа сервисов
   if AnsiUpperCase(ParamStr(1)) = '-SERVICE' then
   begin
     ServicesTable[0].lpServiceName := FirstName;
     ServicesTable[0].lpServiceProc := @FirstMainProc;
     ServicesTable[1].lpServiceName := SecondName;
     ServicesTable[1].lpServiceProc := @SecondMainProc;
     ServicesTable[2].lpServiceName := nil;
     ServicesTable[2].lpServiceProc := nil;
     // Запускаем сервисы, дальше работа едет в их главных процедурах
     if not StartServiceCtrlDispatcher(ServicesTable[0]) and
       (GetLastError <> ERROR_SERVICE_ALREADY_RUNNING) then
         ShowMsg(SysErrorMessage(GetLastError));
   end
   else
     ShowMsg(Format(InfoStr, [ServiceFileName]), MB_ICONINFORMATION);
 end
 else
   ShowMsg(Format(InfoStr, [ServiceFileName]), MB_ICONINFORMATION);
end.

---

Rouse_   (2004-08-11 11:39:00) [5]

program twoservicedemo;

{$DEFINE SERVICE_DEBUG}

uses
 Windows,
 SysUtils,
 WinSvc;

const
 InfoStr = 'Use:'#13#10'%s [ -install | -uninstall ]';
 ServiceFileName = 'twoservicedemo.exe';
 FirstName = 'TSvcFirst';
 FirstDisplayName = 'Test Service First';
 SecondName = 'TSvcSecond';
 SecondDisplayName = 'Test Service Second';
 FirstContext = 1;
 SecondContext = 2;

type
 LPHANDLER_FUNCTION_EX = function (dwControl, dwEventType: DWORD;
   lpEventData, lpContext: Pointer): DWORD; stdcall;
 THandlerFunctionEx = LPHANDLER_FUNCTION_EX;

 function RegisterServiceCtrlHandlerEx(lpServiceName: LPCWSTR;
   lpHandlerProc: LPHANDLER_FUNCTION_EX; lpContext: Pointer):
   SERVICE_STATUS_HANDLE; stdcall; external 'advapi32.dll' name 'RegisterServiceCtrlHandlerExW';
   
var
 ServicesTable: packed array [0..2] of TServiceTableEntry;
 FirstStatusHandle: SERVICE_STATUS_HANDLE = 0;
 SecondStatusHandle: SERVICE_STATUS_HANDLE = 0;
 FirstStatus: TServiceStatus;
 SecondStatus: TServiceStatus;

{$R *.res}

// ** Служебные процедуры и функции ********************************************

// Вывод информации (при работе сервиса не применяется)
procedure ShowMsg(Msg: string; Flags: integer = -1);
begin
 if Flags < 0 then Flags := MB_ICONSTOP;
 MessageBox(0, PChar(Msg), ServiceFileName, MB_OK or MB_TASKMODAL or MB_TOPMOST or Flags)
end;

// Инсталяция сервисов в SCM
function Install: Boolean;
const
 StartType =
{$IFDEF SERVICE_DEBUG}
   SERVICE_DEMAND_START;
{$ELSE}
   SERVICE_AUTO_START;
{$ENDIF}
var
 SCManager, Service: SC_HANDLE;
begin
 SCManager := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
 if SCManager <> 0 then
 try
   // инсталируем первый сервис
   Service := CreateService(SCManager, FirstName, FirstDisplayName, SERVICE_ALL_ACCESS,
     SERVICE_WIN32_SHARE_PROCESS or SERVICE_INTERACTIVE_PROCESS, StartType, SERVICE_ERROR_NORMAL,
     PChar('"' + ParamStr(0) + '" -service'), nil, nil, nil, nil, nil);
   if Service <> 0 then
   try
     Result := ChangeServiceConfig(Service, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, nil, nil,
       nil, nil, nil, nil, nil);
   finally
     CloseServiceHandle(Service);
   end
   else
     Result := GetLastError = ERROR_SERVICE_EXISTS;

   // инсталируем второй сервис
   Service := CreateService(SCManager, SecondName, SecondDisplayName, SERVICE_ALL_ACCESS,
     SERVICE_WIN32_SHARE_PROCESS or SERVICE_INTERACTIVE_PROCESS, StartType, SERVICE_ERROR_NORMAL,
     PChar('"' + ParamStr(0) + '" -service'), nil, nil, nil, nil, nil);
   if Service <> 0 then
   try
     Result := ChangeServiceConfig(Service, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, SERVICE_NO_CHANGE, nil, nil,
       nil, nil, nil, nil, nil);
   finally
     CloseServiceHandle(Service);
   end
   else
     Result := GetLastError = ERROR_SERVICE_EXISTS;

 finally
   CloseServiceHandle(SCManager);
 end
 else
   Result := False;
end;

// деинсталяция сервисов в SCM
function Uninstall: Boolean;
var
 SCManager, Service: SC_HANDLE;
begin
 SCManager := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
 if SCManager <> 0 then
 try
   // Удаляем первый сервис
   Service := OpenService(SCManager, FirstName, _DELETE);
   if Service <> 0 then
   try
     Result := DeleteService(Service);
   finally
     CloseServiceHandle(Service);
   end
   else
     Result := GetLastError = ERROR_SERVICE_DOES_NOT_EXIST;

   // Удаляем второй сервис
   Service := OpenService(SCManager, SecondName, _DELETE);
   if Service <> 0 then
   try
     Result := DeleteService(Service);
   finally
     CloseServiceHandle(Service);
   end
   else
     Result := GetLastError = ERROR_SERVICE_DOES_NOT_EXIST;
 finally
   CloseServiceHandle(SCManager);
 end
 else
   Result := False;
end;

// *** Непосредственно работа сервисов *****************************************

// Инициализация первого сервиса
function FirstInitialize: Boolean;
begin
 with FirstStatus do
 begin
   dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
   dwCurrentState := SERVICE_START_PENDING;
   dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN;
   dwWin32ExitCode := NO_ERROR;
   dwServiceSpecificExitCode := 0;
   dwCheckPoint := 1;
   dwWaitHint := 5000
 end;
 Result := SetServiceStatus(FirstStatusHandle, FirstStatus);
end;

// Оповещение SCM что первый сервис работает
function FirstNotifyIsRunning: Boolean;
begin
 with FirstStatus do
 begin
   dwCurrentState := SERVICE_RUNNING;
   dwWin32ExitCode := NO_ERROR;
   dwCheckPoint := 0;
   dwWaitHint := 0
 end;
 Result := SetServiceStatus(FirstStatusHandle, FirstStatus);
end;

// Завершение работы первого сервиса
procedure FirstStop(Code: DWORD = NO_ERROR);
begin
 with FirstStatus do
 begin
   dwCurrentState := SERVICE_STOPPED;
   dwWin32ExitCode := Code;
 end;
 SetServiceStatus(FirstStatusHandle, FirstStatus); // Результатом True - проверял
end;

// Инициализация второго сервиса
function SecondInitialize: Boolean;
begin
 with SecondStatus do
 begin
   dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
   dwCurrentState := SERVICE_START_PENDING;
   dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN;
   dwWin32ExitCode := NO_ERROR;
   dwServiceSpecificExitCode := 0;
   dwCheckPoint := 1;
   dwWaitHint := 5000
 end;
 Result := SetServiceStatus(SecondStatusHandle, SecondStatus);
end;

// Оповещение SCM что второй сервис работает
function SecondNotifyIsRunning: Boolean;
begin
 with SecondStatus do
 begin
   dwCurrentState := SERVICE_RUNNING;
   dwWin32ExitCode := NO_ERROR;
   dwCheckPoint := 0;
   dwWaitHint := 0
 end;
 Result := SetServiceStatus(SecondStatusHandle, SecondStatus);
end;

// Завершение работы второго сервиса
procedure SecondStop(Code: DWORD = NO_ERROR);
begin
 with SecondStatus do
 begin
   dwCurrentState := SERVICE_STOPPED;
   dwWin32ExitCode := Code;
 end;
 SetServiceStatus(SecondStatusHandle, SecondStatus); // Результатом True - проверял
end;

---

Наверх