Delphi World - Перечислить зарегистрированных пользователей для удаленной или локальной NT системы
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Перечислить зарегистрированных пользователей для удаленной или локальной NT системы

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch


{-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  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.
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования