Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 05.04.2006, 10:35
fispol fispol вне форума
Прохожий
 
Регистрация: 05.04.2006
Сообщения: 1
Репутация: 10
По умолчанию Написание сервиса

Помогите, кто может, написать сервис для мониторинга свободного дискового пространства и отправки данных на мыло. Я вот попытался наваять консольную прогу:

program Project1;
{$APPTYPE CONSOLE}
uses SysUtils, Windows, WinSvc;
const
ServiceName = 'My_servis';
ServiceDisplayName = 'My_servis';
var
DispatchTable : array [0..1] of _SERVICE_TABLE_ENTRYA;
MyServiceStatus : SERVICE_STATUS;
MyServiceStatusHandle : SERVICE_STATUS_HANDLE;
outfile: TextFile;
procedure LogError(s : string);
begin
writeln(s);
end;
procedure ServiceCtrlHandler(Opcode : Cardinal);stdcall;
begin
case Opcode of
SERVICE_CONTROL_PAUSE :
begin
MyServiceStatus.dwCurrentState := SERVICE_PAUSED;
end;
SERVICE_CONTROL_CONTINUE :
begin
MyServiceStatus.dwCurrentState := SERVICE_RUNNING;
end;
SERVICE_CONTROL_STOP :
begin
MyServiceStatus.dwWin32ExitCode:=0;
MyServiceStatus.dwCurrentState := SERVICE_STOPPED;
MyServiceStatus.dwCheckPoint :=0;
MyServiceStatus.dwWaitHint :=0;
if not SetServiceStatus (MyServiceStatusHandle, MyServiceStatus)
then
begin
LogError('SetServiceStatus');
Exit;
end;
exit;
end;
SERVICE_CONTROL_INTERROGATE : ;
end;
if not SetServiceStatus (MyServiceStatusHandle, MyServiceStatus)
then
begin
LogError('SetServiceStatus');
Exit;
end;
end;

{procedure ServiceProc; stdcall;}
procedure ServiceProc(argc : DWORD; var argv : array of PChar); stdcall;
begin
MyServiceStatus.dwServiceType := SERVICE_WIN32;
MyServiceStatus.dwCurrentState := SERVICE_START_PENDING;
MyServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
or SERVICE_ACCEPT_PAUSE_CONTINUE;
MyServiceStatus.dwWin32ExitCode := 0;
MyServiceStatus.dwServiceSpecificExitCode := 0;
MyServiceStatus.dwCheckPoint := 0;
MyServiceStatus.dwWaitHint := 0;
MyServiceStatusHandle := RegisterServiceCtrlHandler(ServiceName,@ServiceCtr lHandler);

if MyServiceStatusHandle = 0
then WriteLn('RegisterServiceCtrlHandler Error');
SetServiceStatus(MyServiceStatusHandle, MyServiceStatus);
repeat
if MyServiceStatus.dwCurrentState <> SERVICE_PAUSED
then
begin
AssignFile(outfile, 'c:\outfile.txt');
Rewrite(outfile);
writeln(outfile, 'Ïðèâåò èç Delphi');
CloseFile(outfile);
writeln('Ñåðâèñ ðàáîòàåò');
sleep(100);
end;
until MyServiceStatus.dwCurrentState = SERVICE_STOPPED;

end;


begin
DispatchTable[0].lpServiceName := ServiceName; {Çàäàíèå èìåíè ñåðâèñà}
DispatchTable[0].lpServiceProc := @ServiceProc; {Èìÿ ñàìîé ïðîöåäóðû}
DispatchTable[1].lpServiceName := nil;
DispatchTable[1].lpServiceProc := nil;
StartServiceCtrlDispatcher(DispatchTable[0]);
if not StartServiceCtrlDispatcher(DispatchTable[0])
then LogError('StartServiceCtrlDispatcher Error'); {Îáðàáîòêà îøèáêè}
end.

При запуске выдает черный экран, закрывающийся через секунду, в сервисах не появляется. И где я не прав и что не так?
Ответить с цитированием
  #2  
Старый 09.04.2006, 10:05
Аватар для Ross
Ross Ross вне форума
Активный
 
Регистрация: 15.10.2005
Адрес: Казань
Сообщения: 250
Репутация: 30
По умолчанию

А тебе именно консольную нужно?
Ответить с цитированием
  #3  
Старый 12.04.2006, 18:23
Ustin Ustin вне форума
Прохожий
 
Регистрация: 12.04.2006
Сообщения: 1
Репутация: 10
По умолчанию

http://bugtraq.ru/forum/faq/programming/services.html
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:18.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter