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

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.

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

Взято с http://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.
Взято с сайта: http://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;
Взято с сайта: http://www.swissdelphicenter.ch

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...