Сервис НТ писанный на Delphi

OTOPBA · 23.08.2006

Помогите плиз! Я уже отчаялся.. В инете все облазил.

Написал сервис, пользуясь стандартным Service Application (TService).

с ключами /install и /uninstall работал волшебно.

Стал запихивать его в инсталлятор - сервис перестал запускаться. Файл копируется куда надо, служба создается, но висит постоянно в состоянии "запуск"

Думаю ладно, фиг с тобой. Написал батник.
Проверяю им наличие файла, если нет - копирую и запускаю с ключом /install
после выполнения делаю Net Start
Все бы ничего, да вот беда, при выполнении команды /install у юзера выскакивает сообщение об успешной установке сервиса.

Как его убрать?
Слышал, что существует ключик /silence или /silent - пробовал, но мой сервис таких "слов" не знает

Подскажите пожалуйста.
Надо решить проблему либо MSI пакетом либо батником без вывода сообщения.
Скрытно поставить службу на клиентах

Всю башку сломал уже. ниче не получается.... :cry2:

/dev/AVR · 23.08.2006

Могу сырец полноценного сервиса выдать(WIN API)-DELPHI.
Взят с bugtraq.ru с полным комментом.

Bendar · 23.08.2006

слушай вылажи гденибуть этот сырец или скинь как нибуть мне. :help:

/dev/AVR · 23.08.2006

Вось.

Код:

program SimpleServ;
{$APPTYPE CONSOLE}
uses Windows, WinSVC; //Не используем SysUtils - размер *.exe будет ~25 Kb

Const
  ServicesCount = 1;
  ServiceName = 'SimpleServ';
  DisplayName = 'Simple Service';
  ServiceType = SERVICE_WIN32_OWN_PROCESS;
  ServiceDescription = 'SimpleServ by HandleX... This sample program will help ' +
                       'you to understand Windows NT Services. ' +
                       'Mail to alex_wh@mail.ru.';

