Проверить, имеем ли мы в системе права администратораDelphi , ОС и Железо , КомпьютерПроверить, имеем ли мы в системе права администратора
Оформил: DeeCo const SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5)); SECURITY_BUILTIN_DOMAIN_RID = $00000020; DOMAIN_ALIAS_RID_ADMINS = $00000220; function IsAdmin: Boolean; var hAccessToken: THandle; ptgGroups: PTokenGroups; dwInfoBufferSize: DWORD; psidAdministrators: PSID; x: Integer; bSuccess: BOOL; begin Result := False; bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken); if not bSuccess then begin if GetLastError = ERROR_NO_TOKEN then bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken); end; if bSuccess then begin GetMem(ptgGroups, 1024); bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize); CloseHandle(hAccessToken); if bSuccess then begin AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators); {$R-} for x := 0 to ptgGroups.GroupCount - 1 do if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then begin Result := True; Break; end; {$R+} FreeSid(psidAdministrators); end; FreeMem(ptgGroups); end; end; procedure TForm1.Button1Click(Sender: TObject); begin if isAdmin then ShowMessage('Logged in as Administrator'); end; Here's the translation of the text into Russian: Код написан на Delphi и проверяет, имеет ли текущий пользователь административные права на системе Windows. Вот разбивка функции
Процедура Некоторые предложения по улучшению:
Вот пример, как улучшенный код может выглядеть:
Обратите внимание, что это только пример и может не работать в производственной среде. Код должен быть тщательно протестирован перед использованием в производственной среде. В статье описывается функция на языке Delphi, которая проверяет, является ли текущий пользователь администратором в системе. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |