Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Получить список пользователей

01.01.2007

GetLocalUserList - возвращает список пользователей (Windows NT, Windows 2000)

unit Func;
 
interface
 
uses
Sysutils, Classes, Stdctrls, Comctrls, Graphics, Windows;
 
////////////////////////////////////////////////////////////////////////////////
{$EXTERNALSYM NetUserEnum}
function NetUserEnum(servername: LPWSTR;
 
  level
,
  filter
: DWORD;
  bufptr
: Pointer;
  prefmaxlen
: DWORD;
  entriesread
,
  totalentries
,
  resume_handle
: LPDWORD): DWORD; stdcall;
external
'NetApi32.dll' Name 'NetUserEnum';
 
function NetApiBufferFree(Buffer: Pointer {LPVOID}): DWORD; stdcall;
 
external
'NetApi32.dll' Name 'NetApiBufferFree';
////////////////////////////////////////////////////////////////////////////////
 
procedure
GetLocalUserList(ulist: TStringList);
 
implementation
 
//------------------------------------------------------------------------------
// возвращает список пользователей локального хоста
//------------------------------------------------------------------------------
 
procedure
GetLocalUserList(ulist: TStringList);
const
 
  NERR_SUCCESS
= 0;
  FILTER_TEMP_DUPLICATE_ACCOUNT
= $0001;
  FILTER_NORMAL_ACCOUNT
= $0002;
  FILTER_PROXY_ACCOUNT
= $0004;
  FILTER_INTERDOMAIN_TRUST_ACCOUNT
= $0008;
  FILTER_WORKSTATION_TRUST_ACCOUNT
= $0010;
  FILTER_SERVER_TRUST_ACCOUNT
= $0020;
 
type
 
  TUSER_INFO_10
= record
    usri10_name
,
      usri10_comment
,
      usri10_usr_comment
,
      usri10_full_name
: PWideChar;
 
end;
  PUSER_INFO_10
= ^TUSER_INFO_10;
 
var
 
  dwERead
, dwETotal, dwRes, res: DWORD;
  inf
: PUSER_INFO_10;
  info
: Pointer;
  p
: PChar;
  i
: Integer;
begin
 
 
if ulist = nil then
   
Exit;
  ulist
.Clear;
 
  info
:= nil;
  dwRes
:= 0;
  res
:= NetUserEnum(nil,
   
10,
    FILTER_NORMAL_ACCOUNT
,
    @info
,
   
65536,
    @dwERead
,
    @dwETotal
,
    @dwRes
);
 
if (res <> NERR_SUCCESS) or (info = nil) then
   
Exit;
  p
:= PChar(info);
 
for i := 0 to dwERead - 1 do
 
begin
    inf
:= PUSER_INFO_10(p + i * SizeOf(TUSER_INFO_10));
    ulist
.Add(WideCharToString(PWideChar((inf^).usri10_name)));
 
end;
 
 
NetApiBufferFree(info);
end;
 
end.

Автор: Кондратюк Виталий

Взято с https://delphiworld.narod.ru