Var
  ServThrHndl: THandle = 0;
  StopEvent: THandle = 0;
  aServHndl: DWord = 0;
  aServStatus: SERVICE_STATUS;

  Function IntToStr(Value: Integer): String; //Included we don't use SysUtils
  Var aSign: Bool;
  Begin
    Result := '';

    aSign := Value >= 0;
    If Not aSign Then Value := -Value;

    Repeat
      Result := Char(Value - (Value Div 10) * 10 + Byte('0')) + Result;
      Value := Value Div 10;
    Until Value = 0;

    If Not aSign Then Result := '-' + Result;
  End;

  // Helper function for windows error strings
  //Included because we don't use SysUtils
  function SysErrorMessage(ErrorCode: Integer): string;
  var
    Len: Integer;
    Buffer: array[0..255] of Char;
  begin
    Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or
      FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, ErrorCode, 0, Buffer,
      SizeOf(Buffer), nil);
    while (Len > 0) and (Buffer[Len - 1] in [#0..#32]) do Dec(Len);
    SetString(Result, Buffer, Len);
    UniqueString(Result);
    ANSItoOEM(PChar(Result), PChar(Result));
    If Result <> '' Then
      Result := IntToStr(ErrorCode) + ' ' + Result;
  end;

  Procedure ShowInfo;
  Begin
    WriteLn;
    WriteLn('                    -=* SIMPLE TRAINING SERVICE BY HandleX *=-');
  End;

  Procedure ProcessStartupParams; //Реакция на install, uninstall

    //Устанавливает "описание" для службы, под Win2k и выше
    Function SetServiceDescription(aSHndl: THandle; aDesc: String): Bool;
    Const SERVICE_CONFIG_DESCRIPTION: DWord = 1;
    Var
      DynChangeServiceConfig2: Function(
        hService: SC_HANDLE;                    // handle to service
        dwInfoLevel: DWORD;                     // information level
        lpInfo: Pointer): Bool; StdCall;        // new data
      aLibHndl: THandle;
      TempP: PChar;
    Begin
      aLibHndl := GetModuleHandle(advapi32);
      Result := aLibHndl <> 0; If Not Result Then Exit;
      DynChangeServiceConfig2 := GetProcAddress(aLibHndl, 'ChangeServiceConfig2A');
      Result := @DynChangeServiceConfig2 <> Nil; If Not Result Then Exit;
      TempP := PChar(aDesc); //ChangeServiceConfig2 хочет указатель на указатель строки
      Result := DynChangeServiceConfig2(aSHndl, SERVICE_CONFIG_DESCRIPTION, @TempP);
    End;

  Type
    TToDo = (tdError, tdInstall, tdUninstall);
    TToDo_s = Set of TToDo;
  Const
    ParamStrings: Array[tdInstall..tdUninstall] of String = ('install', 'uninstall');

  Function MapParam(aParam: String): TToDo; //Узнаёт из параметра о вашем желании;-)
  Var
    J: TToDo;
    TempStr: String;
  Begin
    Result := tdError;
    TempStr := aParam;
    If TempStr[1] In ['/', '-'] Then
      TempStr := Copy(TempStr, 2, Length(TempStr) - 1);
    UniqueString(TempStr);
      CharLower(PChar(TempStr));
    For J := Low(ParamStrings) to High(ParamStrings) Do
      If ParamStrings[J] = TempStr Then
      Begin
        Result := J;
        Exit;
      End;
  End;

  Var
    J: Integer;
    scHndl, sHndl: THandle;
    aStatus: TServiceStatus;
    toDo: TTodo_s;
  Begin
    toDo := [];
    For J := 1 to ParamCount Do
    Begin
      Include(ToDo, MapParam(ParamStr(J)));
      If tdError in toDo Then
      Begin
        ExitCode := ERROR_INVALID_PARAMETER;
        WriteLn('Unknown parameter - ' + ParamStr(J) + '. RTFM, please...');
        Exit;
      End;
    End;

    If [tdInstall, tdUninstall] <= toDo Then
    Begin
      ExitCode := ERROR_INVALID_PARAMETER;
      WriteLn('Error: you can not install and uninstall service simultaniosly. Check params.');
      Exit;
    End;

    If tdInstall in toDo Then //Устанавливаем сервис
    Begin
      Write('Connecting Service Control Manager...');
      scHndl := OpenSCManager(Nil, Nil, SC_MANAGER_CREATE_SERVICE);
      If scHndl = 0 Then
      Begin
        ExitCode := GetLastError;
        WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
        Exit;
      End;
      Try
        WriteLn('Ok');
        Write('Creating service database record...');
        sHndl := CreateService(
          SCHndl, ServiceName, DisplayName,
          SERVICE_QUERY_CONFIG Or SERVICE_CHANGE_CONFIG, ServiceType, SERVICE_DEMAND_START,
          SERVICE_ERROR_NORMAL, PChar(ParamStr(0)), Nil, Nil, Nil, Nil, Nil);

        If sHndl = 0 Then
        Begin
          ExitCode := GetLastError;
          WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
          Exit;
        End;
        Try
          WriteLn('Ok');

          If ServiceDescription <> '' Then
          Begin
            Write('Setting service description...');
            If Not SetServiceDescription(sHndl, ServiceDescription) Then
            Begin
              WriteLn('Failed!');
              WriteLn('Warning: ', SysErrorMessage(GetLastError));
              WriteLn('Warning: SetServiceDesc() failed, but service is installed!');
            End Else WriteLn('Ok');
          End;
        Finally
          CloseServiceHandle(sHndl);
        End;
      Finally
        CloseServiceHandle(SCHndl);
      End;
      WriteLn('Service "', DisplayName, '" install success.');
    End;

    If tdUninstall in toDo Then //Удаляем сервис...
    Begin
      Write('Connecting Service Control Manager...');
      scHndl := OpenSCManager(Nil, Nil, GENERIC_EXECUTE);
      If scHndl = 0 Then
      Begin
        ExitCode := GetLastError;
        WriteLn('Failed!');
        WriteLn('Error: ', SysErrorMessage(ExitCode));
        Exit;
      End;
      Try
        WriteLn('Ok');

        Write('Opening and Quering Service...');
        sHndl := OpenService(SCHndl, ServiceName,
          STANDARD_RIGHTS_REQUIRED Or SERVICE_QUERY_STATUS Or SERVICE_STOP);
        If sHndl = 0 Then
        Begin
          ExitCode := GetLastError;
          WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
          Exit;
        End;
        Try
          If Not QueryServiceStatus(sHndl, aStatus) Then
          Begin
            ExitCode := GetLastError;
            WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
            Exit;
          End;
          WriteLn('Ok');

          If aStatus.dwCurrentState <> SERVICE_STOPPED Then
          Begin
            Write('Service is running, wait until stopped...');
            If Not ControlService(sHndl, SERVICE_CONTROL_STOP, aStatus) Then
            Begin
              ExitCode := GetLastError;
              WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
              Exit;
            End;
            While aStatus.dwCurrentState <> SERVICE_STOPPED Do
            Begin
              Sleep(250); Write('.');
              If Not QueryServiceStatus(sHndl, aStatus) Then
              Begin
                ExitCode := GetLastError;
                WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
                Exit;
              End;
            End;
            WriteLn('Stopped');
          End;

          Write('Deleting Service...');
          If Not DeleteService(sHndl) Then
          Begin
            ExitCode := GetLastError;
            WriteLn('Failed!'); WriteLn('Error: ', SysErrorMessage(ExitCode));
            Exit;
          End;
          WriteLn('Ok');
        Finally
          CloseServiceHandle(sHndl);
        End;
      Finally
        CloseServiceHandle(SCHndl);
      End;
      WriteLn('Service uninstall success.');
    End;

  End;

    Function SetState(aState: DWORD): DWORD;
    Begin
      aServStatus.dwCurrentState := aState;
      If aServHndl <> 0 Then
        SetServiceStatus(aServHndl, aServStatus);
      Result := aServStatus.dwCurrentState;
    End;

    Procedure ServiceHandler(fdwControl: DWORD); StdCall;
    Begin
      Case fdwControl Of
        //Requests the service to stop.
        SERVICE_CONTROL_STOP: Begin
          SetState(SERVICE_STOP_PENDING);
          SetEvent(StopEvent);
          //Если сервис был в паузе, то рабочий поток надо возобновить
          ResumeThread(ServThrHndl);
        End;
        //Requests the service to pause.
        SERVICE_CONTROL_PAUSE: Begin
          SetState(SERVICE_PAUSE_PENDING);
          SuspendThread(ServThrHndl); //Останавливаем рабочий поток сервиса
          SetState(SERVICE_PAUSED);
        End;
        //Requests the paused service to resume.
        SERVICE_CONTROL_CONTINUE: Begin
          SetState(SERVICE_CONTINUE_PENDING);
          ResumeThread(ServThrHndl); //Восстанавливаем рабочий поток сервиса
          SetState(SERVICE_RUNNING);
        End;
        //Requests the service to update immediately its current status
        //information to the service control manager.
        SERVICE_CONTROL_INTERROGATE: Begin
          //Говорим SCM о том, в каком состоянии находится наша служба
          SetState(aServStatus.dwCurrentState);
        End;
        //Протяжно пищим в спикер -- кто-то послал USER DEFINED CONTROL CODE.
        //В реальных применениях может использоваться для подачи различных сигналов
        //самописным службам. Удобны тем, что передаются даже удалённым хостам
        //при помощи ControlService() и соотв. дескриптора удалённого SCM.
        128..255: Begin
          SuspendThread(ServThrHndl);
          Windows.Beep(1000, 500);
          //Возвращать результаты можно вызовом SetServiceStatus().
          aServStatus.dwWin32ExitCode := ERROR_SUCCESS;
          SetState(aServStatus.dwCurrentState);
          ResumeThread(ServThrHndl);
        End;
      End;
    End;

  Procedure MainServiceProc(      // Каждая служба может иметь параметры запуска...
    dwArgc: DWORD;                // Кол-во параметров - у нас не используется
    lpszArgv: Pointer); StdCall   // Массив параметров - у нас не используется
  Begin
    aServHndl := RegisterServiceCtrlHandler(ServiceName, @ServiceHandler);
    If aServHndl = 0 Then
    Begin
      ExitCode := GetLastError;
      Exit; //Какая-то ошибка, выходим, SCM будет ругаться, но сообщить мы ему ничего не можем...
    End;
    ZeroMemory(@aServStatus, SizeOf(aServStatus));
    aServStatus.dwServiceType := ServiceType;
    aServStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_PAUSE_CONTINUE;
    //Здесь может быть подсказка для небыстрых служб о том, как долго она реагирует на команды
    //aServStatus.dwWaitHint := 500;

    //Извещаем SCM, что начинается старт службы...
    SetState(SERVICE_START_PENDING);

    //Пошла процедура инициализации...

    //Получаем реальный дескриптор потока службы...
    If Not DuplicateHandle(
      GetCurrentProcess, GetCurrentThread, GetCurrentProcess,
      @ServThrHndl, 0, FALSE, DUPLICATE_SAME_ACCESS)
    Then Begin
      aServStatus.dwWin32ExitCode := GetLastError;
      SetState(SERVICE_STOPPED);
      Exit;
    End;

    //Создаём unnamed event для остановки службы по сигналу из Handler...
    StopEvent := CreateEvent(Nil, True, False, Nil);
    If StopEvent = 0 Then //Ошибка создания Event'а - выходим...
    Begin
      aServStatus.dwWin32ExitCode := GetLastError;
      SetState(SERVICE_STOPPED);
      Exit;
    End;

    SetState(SERVICE_RUNNING); //Инит прошёл, работаем!

    //Крутим цикл, бипаем по таймауту, если срабатывает event - выходим...
    //В реальной службе именно здесь может быть конкретная полезная работа
    While WaitForSingleObject(StopEvent, 500) = WAIT_TIMEOUT Do
      Windows.Beep(10000, 10); 

    //Выполняем остановку сервиса, вычищаемся...
    CloseHandle(ServThrHndl); ServThrHndl := 0;
    CloseHandle(StopEvent); StopEvent := 0;

    SetState(SERVICE_STOPPED); //Извещаем, SCM, что работа службы остановлена...
  End;                         //Поток ЭТОЙ службы завершил свою работу.

Var
  ServTableEntryArray: Array[0..ServicesCount] Of TServiceTableEntryA;

begin

  //Старт программы...

  If ParamCount > 0 Then //От нас что-то хотят...
  Begin
    ShowInfo;
    ProcessStartupParams; //Выясняем что и выходим...
    Exit;
  End;

  //Готовимся к вызову StartServiceCtrlDispatcher
  ZeroMemory(@ServTableEntryArray, SizeOf(ServTableEntryArray));
  ServTableEntryArray[0].lpServiceName := ServiceName;
  ServTableEntryArray[0].lpServiceProc := @MainServiceProc;

  If Not StartServiceCtrlDispatcher(ServTableEntryArray[0]) Then
  Begin
    ExitCode := GetLastError;
    ShowInfo; //Какая-то ошибка, выводим в консоль сообщение и выходим...
    WriteLn('Error: ', SysErrorMessage(ExitCode));
    WriteLn('This program is Windows NT Service, so it CAN NOT be run from command prompt.');
    WriteLn('You can install it with "/install" parameter.');
    WriteLn('If this service is already installed, you can run it with "net start" command.');
  End;
  //Процесс службы завершает работу, всем до свидания...
  //Если вы разместили в своём *.exe несколько служб, то здесь 
  //вы окажетесь только после остановки ВСЕХ служб процесса.
end.

Взято с bugtraq.ru линк убейте не помню

OTOPBA · 24.08.2006

http://bugtraq.ru/forum/faq/programming/services.html
взял ты его здесь.

А может кто-то имел опыт создания сервисов НЕ НА WIN API?

Поделитесь, плиз..

/dev/AVR · 24.08.2006

А че тут сложного, все в хендлер приходит и все,
а обработчик устраивай сам.

Я тоже хотел через File new service делать, но понял что лажа

Bendar · 24.08.2006

/dev/AVR
большое тебе спасибо можно сказать очень сильно выручил.

OTOPBA · 25.08.2006

Прикол хотите?
Только что рассказали.

запустить сервис надо с 2-мя ключами - MyService.exe /install /silent

и окошко с подтверждением не выдается.

Вот я гоню!
А я пробовал MyService.exe /install /silence и MyService.exe /silence /install

и у меня ничё не получалось... прогнался.

в понедельник попробую на работе - отпишусь как и что..

OTOPBA · 28.08.2006

сервис отлично работает при запуске с 2-мя ключиками:

myservice.exe /install /silent - скрытая установка, без вывода сообщения
myservice.exe /uninstall /silent - скрытое удаление, без вывода сообщения

вот так вот.

как я до этого пробовал? хз... :lol2:

Сервис НТ писанный на Delphi

OTOPBA

floppy-диск

/dev/AVR

RAID-массив

Bendar

RAM

/dev/AVR

RAID-массив

OTOPBA

floppy-диск

/dev/AVR

RAID-массив

Bendar

RAM

OTOPBA

floppy-диск

OTOPBA

floppy-диск