PDA

Показать полную графическую версию : Как программно установить службу в windows?


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

PS код проекта (запускается как приложение или как служба, если с запускать с ключом -INSTALL, но только в 2k и XP, в 7ке не хотит служба устанавливаться):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 и завершающее приложение.

Любезный
10-05-2011, 18:43
А при попытке ручной инсталляции какая-нить ошибка вылезает?

Системный журнал смотрел?

ИМХО, никаких иконок в трее в службах быть не должно - правильная служба не должна сама общаться ни с рабочим столом, ни с панелью задач.

BlackEric
10-05-2011, 22:06
Начиная с Vista запрещено взимодействие служб с рабочим столом. Поэтому - все формы нафиг.

K1L0z
11-05-2011, 19:19
Форма в приложении нужна - она будет использоваться приложением, которое будет подключаться к службе.
Просто не хочется таскать лишние файлы - сделал приложение/служба в одной упаковке.

При ручной регистрации службы ошибок нет. Разве что требуется установка для exe-шника режима совместимости с XP для инсталляции ключом /install. При использовании утилиты sc, из консоли, вообще все в порядке.

И все же как установить службу программно?
Т.е. запустил приложение (которое приложение-служба), нажал в нем кнопку - служба установилась (зарегилась и запустилась), после перезапуска приложения увидели что служба есть и работает - подключились к ней (с этого приложения или по сети - через DataSnap).

Взаимодействие через DataSnap уже есть - осталось дело за малым: программно установить службу под Vista/7 что бы не требовался предварительный вход в систему и запуск приложения-сервера.


PS Хотя бы подскажите как запустить дочерний процесс с правами администратора (что бы всплыл обычный виндовый запрос запуска с правами админа) и параметрами командной строки?

K1L0z
12-05-2011, 12:27
Так нашел MSDN - Redesign for UAC Compatibility (UAC) (http://msdn.microsoft.com/en-us/library/bb756922.aspx)
Написал функциюfunction RunAsAdmin(HWND: hWnd; lpFile,lpParameters: String): Boolean;
var
sei: SHELLEXECUTEINFO;
begin
try
ZeroMemory ( @sei, SizeOf(sei) );

sei.cbSize := SizeOf(SHELLEXECUTEINFOW);
sei.Wnd := hWnd;
sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI;
sei.lpVerb := 'runas';
sei.lpFile := PWideChar(lpFile);
sei.lpParameters := PWideChar(lpParameters);
sei.nShow := SW_SHOWNORMAL;

if ( not ShellExecuteEx ( @sei ) ) then begin
//ShowMessage( 'Error: ShellExecuteEx failed ' + IntToStr(GetLastError) );
Result := False;
Exit;
end;
Result := True;
except
else Result := False;
end;
end;

//пример использования
RunAsAdmin(Forms.Application.Handle, IncludeTrailingPathDelimiter(ParamStr(0)),'/INSTALL');Теперь нужно скрыть появляющееся при удачной или не удачной установки службы сообщение - как это сделать, кто-нибудь знает?

Любезный
12-05-2011, 20:05
Теперь нужно скрыть появляющееся при удачной или не удачной установки службы сообщение - как это сделать, кто-нибудь знает?

Попробуй добавить параметр /SILENT

Правда, прятать сообщение не советую - если будет неудача у клиента, будешь долго разбираться что к чему.

K1L0z
13-05-2011, 09:58
Спасибо))
Ну я после попятки установки проверяю зарегистрирована ли служба, если нет, то прошу зайти под админом и запустить программу ещё раз - она проверит наличие службы и попытается ещё раз установить. Пока так, а там видно будет...

Последний вопрос по службам:
Зависимости от каких служб нужно поставить что бы уже была доступна сеть, конкретно TCP/IP - для работы DataSnap нужен...




© OSzone.net 2001-2012