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