Написание сервиса
Помогите, кто может, написать сервис для мониторинга свободного дискового пространства и отправки данных на мыло. Я вот попытался наваять консольную прогу:
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.
При запуске выдает черный экран, закрывающийся через секунду, в сервисах не появляется. И где я не прав и что не так?
|