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

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

Попытка разобраться с сервисами [D7, XP]


Страницы:   1 2

Vlad ©   (2008-07-18 14:09:00) 

Пытаюсь разобраться с сервисами. Переписал пример, найденный в интернете. Запускаться - запускается, а вот ни инсталлироваться в качестве сервиса, ни работать, не хочет.
Подскажите, это автор что-то намудрил, или я? Где ошибка?

Вот код...

program SvcRunner;

uses
 Windows,WinSvc,ShellApi;

{$R *.res}
const
 ServiceName='SvcRunner';
 ServiceDisplayName='SvcRunner';
 
var
 DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
 ServiceStatus: SERVICE_STATUS;
 ServiceStatusHandle:SERVICE_STATUS_HANDLE;
 hThread:Cardinal;
 
 procedure LogError(ErrorString:string);
 begin
 end;

 procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
 var
   Status : Cardinal;
 begin
   case Opcode of
     SERVICE_CONTROL_PAUSE    :
       begin
         ServiceStatus.dwCurrentState := SERVICE_PAUSED;
         SuspendThread(hThread);
       end;
     SERVICE_CONTROL_CONTINUE :
       begin
         ServiceStatus.dwCurrentState := SERVICE_RUNNING;
         ResumeThread(hThread);
       end;
     SERVICE_CONTROL_STOP     :
       begin
         ServiceStatus.dwWin32ExitCode:=0;
         ServiceStatus.dwCurrentState := SERVICE_STOPPED;
         ServiceStatus.dwCheckPoint   :=0;
         ServiceStatus.dwWaitHint     :=0;

         if not SetServiceStatus (ServiceStatusHandle,ServiceStatus) then
         begin
           Status:=GetLastError;
          LogError('SetServiceStatus');
           Exit;
         end;
     exit;
   end;

   SERVICE_CONTROL_INTERROGATE : ;
   end;

 if not SetServiceStatus (ServiceStatusHandle, ServiceStatus) then
 begin
   Status := GetLastError;
   LogError('SetServiceStatus');
   Exit;
 end;
 end;

 function ServiceInitialization(argc:DWORD; argv:array of PChar; specificError:DWORD):DWORD;stdcall;
 begin
   Result:=0;
 end;

 function MainServiceThread(p:Pointer):DWORD;stdcall;
 var
   h:HWND;
 begin
   h:=FindWindow(nil,'Bla-Bla-Bla');
   if h<>0 then
     PostQuitMessage(h);
 end;

 procedure ServiceProc(argc:DWORD; var argv:array of PChar);stdcall;
 var
   Status : DWORD;
   SpecificError : DWORD;
   ThId:Cardinal;
 begin
   ServiceStatus.dwServiceType      := SERVICE_WIN32;
   ServiceStatus.dwCurrentState     := SERVICE_START_PENDING;
   ServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
     or SERVICE_ACCEPT_PAUSE_CONTINUE;
   ServiceStatus.dwWin32ExitCode           := 0;
   ServiceStatus.dwServiceSpecificExitCode := 0;
   ServiceStatus.dwCheckPoint              := 0;
   ServiceStatus.dwWaitHint                := 0;

   ServiceStatusHandle :=RegisterServiceCtrlHandler(ServiceName,@ServiceCtrlHandler);
   if ServiceStatusHandle = 0 then WriteLn('RegisterServiceCtrlHandler Error');

   Status :=ServiceInitialization(argc,argv,SpecificError);
   if Status <> NO_ERROR then
   begin
     ServiceStatus.dwCurrentState := SERVICE_STOPPED;
     ServiceStatus.dwCheckPoint   := 0;
     ServiceStatus.dwWaitHint     := 0;
     ServiceStatus.dwWin32ExitCode:=Status;
     ServiceStatus.dwServiceSpecificExitCode:=SpecificError;
     SetServiceStatus (ServiceStatusHandle, ServiceStatus);
    LogError('ServiceInitialization');
     exit;
   end;

   ServiceStatus.dwCurrentState :=SERVICE_RUNNING;
   ServiceStatus.dwCheckPoint   :=0;
   ServiceStatus.dwWaitHint     :=0;

   if not SetServiceStatus (ServiceStatusHandle,ServiceStatus) then
   begin
     Status:=GetLastError;
    LogError('SetServiceStatus');
     exit;
   end;
 hThread:=CreateThread(nil,0,@MainServiceThread,nil,0,ThID);
 WaitForSingleObject(hThread,INFINITE);
 CloseHandle(hThread);
 end;

begin
 DispatchTable[0].lpServiceName:=ServiceName;
 DispatchTable[0].lpServiceProc:=@ServiceProc;
 DispatchTable[1].lpServiceName:=nil;
 DispatchTable[1].lpServiceProc:=nil;
 if not StartServiceCtrlDispatcher(DispatchTable[0]) then
   LogError('StartServiceCtrlDispatcher Error');

end.

