Определить SID текущего пользователяDelphi , ОС и Железо , КомпьютерОпределить SID текущего пользователя
Оформил: DeeCo (******************************************************************************) (* SPGetSid - Retrieve the current user''s SID in text format *) (* *) (* Copyright (c) 2004 Shorter Path Software *) (* http://www.shorterpath.com *) (******************************************************************************) { SID is a data structure of variable length that identifies user, group, and computer accounts. Every account on a network is issued a unique SID when the account is first created. Internal processes in Windows refer to an account''s SID rather than the account''s user or group name. } unit SPGetSid; interface uses Windows, SysUtils; function GetCurrentUserSid: string; implementation const HEAP_ZERO_MEMORY = $00000008; SID_REVISION = 1; // Current revision level type PTokenUser = ^TTokenUser; TTokenUser = packed record User: TSidAndAttributes; end; function ConvertSid(Sid: PSID; pszSidText: PChar; var dwBufferLen: DWORD): BOOL; var psia: PSIDIdentifierAuthority; dwSubAuthorities: DWORD; dwSidRev: DWORD; dwCounter: DWORD; dwSidSize: DWORD; begin Result := False; dwSidRev := SID_REVISION; if not IsValidSid(Sid) then Exit; psia := GetSidIdentifierAuthority(Sid); dwSubAuthorities := GetSidSubAuthorityCount(Sid)^; dwSidSize := (15 + 12 + (12 * dwSubAuthorities) + 1) * SizeOf(Char); if (dwBufferLen < dwSidSize) then begin dwBufferLen := dwSidSize; SetLastError(ERROR_INSUFFICIENT_BUFFER); Exit; end; StrFmt(pszSidText, 'S-%u-', [dwSidRev]); if (psia.Value[0] <> 0) or (psia.Value[1] <> 0) then StrFmt(pszSidText + StrLen(pszSidText), '0x%.2x%.2x%.2x%.2x%.2x%.2x', [psia.Value[0], psia.Value[1], psia.Value[2], psia.Value[3], psia.Value[4], psia.Value[5]]) else StrFmt(pszSidText + StrLen(pszSidText), '%u', [DWORD(psia.Value[5]) + DWORD(psia.Value[4] shl 8) + DWORD(psia.Value[3] shl 16) + DWORD(psia.Value[2] shl 24)]); dwSidSize := StrLen(pszSidText); for dwCounter := 0 to dwSubAuthorities - 1 do begin StrFmt(pszSidText + dwSidSize, '-%u', [GetSidSubAuthority(Sid, dwCounter)^]); dwSidSize := StrLen(pszSidText); end; Result := True; end; function ObtainTextSid(hToken: THandle; pszSid: PChar; var dwBufferLen: DWORD): BOOL; var dwReturnLength: DWORD; dwTokenUserLength: DWORD; tic: TTokenInformationClass; ptu: Pointer; begin Result := False; dwReturnLength := 0; dwTokenUserLength := 0; tic := TokenUser; ptu := nil; if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength, dwReturnLength) then begin if GetLastError = ERROR_INSUFFICIENT_BUFFER then begin ptu := HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, dwReturnLength); if ptu = nil then Exit; dwTokenUserLength := dwReturnLength; dwReturnLength := 0; if not GetTokenInformation(hToken, tic, ptu, dwTokenUserLength, dwReturnLength) then Exit; end else Exit; end; if not ConvertSid((PTokenUser(ptu).User).Sid, pszSid, dwBufferLen) then Exit; if not HeapFree(GetProcessHeap, 0, ptu) then Exit; Result := True; end; function GetCurrentUserSid: string; var hAccessToken: THandle; bSuccess: BOOL; dwBufferLen: DWORD; szSid: array[0..260] of Char; begin Result := ''; 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 ZeroMemory(@szSid, SizeOf(szSid)); dwBufferLen := SizeOf(szSid); if ObtainTextSid(hAccessToken, szSid, dwBufferLen) then Result := szSid; CloseHandle(hAccessToken); end; end; end. Это модуль Delphi, который извлекает текущий идентификатор безопасности (SID) в текстовом формате с помощью вызовов Windows API. Модуль
Код использует вызовы Windows API, такие как В целом, этот модуль предоставляет удобный способ извлечь SID текущего пользователя в текстовом формате с помощью Delphi. Определить SID текущего пользователя - это функция, которая позволяет получить уникальный идентификатор (SID) текущего пользователя в текстовом формате. Комментарии и вопросыПолучайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |