Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2008.08.31;
Скачать: CL | DM;

Вниз

Попытка разобраться с сервисами   Найти похожие ветки 

 
Vlad   (2008-07-18 14:09) [0]

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

Вот код...

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.


 
Rouse_ ©   (2008-07-18 14:21) [1]

А где ты тут видишь процедуру регистрации сервиса в SCM? :)


 
sniknik ©   (2008-07-18 14:22) [2]

> это автор что-то намудрил, или я
а ты то как думаешь?

> Где ошибка?
вот например одна...
procedure LogError(ErrorString:string);
begin
end;

сделал пустышку из самой главной процедуры программы...

это уже мелочи
LogError("SetServiceStatus");
совершенно не информативное сообщение об ошибке.

дальше можно не искать.
без нормального лога и нормальных ошибок (если не видиш в них смысла),  можно сразу бросать программирование... ламер программистом не станет.


 
sniknik ©   (2008-07-18 14:25) [3]

http://forum.chertenok.ru/my_download.php?tema=del&action=show&id=173


 
Сергей М. ©   (2008-07-18 14:28) [4]


> Vlad   (18.07.08 14:09)  


А чем, собссно, не устраивает имплементация сервиса под управлением готовых дельфийских классов TServiceApplication и TService ?


 
Dennis I. Komarov ©   (2008-07-18 14:46) [5]

> [4] Сергей М. ©   (18.07.08 14:28)

Дык
> Переписал пример, найденный в интернете.

И все...


 
Vlad   (2008-07-18 15:40) [6]


> sniknik ©   (18.07.08 14:22) [2]
> вот например одна...
> procedure LogError(ErrorString:string);
> begin
> end;
> сделал пустышку из самой главной процедуры программы...

Понял... Делаю...

> LogError("SetServiceStatus");

Не мое, так в примере.

> sniknik ©   (18.07.08 14:25) [3]

Ссылка в том посте битая... (


> Сергей М. ©   (18.07.08 14:28) [4]

не знаю... Просто этот пример попался первым... Мне показалось, что ничем не хуже, чем TServiceApplication...


> Dennis I. Komarov ©   (18.07.08 14:46) [5]

Каюсь... Но там не только пример, там все с объяснениями, что хорошо. Все прочел и только потом скатал )))

Делаю логирование ошибок, и если результаты мне не смогут помочь, подниму эту тему еще раз. Все равно спасибо, ибо "Ёж-птица гордая, пока не пнешь, не полетит" )))


 
sniknik ©   (2008-07-18 16:48) [7]

> Не мое, так в примере.
автор ламер

> Ссылка в том посте битая... (
сообщи 13-му, на пока сюда положил
http://webfile.ru/2098794

> Мне показалось, что ничем не хуже, чем TServiceApplication...
гораздо муторнее... разобраться как работает, вполне, но вот писать так постоянно... нет уж, увольте.


 
Rouse_ ©   (2008-07-18 19:31) [8]

Возьми мой пример и переделай под себя: http://rouse.drkb.ru/winapi.php#twoservicedemo
(второй с низу)


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


> 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;


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


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


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


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

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


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


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

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


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


> Vlad   (21.07.08 12:33) [11]


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


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


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

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


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


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

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


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

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

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


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

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


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


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


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


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


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

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


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


> Vlad   (22.07.08 09:41) [17]


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

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

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


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

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


 
Rouse_ ©   (2008-07-22 10:15) [20]


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

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


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

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

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


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


> Vlad   (22.07.08 10:04) [19]

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

Вариант -

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


 
Vlad   (2008-07-22 12:12) [23]


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

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


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

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


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


> Vlad   (22.07.08 12:12) [23]


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


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

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


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

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

.............................
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 20:26) [26]

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

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


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


> Vlad   (22.07.08 17:45) [25]

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


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


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

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



Страницы: 1 вся ветка

Текущий архив: 2008.08.31;
Скачать: CL | DM;

Наверх




Память: 0.56 MB
Время: 0.013 c
8-1184936230
DmitriyZ
2007-07-20 16:57
2008.08.31
Как в Delphi сгенерировать звук произвольной частоты и вывести ег


2-1216816296
lavgirls
2008-07-23 16:31
2008.08.31
Програ для отображения трафика


2-1216927230
self.name
2008-07-24 23:20
2008.08.31
компонент внутри компонента...


15-1215634451
@!!ex
2008-07-10 00:14
2008.08.31
CALLBACk процедура как часть класса в С++


15-1215956731
ms1
2008-07-13 17:45
2008.08.31
Русские банки