Vlad   (2008-07-24 10:19:00) [1]


> Сергей М. ©   (22.07.08 20:26) [26]
Вариант   (23.07.08 07:03) [27]

Спасибо за наводку и советы. Переделал с проверкой возвращаемых результатов CreateProcess, WaitForSingleObject и OpenProcess, который добавил для получения HANDLE.
Перенес код в консольное приложение, как и посоветовал Вариант   (22.07.08 12:39) [24], отладил, затем перенес в сервис.
Все отлично работает.
Отдельное спасибо Rouse_ © и sniknik ©за примеры.

Вариант   (2008-07-23 07:03:00) [2]


> Vlad   (22.07.08 17:45) [25]

Да - косяк. ProcessID и HANDLE разные вещи.  Если не разобрался еще в чем косяк, то - процесс надо открыть для получения HANDLE -см. OpenProcess или создать, если процесс не найден -см. CreateProcess. И анализируй возврат функций - WaitForSingleObject например может вернуть и WAIT_FAILED, что в твоем случае и было скорее всего.

Сергей М.   (2008-07-22 20:26:00) [3]

Косяк не только и не столько в этом.

Заимей приличие анализировать результаты WinAPI-вызовов)

Vlad   (2008-07-22 17:45:00) [4]

Подозреваю, что нашел свой косяк...

.............................
If Process32First(HSnapShot, pe) Then
   repeat
     if pe.szExeFile='aserv.exe' then
     begin
       AppRunning:=true;
       hndl:=pe.th32ProcessID;
     end;
   until ( not Process32Next(HSnapShot,pe) );
   closehandle(HSnapShot);
   if AppRunning then
     WaitForSingleObject( hndl , INFINITE)
......................

Вариант   (2008-07-22 12:39:00) [5]


> Vlad   (22.07.08 12:12) [23]


