Содержание материала

Этот блок определяет имя текущего Пользователя NT / 2000 Рабочей Станции / Сервера. Он взят из программы "loggedon2" Assarbad

и настроен для VCL. Этот блок содержит хотя еще некоторые небольшие ошибки, но работает без проблем.

 

Code:

{-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

unit Name: GetUser Author: Manfred Ruzicka

 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}

 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.

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить