Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2010.10.03;
Скачать: [xml.tar.bz2];

Вниз

объединение приложения и сервиса   Найти похожие ветки 

 
defen ©   (2010-07-11 05:01) [0]

Доброго времени суток. Подскажите пожалуйста если можно объединить сервис и приложение, которое он запускает в один ехе файл? Если можно, то как?


 
sniknik ©   (2010-07-11 15:36) [1]

в поставке дельфи есть пример - приложение scktsrvr с исходниками.

а вопрос это вовсе не WinAPI, понимаю, все непонятное кажется сложным и одинаковым, а что может быть сложнее WinAPI... но тем не менее это не одно и тоже.


 
Leonid Troyanovsky ©   (2010-07-12 08:04) [2]


> defen ©   (11.07.10 05:01)  

> объединить сервис и приложение, которое он запускает в один
> ехе файл?

uses.

--
Regards, LVT.


 
defen ©   (2010-07-12 14:52) [3]

уважаемые, это ветка "для начинающих" будте добры давать более развернутые ответы. не надо умничать!


 
Anatoly Podgoretsky ©   (2010-07-12 15:29) [4]

> defen  (12.07.2010 14:52:03)  [3]

Наконец то - Ты не умничай, ты код давай.


 
Leonid Troyanovsky ©   (2010-07-12 16:02) [5]


> defen ©   (12.07.10 14:52) [3]

> уважаемые, это ветка "для начинающих"

Ну, начиналась-то она как WinAPI.
И, видимо, для усвоения сложного задор тогда был.

> будте добры давать более развернутые ответы

А что непонятно?

--
Regards, LVT.


 
defen ©   (2010-07-13 01:31) [6]

про поставку говорили что-то...


 
Германн ©   (2010-07-13 02:37) [7]


> defen ©   (13.07.10 01:31) [6]
>
> про поставку говорили что-то...
>

Ну говорили. Искал?
Или "не умничай, код давай"?


 
defen ©   (2010-07-13 15:35) [8]

Какой код вам нужен? приложения или сервиса?


 
defen ©   (2010-07-13 15:40) [9]

От код сервиса, запускающего мою прогу... Надо, чтобы сервис перезапускал приложение при его несанкционированном закрытии...
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,Registry,
 WinSvc;

type
 TService1 = class(TService)
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
   procedure ServicePause(Sender: TService; var Paused: Boolean);
   procedure ServiceContinue(Sender: TService; var Continued: Boolean);
   procedure ServiceAfterInstall(Sender: TService);

 
 private
 
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

var
 Service1: TService1;
  pi:PROCESS_INFORMATION;
 si:STARTUPINFO;

implementation

{$R *.DFM}

const
 SERVICE_CONFIG_FAILURE_ACTIONS = 2;

 SC_ACTION_NONE = 0;
 SC_ACTION_RESTART = 1;
 SC_ACTION_REBOOT = 2;
 SC_ACTION_RUN_COMMAND = 3;

 SE_SHUTDOWN_NAME = "SeShutdownPrivilege";

type
 SC_ACTION = record
   _Type: DWORD;
   Delay: DWORD;
 end;

 SERVICE_FAILURE_ACTIONS = record
   dwResetPeriod: DWORD;
   lpRebootMsg: LPTSTR;
   lpCommand: LPTSTR;
   cActions: DWORD;
   lpsaActions: ^SC_ACTION;
 end;

function ChangeServiceConfig2(hService: SC_HANDLE; dwInfoLevel: Cardinal;
 lpInfo: Pointer): BOOL; stdcall; external advapi32 name "ChangeServiceConfig2A";

function ExecCmd(const aCommand: String;const aShow, aWaitExit: Boolean): Boolean;
var
 cmdLine,Path: String;
begin
 ZeroMemory(@si,sizeof(si));
 si.cb:=Sizeof(si);
 si.dwFlags := STARTF_FORCEONFEEDBACK+STARTF_USESHOWWINDOW;
 if aShow then si.wShowWindow := SW_SHOWNORMAL else si.wShowWindow := SW_SHOWMINNOACTIVE;
 Path := ExtractFilePath(aCommand);
 cmdLine := aCommand;

 Result :=
        CreateProcess( nil,            
                       PChar(cmdline),  
                       nil,            
                       nil,            
                       false,          
                       0,              
                       nil,            
                       PChar(Path),    
                       si,              
                       pi );            
 if Result then
 begin
   if aWaitExit then WaitForSingleObject( pi.hProcess, infinite );
