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