Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Проблема с созданием Сервиса

Автор: Teran 25.12.2006, 17:43

создаю сервис 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.

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

Автор: Snowy 25.12.2006, 17:45

Потому что мессаджебокс не даёт идти дальше.
А ты его не видишь, потому что он запущен под системным аккаунтом.
Убери боксы и сделай записи в системный лог или лог-файл.

Автор: Teran 25.12.2006, 19:12

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

Автор: Snowy 25.12.2006, 19:41

Код


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;

Автор: Teran 25.12.2006, 21:52

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 26.12.2006, 11:01

уже пробовал создавать так

Код


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;

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

Автор: Teran 26.12.2006, 14:11

Найдены ошибки:
Когда устанавливать сервис из командной строки: имя файла + /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.

Автор: Girder 27.12.2006, 13:48

Поиск... тебе в помощь. Вот помнится писал: http://forum.vingrad.ru/index.php?showtopic=57518&view=findpost&p=471413

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