|
|
|
|
| Компьютерный форум OSzone.net » Программирование, базы данных и автоматизация действий » Программирование и базы данных » Delphi - Как программно установить службу в windows? |
|
|
Delphi - Как программно установить службу в windows?
|
|
Новый участник Сообщения: 4 |
Накатал такой вот проект - 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.
На DataModule1 лежит TrayIcon и контекстное меню для него, вызывающее AboutForm1 и завершающее приложение. |
|
|
Отправлено: 17:12, 10-05-2011 |
|
Старожил Сообщения: 295
|
Профиль | Отправить PM | Цитировать А при попытке ручной инсталляции какая-нить ошибка вылезает?
Системный журнал смотрел? ИМХО, никаких иконок в трее в службах быть не должно - правильная служба не должна сама общаться ни с рабочим столом, ни с панелью задач. |
|
Отправлено: 18:43, 10-05-2011 | #2 |
|
Старожил Сообщения: 433
|
Профиль | Отправить PM | Цитировать Начиная с Vista запрещено взимодействие служб с рабочим столом. Поэтому - все формы нафиг.
|
|
------- Отправлено: 22:06, 10-05-2011 | #3 |
|
Новый участник Сообщения: 4
|
Профиль | Отправить PM | Цитировать Форма в приложении нужна - она будет использоваться приложением, которое будет подключаться к службе.
Просто не хочется таскать лишние файлы - сделал приложение/служба в одной упаковке. При ручной регистрации службы ошибок нет. Разве что требуется установка для exe-шника режима совместимости с XP для инсталляции ключом /install. При использовании утилиты sc, из консоли, вообще все в порядке. И все же как установить службу программно? Т.е. запустил приложение (которое приложение-служба), нажал в нем кнопку - служба установилась (зарегилась и запустилась), после перезапуска приложения увидели что служба есть и работает - подключились к ней (с этого приложения или по сети - через DataSnap). Взаимодействие через DataSnap уже есть - осталось дело за малым: программно установить службу под Vista/7 что бы не требовался предварительный вход в систему и запуск приложения-сервера. PS Хотя бы подскажите как запустить дочерний процесс с правами администратора (что бы всплыл обычный виндовый запрос запуска с правами админа) и параметрами командной строки? |
|
Последний раз редактировалось K1L0z, 11-05-2011 в 22:25. Причина: добавлено PS Отправлено: 19:19, 11-05-2011 | #4 |
|
Новый участник Сообщения: 4
|
Профиль | Отправить PM | Цитировать Так нашел MSDN - Redesign for UAC Compatibility (UAC)
Написал функцию Код:
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');
|
|
|
Последний раз редактировалось K1L0z, 12-05-2011 в 12:30. Причина: добавлен пример использования функции Отправлено: 12:27, 12-05-2011 | #5 |
|
Старожил Сообщения: 295
|
Профиль | Отправить PM | Цитировать Цитата:
Правда, прятать сообщение не советую - если будет неудача у клиента, будешь долго разбираться что к чему. |
|
|
Отправлено: 20:05, 12-05-2011 | #6 |
|
Новый участник Сообщения: 4
|
Профиль | Отправить PM | Цитировать Спасибо))
Ну я после попятки установки проверяю зарегистрирована ли служба, если нет, то прошу зайти под админом и запустить программу ещё раз - она проверит наличие службы и попытается ещё раз установить. Пока так, а там видно будет... Последний вопрос по службам: Зависимости от каких служб нужно поставить что бы уже была доступна сеть, конкретно TCP/IP - для работы DataSnap нужен... |
|
Отправлено: 09:58, 13-05-2011 | #7 |
|
Участник сейчас на форуме |
 |
Участник вне форума |
 |
Автор темы |
 |
Сообщение прикреплено |
| |||||
| Название темы | Автор | Информация о форуме | Ответов | Последнее сообщение | |
| Разное - [решено] Как программно узнать ключ Windows? | somio | Программирование и базы данных | 9 | 23-01-2012 15:45 | |
| Delphi - Как отправить смс программно? | vlandex | Программирование и базы данных | 13 | 22-03-2011 09:51 | |
| Службы - [решено] как установить службу "Справка и поддержка"? | energy701 | Microsoft Windows 2000/XP | 25 | 02-02-2008 21:12 | |
| Как программно определить свой IP | Guest | Сетевые технологии | 3 | 23-06-2004 09:45 | |
| Как заставить Windows программно изменить раскладку клавы | Guest | Программирование и базы данных | 2 | 29-12-2003 02:12 | |
|
|
Время: 17:48. | © OSzone.net 2001-
|
|
Powered by: vBulletin Copyright ©2000 - 2024, Jelsoft Enterprises Ltd. |
