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

Вниз

Как сервисному приложению отловить вход пользователя в систему.   Найти похожие ветки 

 
Antoha ©   (2005-09-24 12:40) [0]

Предположим есть работающий сервис. Как известно сервисы запускаются до входа пользователя в систему. Хотелось бы узнать как сервису получить событие входа/выхода пользователя в ОС. Необходим вариант отлова данного события по Windows XP/2000/2003. Всем зарание спасибо за помошь.


 
Набережных С. ©   (2005-09-24 15:07) [1]

Go to MSDN: winlogon notification package


 
Antoha ©   (2005-09-26 13:52) [2]

Помогло. Огромное пасибо. Тока вот непонятно как на delphi написать winlogon notification package. Потому как Delphi при создании библиотеки использует DLLMain а сервис winlogon хочет LibMain. Как быть ?Ж(


 
Набережных С. ©   (2005-09-26 19:20) [3]

Не понял, при чем тут DllMain? По-моему, в MSDN очень ясно написано. Тебе нужно просто экспортировать несколько функций с требуемой сигнатурой, и их имена указать соответствующих переменных своего ключа в реестре в качестве обработчиков соответствующих событий.

Вот пример размещаемой в либе функции, производящей регистрацию этой библиотеки:

function RegisterHandler(Reg: bool; pRegName: PAnsiChar): HResult; stdcall;
const
 sKey = "Software\Microsoft\Windows NT\CurrentVersion\Winlogon\Notify";
 sLogonFunc = "SNLogonOn";
 sLogoffFunc = "SNLogonOff";
 sDllName = "DllName";
 sAsync   = "Asynchronous";
 sLogon   = "Logon";
 sLogoff  = "Logoff";
 sImpers  = "Impersonate";
var
 Key, MyKey, SubKey: HKEY;
 n: integer;
 sName: string;
Label
 Final;
begin
 MyKey:=0; SubKey:=0;

 Result:=RegOpenKey(HKEY_LOCAL_MACHINE, PChar(sKey), Key);
 if Result <> ERROR_SUCCESS then Exit;

 try
   sName:=ExtractFileName(GetModuleName(HInstance));
   if Reg then
   begin
     Result:=RegOpenKey(Key, pRegName, SubKey);
     if Result = ERROR_SUCCESS then
     begin
       Result:=ERROR_ALREADY_EXISTS;
       GoTo Final;
     end;

     Result:=RegCreateKey(Key, pRegName, MyKey);
     if Result <> ERROR_SUCCESS then Goto Final;

     n:=1;
     Result:=RegSetValueEx(MyKey, PChar(sAsync), 0, REG_DWORD, @n, SizeOf(n));
     if Result <> ERROR_SUCCESS then Goto Final;

     n:=0;
     Result:=RegSetValueEx(MyKey, PChar(sImpers), 0, REG_DWORD, @n, SizeOf(n));
     if Result <> ERROR_SUCCESS then Goto Final;

     Result:=RegSetValueEx(MyKey, PChar(sDllName), 0, REG_EXPAND_SZ,
                                             PChar(sName), Length(sName));
     if Result <> ERROR_SUCCESS then Goto Final;

     Result:=RegSetValueEx(MyKey, PChar(sLogon), 0 , REG_SZ,
                                    PChar(sLogonFunc), Length(sLogonFunc));
     if Result <> ERROR_SUCCESS then Goto Final;

     Result:=RegSetValueEx(MyKey, PChar(sLogoff), 0, REG_SZ,
                                   PChar(sLogoffFunc), Length(sLogoffFunc));
   end
   else
   begin
     Result:=RegDeleteKey(Key, pRegName);
   end;

Final:
 finally
   RegCloseKey(MyKey);
   RegCloseKey(SubKey);
   RegCloseKey(Key);
 end;
end;

Соответственно, имена функций-обработчиков нужно поменять на свои.
А вот такая программа может использовать эту функцию для регистрации библиотеки:

program RegLogonEvntLib;

{$APPTYPE CONSOLE}

uses
 Windows, SysUtils;

type
 TRegisterHandler = function(Reg: bool; pRegName: PAnsiChar): Cardinal; stdcall;

var
 s, RegName, DllName: string;
 LH: THandle;
 F: TRegisterHandler;
 Res: Cardinal;
begin
 if ParamCount < 2 then
 begin
   WriteLn("Example:");
   WriteLn("/REG DllName.dll[ RegistrationName]");
   WriteLn("/UNREG DllName.dll[ RegistrationName]");
   Exit;
 end;

 s:=ParamStr(1);
 DllName:=ParamStr(2);
 if ParamCount < 3 then RegName:=ExtractFileName(ChangeFileExt(DllName, ""))
 else RegName:=ParamStr(3);

 LH:=LoadLibrary(PChar(DllName));
 if LH = 0 then
 begin
   WriteLn(Format("Library "%s" not found", [DllName]));
   Exit;
 end;

 try
   @F:=GetProcAddress(LH, "RegisterHandler");
   if not Assigned(F) then
   begin
     WriteLn(Format("Function "RegisterHandler" not found in library "%s"", [DllName]));
     Exit;
   end;

   if SameText(s, "/REG") then
   begin
     Res:=F(true, PChar(RegName));
     if Res = ERROR_SUCCESS then
     begin
       WriteLn(Format("The library "%s" is successfully registered", [DllName]));
       Exit;
     end;
   end else

   if SameText(s, "/UNREG") then
   begin
     Res:=F(false, PChar(RegName));
     if Res = ERROR_SUCCESS then
     begin
       WriteLn(Format("The library "%s" is successfully unregistered", [DllName]));
       Exit;
     end;
   end else
   
   begin
     WriteLn(Format("Unknown parameter: "%s"", [s]));
     Exit;
   end;

   if Res = ERROR_ALREADY_EXISTS then
     s:=Format("Key named "%s" already exists", [RegName])
   else
     s:=SysErrorMessage(Res);
   CharToOem(PChar(s), PChar(s));  
   WriteLn("Error!");
   WriteLn(s);
 finally
   FreeLibrary(LH);
 end;
end.


 
Polevi ©   (2005-09-27 08:09) [4]

Goto Final это прикольно :)


 
dmitry501 ©   (2005-09-27 09:52) [5]

Polevi ©   (27.09.05 8:09) [4]
http://rsdn.ru/forum/Message.aspx?mid=1250236&only=1
:)


 
GuAV ©   (2005-09-27 18:14) [6]

Polevi ©   (27.09.05 8:09) [4]

Тут видимо дилемма или нехорошая вещь Goto, или нехорошая вещь Exit.



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

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

Наверх





Память: 0.47 MB
Время: 0.011 c
14-1131356879
_Sergey_
2005-11-07 12:47
2005.11.27
Delphi: Лицезия кончилась!


1-1130929570
BobbyDigital
2005-11-02 14:06
2005.11.27
SaveDialog


14-1131274581
SergP
2005-11-06 13:56
2005.11.27
Как в VB можно присвоить значения элементам массива?


1-1130848909
kyn66
2005-11-01 15:41
2005.11.27
Соединение с Интернет.


14-1131301117
ArtemESC
2005-11-06 21:18
2005.11.27
Лучший Хостинг ...





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