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

Вниз

Уважаемые мастера подскажите плиз, как в сервисе установить   Найти похожие ветки 

 
Alibaba   (2004-05-28 08:30) [0]

RegisterWindowMessage,
я делаю так
type
 Tlogo = class(TService)
    procedure DefaultHandler(var Message); override;
     private
     public
   
 end;
var
 logo: Tlogo;
  fmsg:integer;

procedure Tlogo.DefaultHandler(var message);
begin

     with TMessage(message) do begin
       if (msg = FMsg) then begin
            messagebox(0, pchar("произошло"),pchar("что надо"),MB_SERVICE_NOTIFICATION);
            end
  else
           inherited DefaultHandler(message);
   end;
end;

initialization
  FMsg := RegisterWindowMessage("TaskbarCreated");
что то не работает ? :-(


 
Digitman ©   (2004-05-28 09:14) [1]


> что то не работает


и не будет это работать, потому что сообщение это, будучи посланным, адресовано верхнеуровневым окнам десктопа, а у тебя  сервис, очевидно, никаких окон не создает

ко всему прочему, передача управления на DefaultHandler() произойдет лишь тогда, когда где-либо будет вызван метод Tlogo.Dispatch() ... а этот метод никто кроме тебя самого не вызовет


 
Alibaba   (2004-05-28 09:31) [2]

т.е мне сначала необходимо создать форму?
ок, а когда мне ее лудше создать, при создании сервиса или при старте?


 
Digitman ©   (2004-05-28 10:04) [3]


> т.е мне сначала необходимо создать форму?


ну почему обязательно форму ? достаточно просто окно создать, например, вызовом ф-ции AllocateHWND()

создать окно можно в OnStart, уничтожить - в OnStop

если не назначать обработчик OnExecute, диспетчеризация оконных сообщений происходит автоматически, все что требуется - просто при вызове AllocateHWND() передать ей параметром адрес метода, который будет вызываться всякий раз при получении окном любого адресованного ему сообщения

Tlogo = class(TService)
  FWnd: THandle;
..
   procedure MyWindowProc(var Message: TMessage);
..  
end;

procedure Tlogo.MyWindowProc(var Message: TMessage);
begin
if (msg = FMsg) then begin
  messagebox(0, pchar("произошло"),pchar("что надо"),MB_SERVICE_NOTIFICATION);
end ;
end;

в Tlogo.OnStart:

 FWnd := AllocateHWnd(MyWindowProc);

в Tlogo.OnStop:

 DeallocateHWnd(FWnd);


 
Alibaba   (2004-05-28 10:32) [4]

type
 Tlogo = class(TService)
   procedure MyWindowProc(var Message: TMessage);
   procedure ServiceCreate(Sender: TObject);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);

 private
 public
  FWnd: THandle;

 end;

var
 logo: Tlogo;
 fmsg:integer;
 implementation
{$R *.DFM}
procedure Tlogo.ServiceCreate(Sender: TObject);
begin
messagebox(0, pchar("service"),pchar("create"),MB_SERVICE_NOTIFICATION);
end;

procedure Tlogo.ServiceStart(Sender: TService; var Started: Boolean);
begin
messagebox(0, pchar("start"),pchar("service"),MB_SERVICE_NOTIFICATION);
FWnd := AllocateHWnd(MyWindowProc);
messagebox(0, pchar("start"),pchar("service"),MB_SERVICE_NOTIFICATION);
end;

procedure Tlogo.MyWindowProc(var Message: TMessage);
begin
if (message.Msg = FMsg) then begin
 messagebox(0, pchar("произошло"),pchar("что надо"),MB_SERVICE_NOTIFICATION);
end ;
end;
procedure Tlogo.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
DeallocateHWnd(FWnd);
end;
делаю так, а он создается, но не хочет запускаться :-(


 
Alibaba   (2004-05-28 10:43) [5]

выдается сообщение сервис стартанул и сообщение о том что обнаружена ошибка и приложение будет закрыто


 
Alibaba   (2004-05-28 10:44) [6]

выдается сообщение сервис создан и сообщение о том что обнаружена ошибка и приложение будет закрыто


 
Digitman ©   (2004-05-28 10:50) [7]

procedure Tlogo.ServiceStart(Sender: TService; var Started: Boolean);
begin
messagebox(0, pchar("start"),pchar("service"),MB_SERVICE_NOTIFICATION);
FWnd := AllocateHWnd(MyWindowProc);
messagebox(0, pchar("start"),pchar("service"),MB_SERVICE_NOTIFICATION);
Started := True;
end;

procedure Tlogo.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
DeallocateHWnd(FWnd);
Stopped := True;

end;


 
Alibaba   (2004-05-28 10:54) [8]

Уважаемый, любезнейше простите, однако и в таком виде вылетает ошибка :-(


 
Alibaba   (2004-05-28 11:05) [9]

Вернее ошибка не вылетает, но и условие
if (message.Msg = FMsg) then begin
messagebox(0, pchar("произошло"),pchar("что надо"),MB_SERVICE_NOTIFICATION);
end ;
тож не срабатывает работает


 
Digitman ©   (2004-05-28 11:07) [10]

а ты установил в параметрах сервиса опцию взаимодействия с раб.столом ?


 
Alibaba   (2004-05-28 11:13) [11]

да, стоит галочка


 
Digitman ©   (2004-05-28 11:29) [12]

как сервис стартует у тебя ? и с каким эккаунтом ?


 
Alibaba   (2004-05-28 11:30) [13]

Digitman,
прости меня за настойчивость,(и наглость) просто я в этом не сильно разбираюсь,а мне нужно чтобы после того как пользователь ввел логин и пароль на вход в систему, производились определенные действия (хотя бы выдавалось сообщение).


 
Alibaba   (2004-05-28 11:35) [14]

а вот под каким эккаунтом я даже и не знаю.
в StartType стоит stBoot, я захажу под админом


 
Digitman ©   (2004-05-28 12:25) [15]

тогда все ясно

под кем ты заходишь - это несущественно, но сам сервис в твоем случае стартует под эккаунтом "local system" в момент когда ни одна ВинСтэйшн еще не активна (про десктопы и говорить не приходится)

настоятельно рекомендую прочитать и внимательно разобраться в станд.справке "Win32 programmer"s reference", тема - "Interactive Services"

важная цитата оттуда :

It is also possible to interact with the desktop from a non-interactive service by modifying the DACLs on the interface window station and desktop or by impersonating the logged-on user and opening the interactive window station and desktop directly. For more information, see Interacting with the User by a Win32 Service.

выделенная жирным процитированная гиперссылка содержит пример кода.


 
Stany ©   (2004-05-28 14:03) [16]

Уважаемый Alibaba, ветка вроде WinApi называется, а Вы постите VCLевый сервис... советую во избежании траблов писать такие вещи на API, могу даже шаблон подкинуть, там все понятнее...


 
Alibaba   (2004-05-28 14:06) [17]

Многоуважаемый Stany ©  , буду вам только признателен, за шаблон, однако если Вы сможите пояснить мне как можно отловить вход пользователя в систему, буду признателен в двойне.


 
Digitman ©   (2004-05-28 14:15) [18]


> Alibaba   (28.05.04 14:06) [17]


ты справку почитал ? ты вник ? у тебя возникли конкр.вопросы ? куда ты в ВинАПИ ломишься без явной нужды ? оной хорош при полном понимании происходящего ... и оное дается при внимательном изучении док-ции и аналитической трасировке штатного кода от Борланда ..


 
stany ©   (2004-05-28 14:17) [19]

"отловить вход пользователя в систему" - сам бы такое хотел знать, а код сервиса, обязательно сегодня вечером - завтра, щас в универе сижу ...


 
Alibaba   (2004-05-28 14:28) [20]

Digitman ©  спасибо Вам за терпение.

винапи в принципе на будушее пригодится, а конкретно мне нужно отловить вход пользователя в систему, я понял что  методом  RegisterWindowMessage("TaskbarCreated") в моем случае оного не зафиксировать,
Поэтому, может вы сможите мне подсказать, как можно это зафиксировать( я конечно могу закинуть в автозагрузку какую-нить прогу и искать ее окно, но это как то не совсем приемлемо).
я при старте компа блокирую его, создавая Desktoр, и на этом месте комп зависает если вход в систему не произведен.
хелп я прочитал,пасибо за линк, немного понял.


 
Alibaba   (2004-05-28 14:29) [21]

>stany © заранее благодарен


 
Digitman ©   (2004-05-28 14:36) [22]


> Alibaba   (28.05.04 14:28) [20]



> хелп я прочитал,пасибо за линк, немного понял.


тогда давай о том немногом (в порядке очередности), чего понять с наскоку тебе там не удалось ...


 
Alibaba   (2004-05-28 15:01) [23]

Интерактивный сервис это тот который взаимодействует с Desktop"ом приложения. Другие десктопы не принимают пользовательского ввода.
Interacting with the User by a Win32 Service
для того чтобы сервис (не интерактивный) начал взаимодействовать с  юзером, он должен открыть пользовательскую оконную станцию ("WinSta0")и десктоп  ("Default"). Только залогинившимся пользователям и сервисам запущеным из под аккаунта LocalSystem предоставляется доступ к пользовательской оконной станции и десктопу.
мой то сервис и запускается с правами системы.
и по идее  RegisterWindowMessage("TaskbarCreated") возникает когда создается Таскбар, т.е пользователь произвелл вход в систему, как я понимаю он создается после ввода пользователем пароля. так?
т.е если мой сервис стартует раньше чем создался таскбар он должен отловить момент его создания так?


 
Alibaba   (2004-05-29 06:45) [24]

но почему же он тогда это не улавливает ????


 
Stany ©   (2004-05-29 10:30) [25]

>Alibaba лови сервис


program system_svc;

uses
 Windows,
 Messages,
 WinSvc;

const
 ServiceName="system_svc";
var
 DispatchTable   : SERVICE_TABLE_ENTRY;
 svcStatus       : SERVICE_STATUS;
 svcStatusHandle : SERVICE_STATUS_HANDLE;

function ReportStatusToSCMgr(dwState, dwExitCode, dwWait: DWORD): BOOL;
begin
 if dwState = SERVICE_START_PENDING then
   svcStatus.dwControlsAccepted := 0
 else
   svcStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or
                                   SERVICE_ACCEPT_PAUSE_CONTINUE;

 svcStatus.dwCurrentState := dwState;
 svcStatus.dwWin32ExitCode := dwExitCode;
 svcStatus.dwWaitHint := dwWait;

 if (dwState = SERVICE_RUNNING) or (dwState = SERVICE_STOPPED) then
   svcStatus.dwCheckPoint := 0
 else
   inc(svcStatus.dwCheckPoint);
 Result := SetServiceStatus(svcStatusHandle,svcStatus);
end;

procedure ServiceCtrlHandler(dwCtrlCode:DWORD);stdcall;
begin
 case dwCtrlCode of
   SERVICE_CONTROL_STOP:
   begin
     ReportStatusToSCMgr(SERVICE_STOP_PENDING,NO_ERROR,1000);
     svcStatus.dwCurrentState:= SERVICE_STOPPED;
   end;

   SERVICE_CONTROL_PAUSE:
   begin
      ReportStatusToSCMgr(SERVICE_PAUSE_PENDING, NO_ERROR, 1000);
      svcStatus.dwCurrentState:=SERVICE_PAUSED;
   end;

   SERVICE_CONTROL_CONTINUE:
   begin
     ReportStatusToSCMgr(SERVICE_CONTINUE_PENDING, NO_ERROR, 1000);
     svcStatus.dwCurrentState:=SERVICE_RUNNING;
   end;
   SERVICE_CONTROL_SHUTDOWN:;

   SERVICE_CONTROL_INTERROGATE:
     SetServiceStatus(svcStatusHandle,svcStatus);
 end;
 ReportStatusToSCMgr(svcStatus.dwCurrentState,NO_ERROR,0);
end;

procedure ServiceProc(argc:DWORD;var argv:array of PChar);stdcall;
begin
 svcStatus.dwServiceType             := SERVICE_WIN32_OWN_PROCESS or
                                        SERVICE_INTERACTIVE_PROCESS;
 //svcStatus.dwCurrentState:= SERVICE_STOPPED;
 {svcStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP
   or SERVICE_ACCEPT_PAUSE_CONTINUE;}
 svcStatus.dwWin32ExitCode           := NO_ERROR;
 svcStatus.dwServiceSpecificExitCode := 0;

 svcStatusHandle:=RegisterServiceCtrlHandler(SERVICENAME, @ServiceCtrlHandler);

 if svcStatusHandle=0 then
 begin
   ReportStatusToSCMgr(SERVICE_STOPPED,GetLastError,0);
   Exit;
 end;

 ReportStatusToSCMgr(SERVICE_START_PENDING,0,0);
 ReportStatusToSCMgr(SERVICE_RUNNING,0,0);

 while true do begin
   Sleep(1000);
   windows.Beep(70,30);
 end;
end;

begin
 DispatchTable.lpServiceName:=ServiceName;
 DispatchTable.lpServiceProc:=@ServiceProc;
 StartServiceCtrlDispatcher(DispatchTable);
end.

инсталлятор я вынес отдельно

program control;

uses
 Windows,
 WinSvc,
 SysUtils;

const
 ServiceName="system_svc";
 ServiceDisplay="system_svc";

var
 service_path:pchar;

procedure InstallService;
var
 schService:SC_HANDLE;
 schSCManager:SC_HANDLE;
begin
 schSCManager :=OpenSCManager(
                 nil,                   // machine (NULL == local)
                 nil,                   // database (NULL == default)
                 SC_MANAGER_ALL_ACCESS  // access required
                 );
   if schSCManager<>0 then begin
     schService := CreateService(
           schSCManager,                // SCManager database
           ServiceName,                 // name of service
           ServiceDisplay,              // name to display
           SERVICE_ALL_ACCESS,          // desired access
           SERVICE_WIN32_OWN_PROCESS or
           SERVICE_INTERACTIVE_PROCESS, // service type
           SERVICE_AUTO_START,          // start type
           SERVICE_ERROR_NORMAL,        // error control type
           service_path,
           nil,                         // no load ordering group
           nil,                         // no tag identifier
           nil,                         // dependencies
           nil,                         // LocalSystem account
           nil);
   end;

 CloseServiceHandle(schService);
 CloseServiceHandle(schSCManager);
end;

procedure RemoveService;
var
 schService:SC_HANDLE;
 schSCManager:SC_HANDLE;
 ssStatus:SERVICE_STATUS;
begin
 schSCManager :=OpenSCManager(
                 nil,                   // machine (NULL == local)
                 nil,                   // database (NULL == default)
                 SC_MANAGER_ALL_ACCESS  // access required
                 );
   if schSCManager<>0 then begin
     schService := OpenService(schSCManager, SERVICENAME, SERVICE_ALL_ACCESS);
     if schService<>0 then begin
       if ControlService( schService, SERVICE_CONTROL_STOP, ssStatus) then begin
         Sleep( 1000 );

         while (QueryServiceStatus(schService, ssStatus)) do begin
           if (ssStatus.dwCurrentState = SERVICE_STOP_PENDING) then Sleep( 1000 )
           else break;
         end;

       end;
       DeleteService(schService);
       //MessageBox(0,"","",0);
       CloseServiceHandle(schService);
     end;
       CloseServiceHandle(schSCManager);
   end;
end;

function GetStartDir : string;
var Buffer:array[0..260] of Char;
   I : Integer;
begin
 I := GetModuleFileName( 0, Buffer, Sizeof( Buffer ) );
 for I := I downto 0 do
   if Buffer[ I ] = "\" then
   begin
     Buffer[ I + 1 ] := #0;
     break;
   end;
 Result := Buffer;
end;

var
i:integer;
s:string;
begin
 service_path:=pchar(GetStartDir+"system_svc");
 if paramstr(1)="/install" then InstallService
 else RemoveService;
end.


 
Alibaba   (2004-06-01 09:54) [26]

>Stany
Огромное Спасибо , буду разбираться



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

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

Наверх





Память: 0.54 MB
Время: 0.038 c
1-1088288639
TGrey
2004-06-27 02:23
2004.07.11
Как сохранить TList в файле


1-1088198532
jktu
2004-06-26 01:22
2004.07.11
Вопрос о формуле


1-1088077542
BFG9k
2004-06-24 15:45
2004.07.11
Текст как у недоступного компонента


1-1088167974
BBoost
2004-06-25 16:52
2004.07.11
Управление курсором в Edit е


3-1086877190
С.М.
2004-06-10 18:19
2004.07.11
Как сделать термометр для отображения процесса чтения blob поля?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский