Показать сообщение отдельно
  #4  
Старый 10.05.2011, 16:54
KiL0z KiL0z вне форума
Прохожий
 
Регистрация: 27.05.2010
Сообщения: 23
Репутация: 10
По умолчанию

Так накатал такой вот проект - http://zalil.ru/31009630
Как правильно создавать новую службу в 7ке (в 2k и XP работает) , а то не хочет устанавливаться и все тут (даже с админскими правами (помагает только предварительная установка для exe-шника совместимости с WinXP), если конечно ручками не ставить через утилиту SC) ?

PS код проекта:
Код:
program TestService;

uses
  SvcMgr,
  Forms,
  SysUtils,
  Windows,
  Types,
  WinSvc,
  UnitMyService in 'UnitMyService.pas' {MyService: TService},
  UnitAboutForm in 'UnitAboutForm.pas' {AboutForm1},
  UnitDataModule in 'UnitDataModule.pas' {DataModule1: TDataModule};

const
  NameService = 'MyService';

{$R *.RES}

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;

function DeleteNTService(ServiceName: string): boolean;
var
  hServiceToDelete, hSCMgr: SC_HANDLE;
  RetVal: LongBool;
  FunctRetVal: Boolean;
begin
  FunctRetVal := false;
  hSCMgr := OpenSCManager(nil, nil, SC_MANAGER_CREATE_SERVICE);
  if (hSCMgr <> 0) then begin
    hServiceToDelete := OpenService(hSCMgr, PChar(ServiceName),
      SERVICE_ALL_ACCESS);
    RetVal := DeleteService(hServiceToDelete);
    CloseServiceHandle(hSCMgr);
    FunctRetVal := RetVal;
  end;
  DeleteNTService := FunctRetVal;
end;

function Installing: Boolean;
begin
  if FindCmdLineSwitch('INSTALL',['-','\','/'], True) then
    Result := CreateNTService(ParamStr(0), NameService)
  else
    if FindCmdLineSwitch('UNINSTALL',['-','\','/'], True) then
      Result := DeleteNTService(NameService)
    else
      Result := False;
end;

function StartService: Boolean;
var
  Mgr, Svc: Integer;
  UserName, ServiceStartName: string;
  Config: Pointer;
  Size: DWORD;
begin
  Result := False;
  Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if (Mgr <> 0) then begin
    Svc := OpenService(Mgr, PChar(NameService), SERVICE_ALL_ACCESS);
    Result := Svc <> 0;
    if Result then begin
      QueryServiceConfig(Svc, nil, 0, Size);
      Config := AllocMem(Size);
      try
        QueryServiceConfig(Svc, Config, Size, Size);
        ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
        if CompareText(ServiceStartName, 'LocalSystem') = 0 then
          ServiceStartName := 'SYSTEM';
      finally
        Dispose(Config);
      end;
      CloseServiceHandle(Svc);
    end;
    CloseServiceHandle(Mgr);
  end;
  if Result then begin
    Size := 256;
    SetLength(UserName, Size);
    GetUserName(PChar(UserName), Size);
    SetLength(UserName, StrLen(PChar(UserName)));
    Result := CompareText(UserName, ServiceStartName) = 0;
  end;
end;

begin
  if Installing or StartService then begin
    SvcMgr.Application.Initialize;
    SvcMgr.Application.CreateForm(TAboutForm1, AboutForm1);
    SvcMgr.Application.CreateForm(TMyService, MyService);
    SvcMgr.Application.CreateForm(TDataModule1, DataModule1);
    SvcMgr.Application.Run;
  end
  else begin
    Forms.Application.ShowMainForm := False;
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TAboutForm1, AboutForm1);
    Forms.Application.CreateForm(TMyService, MyService);
    Forms.Application.CreateForm(TDataModule1, DataModule1);
    Forms.Application.Run;
  end;
  DataModule1.EnableTrayIcon := True;
end.
Форма AboutForm1 пустая, просто для примера.
На DataModule1 лежит TrayIcon и контекстное меню для него, вызывающее AboutForm1 и завершающее приложение.
Ответить с цитированием