> Переделал по твоему варианту. Ничего не изменилось - та
> же 100% загруженность проца (((


Код твой не читал - нет времени, да и переделанного кода тут нет.

Могу только сказать, что WaitForSingleObject(HANDLE,INFINITE) при HANDLE в несигнальном состоянии не загружает процессор, а переводит поток в состояние ожидания события. Значит есть ошибка в логике выполнения программы. Поищи или код выложи сюда. Дам совет, напиши сперва обычную консольную или GUI задачу, с отладчиком продись по коду и найди возможные недоразумения. А потом уже рабочий и отлаженный код переноси в сервис.

Vlad   (2008-07-22 12:12:00) [6]


> Сергей М. ©   (22.07.08 10:29) [21]

Спасибо. Но если честно, то мне кажется, что для меня это пока слишком сложно (((


> Вариант   (22.07.08 10:31) [22]

Переделал по твоему варианту. Ничего не изменилось - та же 100% загруженность проца (((

Вариант   (2008-07-22 10:31:00) [7]


> Vlad   (22.07.08 10:04) [19]

если первоначально процесс запущен не тобой

Вариант -

1 Найди процесс в памяти (например CreateToolhelp32Snapshot) -> если нет процесса то 2, если есть процесс выполни 3
2 - создай процесс, получив его Handle, отслеживай по WaitFor...., при переходе handle  в сигнальное состояние (процесс завершен) выполни 2
3  - открой процесс, получив его Handle, отслеживай по WaitFor (SingleObject или MultipleObjects)...., при переходе handle  в сигнальное состояние (процесс завершен) выполни 2

Сергей М.   (2008-07-22 10:29:00) [8]

Неправильно понял.

http://msdn.microsoft.com/en-us/library/ms802952.aspx

Rouse_   (2008-07-22 10:15:00) [9]


> Когда я запускаю чуть переделанный сервис Rouse_ ©, то он
> отжирает все свободное процесорное время, то есть загрузка
> 100%. Как обычно этого избегают? Таймер?

Это потому что рабочий цикл сервиса пустой и крутится в холостую отьедая процессорное время :) Добавь полезную нагрузку и все будет нормально :)

Vlad   (2008-07-22 10:04:00) [10]

Мммм... Правильно ли я понял, что предлагается сделать глобальный хук на (например) CreateProcessA? И там уже смотреть, оно-не оно?

Сергей М.   (2008-07-22 09:50:00) [11]


> Vlad   (22.07.08 09:41) [17]


Чем, собссно, в этом "разрезе" сервис отличается от не-сервиса ?
Ничем. Обычное приложение решит ту же задачу с той же степенью кривизны логики. Так зачем же кривую логику тащить сразу в сервис ?

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

На wasm.ru имеется статья с примерами.

Vlad   (2008-07-22 09:41:00) [12]


> Сергей М. ©   (21.07.08 19:21) [16]

Сударь, вы столь многословны )))
Шучу, спасибо за ответ.
А какие есть альтернативные пути решения? Код вверху.
Я не прошу написать мне код, хоть пример был бы желателен, но совершенно необязателен. Дайте направление. Если разбирусь сам, хорошо, если нет, задам вопрос уже в другой теме и хоть с какими то конкретными знаниями.

Сергей М.   (2008-07-21 19:21:00) [13]


> вы считаете, это нормальное решение?


Это дерьмовое решение.
Хоть в сервисе, хоть не в сервисе.

Vlad   (2008-07-21 16:44:00) [14]

По поводу 100%-ой загрузки процессора...
Использование в сервисе SetTimer, KillTimer - это нормальная практика? Сам сервис призван делать только 1 вещь -мониторить запущен ли определенный процесс и если нет, запускать его... Думаю сделать опрос по таймеру, а не как сейчас... Как вы считаете, это нормальное решение?

Vlad   (2008-07-21 14:00:00) [15]


> Сергей М. ©   (21.07.08 13:05) [12]

Я посчитал, что проще найти нормальный пример. Мне не трудно отформатировать, но лично для меня такой код - это признак плохого отношения к читателям. Но это естественно мое личное ИМХО.


> palva ©   (21.07.08 13:27) [13]

Буду иметь ввиду, спасибо.

А по моем двум вопросам, подскажите?
> Vlad   (21.07.08 12:19) [9]

palva   (2008-07-21 13:27:00) [16]


> Я не смог продраться через неотформатированный код и рваные
> объяснения. Может я и не прав.

Может быть, неправ в том, что искал статьи ориентированные на Delphi. API-программированием логичнее заниматься на си, и дельных материалов по программированию служб можно найти гораздо больше, если не ограничиваться языком Delphi. Даже документацию по API лучше читать в MSDN, а не в делфийском хэлпе.

Сергей М.   (2008-07-21 13:05:00) [17]


> Vlad   (21.07.08 12:33) [11]


Отформатировать сравнительно небольшой код ради благой идеи понять как он работает вовсе не сложно.

Vlad   (2008-07-21 12:33:00) [18]


> Сергей М. ©   (21.07.08 12:24) [10]

Честно?
Просто пример с сервисом на WinApi был наиболее разжеван и, как мне показалось (но тут товарищи не согласны вроде), написан более знающим человеком, чем примеры с TServiceApplication. На самом деле, с последним я нашел только один пример, зато в куче мест.
Например вот тут http://www.realcoding.net/article/view/4164
Я не смог продраться через неотформатированный код и рваные объяснения. Может я и не прав.

Сергей М.   (2008-07-21 12:24:00) [19]


> Vlad   (18.07.08 15:40) [6]
>
>


> Мне показалось, что ничем не хуже, чем TServiceApplication


Совершенно нелогично)

Раз ты искал альтернативу классу TServiceApplication, значит он тебя чем-то не устраивает. Вот я и спрашиваю - чем он тебя не устраивает ?

Vlad   (2008-07-21 12:19:00) [20]


> sniknik ©   (18.07.08 16:48) [7]
> Rouse_ ©   (18.07.08 19:31) [8]

Спасибо, оба примера очень информативны.
Если позволите, еще парочка ламерских вопроса...
1) Когда я запускаю чуть переделанный сервис Rouse_ ©, то он отжирает все свободное процесорное время, то есть загрузка 100%. Как обычно этого избегают? Таймер?
2) Эм... Мне стыдно, но я не пойму, почему он ругается на BM_CLICK. Неизвестный идентификатор. В Uses прописаны Windows, WinSvc, ShellApi;
Выполняющийся код внизу.

function ServiceThread(P: Pointer): DWORD; stdcall;
var
 h,HW:HWND;
 si: Tstartupinfo;
 pr: Tprocessinformation;
begin
 if not ReportStatusToSCMgr(SERVICE_RUNNING, NO_ERROR, 0) then begin
   ErrorLog('ServiceThread SERVICE_RUNNING : '+GetErrosString);
   result:= GetLastError;
   exit;
 end;
 try
   while (Status.dwCurrentState <> SERVICE_STOP_PENDING) do begin

     h:=FindWindow(nil,'Сервер регистрации пользователей');
     If h=0 then
     begin
       FillChar( Si, SizeOf( Si ) , 0 );
       with Si do
       begin
         cb := SizeOf( Si);
         dwFlags := startf_UseShowWindow;
         wShowWindow := 4;
       end;
     Createprocess(nil, 'C:\MasterCash\aserv.exe', nil, nil,false, Create_default_error_mode, nil, nil, si, pr);
     sleep(10000);
     HW := FindWindowEx(FindWindow('TMessageForm', 'aserv'), 0, 'TButton', nil);
     if HW<>0 then
       //PostMessage (hw, BM_CLICK, 0, 0);
     sleep(1000);
     h:=FindWindow(nil,'Сервер регистрации пользователей');
     ShowWindow(h,SW_MINIMIZE);
   end;

   end;
   result:= 0;
 finally
   Status.dwCurrentState:= SERVICE_STOP;
 end;
end;

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо