Einzelnen Beitrag anzeigen

FlorianK

Registriert seit: 18. Apr 2004
Ort: [BUFFEROVERFLOW]
39 Beiträge
 
Delphi 7 Personal
 
#17

Re: NET SEND für Windows 98? REPLACEMENT

  Alt 20. Apr 2004, 20:40
Hallo,
irgendwo habe ich mal den Code fürs herausfinden von Usern übers Netzwerk gefunden, ich weiß nicht ob er funktioniert:
Delphi-Quellcode:
unit NetworkUser;

interface

uses Windows;

type
   ATStrings = array of string;
   function GetUser(const ServerName: string): string;

implementation

function GetUser(const ServerName: string): string;
const MAX_NAME_STRING = 1024;
var userName,
  domainName: array [0..MAX_NAME_STRING] of Char;
  subKeyName: array [0..MAX_PATH] of Char;
  ArryList: 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(ArryList, 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(ArryList, length(ArryList) + 1);
            ArryList[length(ArryList) - 1] := string(domainName) + '\' + string(userName);
            result := string(userName);
          end;
        end;
        if Assigned(sid) then FreeSid(sid);
      end;
    end;
    subKeyNameSize := SizeOf(subKeyName);
    Inc(index);
  end;
  RegCloseKey(usersKey);
end;

end.
Vielleicht kann jemand der ein Netzwerk besitzt diesen Code testen?

Danke schon im voraus

Florian K.
Florian K.
Errare humanum est. - Irre sind auch nur Menschen.
  Mit Zitat antworten Zitat