| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Попытка разобраться с сервисами [D7, XP]
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.
Rouse_ (2008-07-18 19:31:00) [21]Возьми мой пример и переделай под себя: http://rouse.drkb.ru/winapi.php#twoservicedemo
(второй с низу)
sniknik (2008-07-18 16:48:00) [22]> Не мое, так в примере.
автор ламер
> Ссылка в том посте битая... (
сообщи 13-му, на пока сюда положил
http://webfile.ru/2098794
> Мне показалось, что ничем не хуже, чем TServiceApplication...
гораздо муторнее... разобраться как работает, вполне, но вот писать так постоянно... нет уж, увольте.
Vlad (2008-07-18 15:40:00) [23]
> 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]
Каюсь... Но там не только пример, там все с объяснениями, что хорошо. Все прочел и только потом скатал )))
Делаю логирование ошибок, и если результаты мне не смогут помочь, подниму эту тему еще раз. Все равно спасибо, ибо "Ёж-птица гордая, пока не пнешь, не полетит" )))
Dennis I. Komarov (2008-07-18 14:46:00) [24]> [4] Сергей М. © (18.07.08 14:28)
Дык
> Переписал пример, найденный в интернете.
И все...
Сергей М. (2008-07-18 14:28:00) [25]
> Vlad (18.07.08 14:09)
А чем, собссно, не устраивает имплементация сервиса под управлением готовых дельфийских классов TServiceApplication и TService ?
sniknik (2008-07-18 14:25:00) [26]http://forum.chertenok.ru/my_download.php?tema=del&action=show&id=173
sniknik (2008-07-18 14:22:00) [27]> это автор что-то намудрил, или я
а ты то как думаешь?
> Где ошибка?
вот например одна...
procedure LogError(ErrorString:string);
begin
end;
сделал пустышку из самой главной процедуры программы...
это уже мелочи
LogError('SetServiceStatus');
совершенно не информативное сообщение об ошибке.
дальше можно не искать.
без нормального лога и нормальных ошибок (если не видиш в них смысла), можно сразу бросать программирование... ламер программистом не станет.
Rouse_ (2008-07-18 14:21:00) [28]А где ты тут видишь процедуру регистрации сервиса в SCM? :)
| |
Страницы: 