...Eingeloggte User über das Netzwerk ermitteln?

-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 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
            übernommen und für an die VCL angepasst.Diese unit enthält 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.

printed from
www.swissdelphicenter.ch
developers knowledge base