{-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  unit
Name: GetUser
 
Author: Manfred Ruzicka
 
History:   Diese unit ermittelt den aktuell angemeldeten User einer NT / 2000
             
Worstation / Servers.Sie wurde aus dem Programm "loggedon2" von Assarbad
             ubernommen und fur an
die VCL angepasst.Diese unit enthalt zwar noch
             einige kleine
Fehler, funktioniert aber ohne Probleme.-
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
 
 
 unit
GetUser;
 
 
interface
 
 uses
   
Windows
     
, Messages
     
, SysUtils
     
, Dialogs;
 
 type
   TServerBrowseDialogA0
= function(hwnd: HWND; pchBuffer: Pointer;
     cchBufSize
: DWORD): bool;
   stdcall
;
   
ATStrings = array of string;
 
 
 procedure
Server(const ServerName: string);
 
function ShowServerDialog(AHandle: THandle): string;
 
 
 implementation
 
 uses
Client, ClientSkin;
 
 procedure
Server(const ServerName: string);
 
const
   MAX_NAME_STRING
= 1024;
 
var
    userName
, domainName: array[0..MAX_NAME_STRING] of Char;
   subKeyName
: array[0..MAX_PATH] of Char;
   NIL_HANDLE
: Integer absolute 0;
   
Result: ATStrings;
   subKeyNameSize
: DWORD;
   
Index: DWORD;
   userNameSize
: DWORD;
   domainNameSize
: DWORD;
   lastWriteTime
: FILETIME;
   usersKey
: HKEY;
   sid
: PSID;
   sidType
: SID_NAME_USE;
   authority
: SID_IDENTIFIER_AUTHORITY;
   subAuthorityCount
: BYTE;
   authorityVal
: DWORD;
   revision
: DWORD;
   subAuthorityVal
: array[0..7] of DWORD;
 
 
   
function getvals(s: string): Integer;
   
var
      i
, j, k, l: integer;
     tmp
: string;
   
begin
     
Delete(s, 1, 2);
     j  
:= Pos('-', s);
     tmp
:= Copy(s, 1, j - 1);
     val
(tmp, revision, k);
     
Delete(s, 1, j);
     j
:= Pos('-', s);
     tmp
:= Copy(s, 1, j - 1);
     val
('$' + tmp, authorityVal, k);
     
Delete(s, 1, j);
     i
:= 2;
     s
:= s + '-';
     
for l := 0 to 7 do
     
begin
       j
:= Pos('-', s);
       
if j > 0 then
       
begin
         tmp
:= Copy(s, 1, j - 1);
         val
(tmp, subAuthorityVal[l], k);
         
Delete(s, 1, j);
         
Inc(i);
       
end
       
else
         
break;
     
end;
     
Result := i;
   
end;
 
begin
   setlength
(Result, 0);
   revision    
:= 0;
   authorityVal
:= 0;
   
FillChar(subAuthorityVal, SizeOf(subAuthorityVal), #0);
   
FillChar(userName, SizeOf(userName), #0);
   
FillChar(domainName, SizeOf(domainName), #0);
   
FillChar(subKeyName, SizeOf(subKeyName), #0);
   
if ServerName <> '' then
   
begin
     usersKey
:= 0;
     
if (RegConnectRegistry(PChar(ServerName), HKEY_USERS, usersKey) <> 0) then
       
Exit;
   
end
   
else
   
begin
     
if (RegOpenKey(HKEY_USERS, nil, usersKey) <> ERROR_SUCCESS) then
       
Exit;
   
end;
   
Index          := 0;
   subKeyNameSize
:= SizeOf(subKeyName);
   
while (RegEnumKeyEx(usersKey, Index, subKeyName, subKeyNameSize,
     
nil, nil, nil, @lastWriteTime) = ERROR_SUCCESS) do
   
begin
     
if (lstrcmpi(subKeyName, '.default') <> 0) and (Pos('Classes', string(subKeyName)) = 0) then
     
begin
       subAuthorityCount
:= getvals(subKeyName);
       
if (subAuthorityCount >= 3) then
       
begin
         subAuthorityCount
:= subAuthorityCount - 2;
         
if (subAuthorityCount < 2) then subAuthorityCount := 2;
         authority
.Value[5] := PByte(@authorityVal)^;
         authority
.Value[4] := PByte(DWORD(@authorityVal) + 1)^;
         authority
.Value[3] := PByte(DWORD(@authorityVal) + 2)^;
         authority
.Value[2] := PByte(DWORD(@authorityVal) + 3)^;
         authority
.Value[1] := 0;
         authority
.Value[0] := 0;
         sid
:= nil;
         userNameSize
:= MAX_NAME_STRING;
         domainNameSize
:= MAX_NAME_STRING;
         
if AllocateAndInitializeSid(authority, subAuthorityCount,
           subAuthorityVal
[0], subAuthorityVal[1], subAuthorityVal[2],
           subAuthorityVal
[3], subAuthorityVal[4], subAuthorityVal[5],
           subAuthorityVal
[6], subAuthorityVal[7], sid) then
         
begin
           
if LookupAccountSid(PChar(ServerName), sid, userName, userNameSize,
             domainName
, domainNameSize, sidType) then
           
begin
             setlength
(Result, Length(Result) + 1);
             
Result[Length(Result) - 1] := string(domainName) + '\' + string(userName);
 
             // Hier kann das Ziel eingetragen werden
            Form1.label2.Caption := string(userName);
             form2.label1.Caption := string(userName);
           end;
         end;
         if Assigned(sid) then FreeSid(sid);
       end;
     end;
     subKeyNameSize := SizeOf(subKeyName);
     Inc(Index);
   end;
   RegCloseKey(usersKey);
 end;
 
 function ShowServerDialog(AHandle: THandle): string;
 var
   ServerBrowseDialogA0: TServerBrowseDialogA0;
   LANMAN_DLL: DWORD;
   buffer: array[0..1024] of char;
   bLoadLib: Boolean;
 begin
   bLoadLib := False;
   LANMAN_DLL := GetModuleHandle('
NTLANMAN.DLL');
   if LANMAN_DLL = 0 then
   begin
     LANMAN_DLL := LoadLibrary('
NTLANMAN.DLL');
     bLoadLib := True;
   end;
   if LANMAN_DLL <> 0 then
   begin @ServerBrowseDialogA0 := GetProcAddress(LANMAN_DLL, '
ServerBrowseDialogA0');
     DialogBox(HInstance, MAKEINTRESOURCE(101), AHandle, nil);
     ServerBrowseDialogA0(AHandle, @buffer, 1024);
     if buffer[0] = '
\' then
     begin
       Result := buffer;
     end;
     if bLoadLib = True then
       FreeLibrary(LANMAN_DLL);
   end;
 end;
 
 
 end.

Взято с сайта: https://www.swissdelphicenter.ch


// The NetUserEnum function provides information about all user accounts on a server. 
 
type
   USER_INFO_1
= record
     usri1_name
: LPWSTR;
     usri1_password
: LPWSTR;
     usri1_password_age
: DWORD;
     usri1_priv
: DWORD;
     usri1_home_dir
: LPWSTR;
     usri1_comment
: LPWSTR;
     usri1_flags
: DWORD;
     usri1_script_path
: LPWSTR;
   
end;
   lpUSER_INFO_1
= ^USER_INFO_1;
 
 
function NetUserEnum(ServerName: PWideChar;
   
Level,
   
Filter: DWORD;
   
var Buffer: Pointer;
   
PrefMaxLen: DWORD;
   
var EntriesRead,
   
TotalEntries,
   
ResumeHandle: DWORD): Longword; stdcall; external 'netapi32.dll';
 
 
function NetApiBufferFree(pBuffer: PByte): Longint; stdcall; external
 
'netapi32.dll';
 
 
{...}
 
 procedure TForm1
.Button1Click(Sender: TObject);
 
var
   
EntiesRead: DWORD;
   
TotalEntries: DWORD;
   
UserInfo: lpUSER_INFO_1;
   lpBuffer
: Pointer;
   
ResumeHandle: DWORD;
   
Counter: Integer;
   
NetApiStatus: LongWord;
 
begin
   
ResumeHandle := 0;
   repeat
     
// NetApiStatus :=
   
// NetUserEnum(PChar('\\NT-Domain'), 1, 0, lpBuffer, 0,EntiesRead, TotalEntries, ResumeHandle);
   
NetApiStatus := NetUserEnum(nil, 1, 0, lpBuffer, 0, EntiesRead,
       
TotalEntries, ResumeHandle);
     
UserInfo     := lpBuffer;
 
     
for Counter := 0 to EntiesRead - 1 do
     
begin
       listbox1
.Items.Add(WideCharToString(UserInfo^.usri1_name) + ' --> ' +
         
WideCharToString(UserInfo^.usri1_comment));
       
Inc(UserInfo);
     
end;
 
     
NetApiBufferFree(lpBuffer);
   
until (NetApiStatus <> ERROR_MORE_DATA);
 
end;

Взято с сайта: https://www.swissdelphicenter.ch