VPF::Сервис в как классе - Форум программистов

dvamaster

Дата 12.11.2010, 07:06 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 559
Регистрация: 30.6.2004
Где: Россия : Курган

Репутация: 2
Всего: 10

Доброго времени суток!

Создаю класс-обертку для сервиса

создаю WinAPI совместимые функции (реализация взята из библиотеки WinLight)

Код


  PServiceCtrlHandler := VirtualAlloc(nil, 12, MEM_RESERVE or MEM_COMMIT,
    PAGE_EXECUTE_READWRITE);
  asm
    mov  EAX, Self
    mov  ECX, [EAX].TCore.PServiceCtrlHandler
    mov  word  ptr [ECX + 0], $6858               // pop  EAX
    mov  dword ptr [ECX + 2], EAX                 // push _Self_
    mov  word  ptr [ECX + 6], $E950               // push EAX
    mov  EAX, OFFSET(TCore.ServiceCtrlHandler)
    sub  EAX, ECX
    sub  EAX, 12
    mov  dword ptr [ECX + 8], EAX                 // jmp  TCore.ServiceCtrlHandler
  end;
  PServiceProc := VirtualAlloc(nil, 12, MEM_RESERVE or MEM_COMMIT,
    PAGE_EXECUTE_READWRITE);
  asm
    mov  EAX, Self
    mov  ECX, [EAX].TCore.PServiceProc
    mov  word  ptr [ECX + 0], $6858               // pop  EAX
    mov  dword ptr [ECX + 2], EAX                 // push _Self_
    mov  word  ptr [ECX + 6], $E950               // push EAX
    mov  EAX, OFFSET(TCore.ServiceProc)
    sub  EAX, ECX
    sub  EAX, 12
    mov  dword ptr [ECX + 8], EAX                 // jmp  TCore.ServiceProc
  end;

В теле программы создаю класс

Код


  Core := CreateCore;
  Core.RunAsService;
  Core.Destroy

процедура запуска сервиса

Код


function TCore.RunAsService: BOOL; stdcall;
begin
  FRunAsService := true;
  FConsoleClose := false;

  FDispatchTable[0].lpServiceName := szServiceName;
  FDispatchTable[0].lpServiceProc := PServiceProc;
  FDispatchTable[1].lpServiceName := nil;
  FDispatchTable[1].lpServiceProc := nil;

  Result := StartServiceCtrlDispatcher(FDispatchTable[0])
end;

процедура сервиса

Код


procedure TCore.ServiceProc(argc: DWORD; var argv: array of PChar); stdcall;
begin
  FServiceStatus.dwServiceType := SERVICE_WIN32;
  FServiceStatus.dwCurrentState := SERVICE_START_PENDING;
  FServiceStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP;
  FServiceStatus.dwWin32ExitCode := 0;
  FServiceStatus.dwServiceSpecificExitCode := 0;
  FServiceStatus.dwCheckPoint := 0;
  FServiceStatus.dwWaitHint := 0;

  FServiceStatusHandle := RegisterServiceCtrlHandler(szServiceName,
    PServiceCtrlHandler);

  if FServiceStatusHandle = 0 then
    Exit;

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

  SetRealmServiceStatus;

  Execute
end;

Суть проблемы:

Класс уничтожается раньше чем происходит выход из процедуры сервиса.

Как понимаю это специфика работы сервиса и функции StartServiceCtrlDispatcher в частности.

Есть ли решение этой проблемы?

Добавлено через 5 минут и 16 секунд
В VCL это решается созданием TApplication из модуля Forms

но я не использую VCL, и считаю это кривым решением

--------------------

Хорошую информацию трудно добыть. Сделать с ней что-нибудь - еще труднее. /L. Skywalker/

Что же я сделал не так? /Король Лир/

Я делаю это для твоего же блага! /Любой родитель и палач/

PKUNZIP.ZIP /неизвестный/

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »