Перечислить зарегистрированных пользователей для удаленной или локальной NT системы

{-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -   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

.

Другое по теме:

• Определение системной информации
• Как передать при создании нити (Tthread) ей некоторое значение
• Частичная блокировка и разблокировка функций клавиатуры и мышки