Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Проблема с созданием Сервиса, что не так? 
:(
    Опции темы
Teran
  Дата 25.12.2006, 17:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3
создаю сервис new->Servuces ApplicationЖ
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs;

type
  TService1 = class(TService)
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure ServiceCreate(Sender: TObject);
    procedure ServiceDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;

var
  Service1: TService1;

implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
MessageBox(0,'Start Services','Services',0);
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
MessageBox(0,'Stop Services','Services',0);
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
//
end;

procedure TService1.ServiceCreate(Sender: TObject);
begin
 MessageBox(0,'Create Services','Services',0);
end;

procedure TService1.ServiceDestroy(Sender: TObject);
begin
 MessageBox(0,'Destroy Services','Services',0);
end;

end.

но после установки пытаюсь его стартовать в "Управление компьютером -> Службы" а он почемуто не хочет полоска прогресса старта - до середины доходит быстро а после середины  длится долго и вконце пишет "не удалось запустить службу. Служба не ответила на запрос своевременно" но как ни странно остается висеть в процессах
что я не так сделал?
буду благодерен за пример

Это сообщение отредактировал(а) Teran - 25.12.2006, 17:45


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Snowy
Дата 25.12.2006, 17:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484
Потому что мессаджебокс не даёт идти дальше.
А ты его не видишь, потому что он запущен под системным аккаунтом.
Убери боксы и сделай записи в системный лог или лог-файл.
PM MAIL   Вверх
Teran
Дата 25.12.2006, 19:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3
Странно, заремил чекбоксы но все по прежнему можеть чегото в ServiceExecute(Sender: TService); не хватает?


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Snowy
Дата 25.12.2006, 19:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 30
Всего: 484
Код

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
  LogMessage('I am started', EVENTLOG_INFORMATION_TYPE);
  Started := true;
end;

procedure TService1.ServiceExecute(Sender: TService);
begin
    while not Terminated do begin
      ServiceThread.ProcessRequests(True);
    end;
end;
PM MAIL   Вверх
Teran
Дата 25.12.2006, 21:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3
Snowy, пожалуйста проделай у себя такое и если получится прикрепи файлик
 smile я все делаю также и ничего не выходит
создаю сервис с помощю компонента Gridera  - TDriver
Код

Driver1.unServiceInstall('Boxa Services','Boxa Services','D:\Prog\Dop\Services\SpyFound.exe',SERVICE_WIN32_OWN_PROCESS or SERVICE_INTERACTIVE_PROCESS,SERVICE_DEMAND_START);


Это сообщение отредактировал(а) Teran - 25.12.2006, 21:54


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Teran
Дата 26.12.2006, 11:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3
уже пробовал создавать так
Код

var
  hNewService, hSCMgr: SC_HANDLE;
  FuncRetVal: Boolean;
begin
  FuncRetVal := False;
  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
  if (hSCMgr <> 0) then
  begin
    hNewService := CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
      STANDARD_RIGHTS_REQUIRED, SERVICE_WIN32_OWN_PROCESS,
      SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL,
      PChar(ExecutablePath), nil, nil, nil, nil, nil);
    CloseServiceHandle(hSCMgr);
    if (hNewService <> 0) then
      FuncRetVal := true
    else
      FuncRetVal := false;
  end;
  CreateNTService := FuncRetVal;

но похоже что дело в самом сервисе ...
что тут не так?


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Teran
Дата 26.12.2006, 14:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 590
Регистрация: 9.9.2005
Где: Украина, Запорожь е

Репутация: 1
Всего: 3
Найдены ошибки:
Когда устанавливать сервис из командной строки: имя файла + /install  - все проходит хорошо сервис стартует и останавливается без ошибок но когда его создаеш с помощю функции при старте пишет "не удалось запустить службу. Служба не ответила на запрос своевременно"
В чем причина ???
код функции:
Код

function CreateNTService(ExecutablePath, ServiceName: string): boolean;
var
  hNewService, hSCMgr: SC_HANDLE;
  FuncRetVal: Boolean;
begin
  FuncRetVal := False;
  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
  if (hSCMgr <> 0) then
  begin
     hNewService := CreateService(hSCMgr, PChar(ServiceName), PChar(ServiceName),
      STANDARD_RIGHTS_REQUIRED, SERVICE_WIN32_OWN_PROCESS,
      SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL,
      PChar(ExecutablePath), nil, nil, nil, nil, nil);
    CloseServiceHandle(hSCMgr);
    if (hNewService <> 0) then
      FuncRetVal := true
    else
      FuncRetVal := false;
  end;
  CreateNTService := FuncRetVal;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  tmpS: string;
begin
  tmpS := 'Service_Test';
  if (CreateNTService('D:\Progr\Services1\TestService.exe', tmpS)) then MessageDlg('Service ' + tmpS + ' has been successfully created!', mtInformation, [mbOK], 0)
   else MessageDlg('Unable to create service ' + tmpS + ' Win32 Error code: ' + IntToStr(GetLastError), mtWarning, [mbOK], 0);
end;

сам же сервис написан с пом TService.


--------------------
Ни цего не понимаю
PM MAIL ICQ   Вверх
Girder
Дата 27.12.2006, 13:48 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


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

Репутация: 25
Всего: 155
Поиск... тебе в помощь. Вот помнится писал: http://forum.vingrad.ru/index.php?showtopi...st&p=471413

А для File->New->Other->Service Application там все нормально помниться работает, только нужно енто помнить: http://forum.vingrad.ru/index.php?showtopi...st&p=336679


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0544 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.