//  CloseHandle(pi.hThread);
//  CloseHandle(pi.hProcess);
 end;
end;
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
ExecCmd("c:\1.exe",true,false);
AllowPause:=false;

end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
var
 RC: Integer;
begin
 RC := WaitForSingleObject(pi.hProcess,0);
 if RC<>WAIT_OBJECT_0 then TerminateProcess(pi.hProcess,0);
// CloseHandle(pi.hThread);
// CloseHandle(pi.hProcess);
end;

procedure TService1.ServicePause(Sender: TService; var Paused: Boolean);
begin
 SuspendThread(pi.hThread);
end;

procedure TService1.ServiceContinue(Sender: TService;
 var Continued: Boolean);
begin
 ResumeThread(pi.hThread);
 end;

procedure TService1.ServiceAfterInstall(Sender: TService);
const
 ACTION_COUNT = 3;
var
 scm, svc: SC_HANDLE;
 sfa: SERVICE_FAILURE_ACTIONS;
 sca: array[0..ACTION_COUNT - 1] of SC_ACTION;

 hToken: THandle;
 tkp: TOKEN_PRIVILEGES;
 ret_len: Cardinal;
begin
 scm := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
 if scm = 0 then RaiseLastWin32Error;
 try
   svc := OpenService(scm, PChar(Name), SERVICE_ALL_ACCESS);
   if svc = 0 then RaiseLastWin32Error;
   try
     sfa.dwResetPeriod := 0;
     sfa.lpRebootMsg := "Сообщение перед перезагрузкой";
     sfa.lpCommand := nil;
     sfa.cActions := ACTION_COUNT;
     sca[0]._Type := SC_ACTION_REBOOT;
     sca[0].Delay := 0;
     sca[1]._Type := SC_ACTION_REBOOT;
     sca[1].Delay := 0;
     sca[2]._Type := SC_ACTION_REBOOT;
     sca[2].Delay := 0;
     sfa.lpsaActions := @sca;

    SE_SHUTDOWN_NAME
     // т.е. если sca[n]._Type <> SC_ACTION_REBOOT, то этот кусок кода не нужен
     if not OpenProcessToken(GetCurrentProcess,
       TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then
       RaiseLastWin32Error;

     if not LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME,
       tkp.Privileges[0].Luid) then
       RaiseLastWin32Error;

     tkp.PrivilegeCount := 1;  // one privilege to set
     tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

     if not AdjustTokenPrivileges(Cardinal(hToken), False, tkp, 0,
       nil, ret_len) then
       RaiseLastWin32Error;
     // <-----

     if not ChangeServiceConfig2(svc, SERVICE_CONFIG_FAILURE_ACTIONS, @sfa) then
       RaiseLastWin32Error;
   finally
     CloseServiceHandle(svc);
   end;
 finally
   CloseServiceHandle(scm);
 end;
end;

end.


 
Leonid Troyanovsky ©   (2010-07-13 16:18) [10]


> defen ©   (13.07.10 15:40) [9]

> От код сервиса, запускающего мою прогу...

А теперь переносим функционал проги в OnExecute:

implementation

uses MyProg;

procedure TService1.Service1Execute(Sender: TService);
begin
 ..
end;

--
Regards, LVT.


 
defen ©   (2010-07-13 17:09) [11]


> А теперь переносим функционал проги в OnExecute:

? :)


 
sniknik ©   (2010-07-13 20:00) [12]

> ? :)
и действительно. почитал код... как то я по другому себе объединение представлял.

но если понимать его так, то работа сервиса должна выполняться в OnExecute.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2010.10.03;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.49 MB
Время: 0.003 c
15-1278398042
И. Павел
2010-07-06 10:34
2010.10.03
Порекомендуйте библиотеку для отчетов


10-1168354475
Priest
2007-01-09 17:54
2010.10.03
LoadPackage в COM сервере


2-1278168130
Morsik
2010-07-03 18:42
2010.10.03
Как на delphi сделать при сохранении форматы?


2-1278309141
azamatufa
2010-07-05 09:52
2010.10.03
Как пробежаться по строкам DBMemo?


2-1278866639
faiwer
2010-07-11 20:43
2010.10.03
Property &amp; var





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский