whats new ¦  programming tips ¦  indy articles ¦  intraweb articles ¦  informations ¦  links ¦  interviews
 misc ¦  tutorials ¦  Add&Win Game

Tips (1547)

Database (90)
Files (137)
Forms (107)
Graphic (115)
IDE (21)
Indy (5)
Internet / LAN (131)
IntraWeb (0)
Math (76)
Misc (127)
Multimedia (45)
Objects/
ActiveX (51)

OpenTools API (3)
Printing (35)
Strings (83)
System (268)
VCL (243)

Top15

Tips sort by
component


Search Tip

Add new Tip

Add&Win Game

Advertising

40 Visitors Online


 
...Enumerate the logged in users on a Remote or Local NT Workstation?
Autor: Manfred Ruzicka
Homepage: http://mitglied.lycos.de/ruzicka
[ Print tip ]  

Tip Rating (31):  
     


-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 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 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,
    nilnilnil, @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.

 

Rate this tip:

poor
very good


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners