Toon posts:

[delphi] Username ophalen

Pagina: 1
Acties:
  • 115 views sinds 30-01-2008
  • Reageer

Verwijderd

Topicstarter
Heren en dames,

In Delphi doe ik het volgende om op een Windows 2000 of hoger bak de complete user op te halen het volgende:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure GetUserNameEx(NameFormat: DWORD;
  lpNameBuffer: LPSTR; nSize: PULONG); stdcall;
  external 'secur32.dll' Name 'GetUserNameExA';
...
    function LoggedOnUserNameEx(fFormat: DWORD): string;
    var
      UserName: array[0..250] of char;
      Size: DWORD;
    begin
      Size := 250;
      GetUserNameEx(fFormat, @UserName, @Size);
      Result := UserName;
    end;


Werkt prima onder 2000 dus.

Nu heb ik echter ook een NT machine, maar die heeft secur32.dll niet. Daar heet 'ie dus anders (waarsch. security.dll).

Hoe kan ik ervoor zorgen dat ik in 1 executable toch voor 2 operating system-versies support kan leveren.

Dus:
code:
1
2
if windowsNT then getWindowsNTAuth();
if windows2000Hoger then getWindows2000Auth()


Iemand enig idee?

  • LordLarry
  • Registratie: Juli 2001
  • Niet online

LordLarry

Aut disce aut discede

Dat kun je doen door met GetVersion(Ex) de windows versie te achterhalen en dan de dll niet statisch te laden zoals je nu doet, maar dynamisch met LoadLibrary en GetProcAddress.

GetUserNameEx bestaat pas vanaf win2k. Onder NT 4 is er gewoonweg geen GetUserNameEx, ook niet in een andere dll. Daar moet je gewoon GetUserName gebruiken. Die functie is onder elke win32 te gebruiken.

We adore chaos because we like to restore order - M.C. Escher


  • Bas_je
  • Registratie: Augustus 2003
  • Laatst online: 03-03-2025
zoiets:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses WinSock;

function GetLocalIPAddress : string;
var wsdata : TWSAData;
    he : PHostEnt;
    ss : pchar;
    ip : TInAddr;
    i  : cardinal;
    co : string;
begin
  i := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(co,i);
  GetComputerName(PChar(co),i);
  WSAStartup(MakeWord(1, 1), wsdata);
  he := gethostbyname(pchar(co));
  if he<>nil then begin
    ip.S_addr := integer(pointer(he^. h_addr_list^)^);
    ss := inet_ntoa(ip);
    Result := string(ss);
  end;
  WSACleanup();
end;

procedure GetLocalName(var sUser,sComputer : string);
var 
  i : cardinal; 
begin
  try
    i:=255;
    { user }
    SetLength(sUser,i); 
    GetUserName(PChar(sUser),i); 
    SetLength(sUser,(i));
    { computer }
    i := 255; 
    SetLength(sComputer,i);
    GetComputerName(PChar(sComputer),i); 
    SetLength(sComputer,(i));
  except
    ShowMessage('Can not get Local Name !');
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var s1,s2: string;
begin
  GetLocalName(s1,s2);
  Edit1.Text := s2; // computer
  Edit2.Text := s1; // user
  Edit3.Text := GetLocalIPAddress; // IP address
end;

end.

while ( !$succeed ) { $try++ }


Verwijderd

Smerige manier: zet je platformafhankelijke code in een DLL, en maak verschillende DLLs afhankelijk van de platformen die je wil ondersteunen. Als je deze DLLs dezelfde naam geeft, kun je nog steeds statisch linken. Bovendien kun je in de DLLs zelf óók statisch linken.

Als je dan uitrolt naar een gegeven systeem laat je de installer (of jijzelf, als je het met de hand doet), bepalen welke DLL geïnstalleerd moet worden.

Maar wat Lord_Larry zegt is waarschijnlijk mooier :)

[ Voor 7% gewijzigd door Verwijderd op 02-09-2004 01:02 ]


Verwijderd

Topicstarter
LordLarry schreef op 01 september 2004 @ 18:49:
Dat kun je doen door met GetVersion(Ex) de windows versie te achterhalen en dan de dll niet statisch te laden zoals je nu doet, maar dynamisch met LoadLibrary en GetProcAddress.

GetUserNameEx bestaat pas vanaf win2k. Onder NT 4 is er gewoonweg geen GetUserNameEx, ook niet in een andere dll. Daar moet je gewoon GetUserName gebruiken. Die functie is onder elke win32 te gebruiken.
Dat laatste zegt de MSDN ook en is me wel bekend. Maar er is een patch om windows NT op Active Directory aan te loggen. Volgens mij bevat die secur32.dll wel?!

  • Dala
  • Registratie: November 2000
  • Laatst online: 18-05 19:00
Voor uit te vinden welke user draait, zelfs als je programma een service is..
Heb ik het volgende stukje code gemaakt.
Delphi:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
{ If you want to know the user which is             }
{ running a program. It's usefull with a service.   }
uses TlHelp32;
{..}
type
   PTOKEN_USER = ^TOKEN_USER;
  _TOKEN_USER = record
    User: TSidAndAttributes;
   end;
   TOKEN_USER = _TOKEN_USER;
{...}
function GetUserAndDomainFromPID(ProcessId: DWORD;
  var User, Domain: string): Boolean;
var
  hToken: THandle;
  cbBuf: Cardinal;
  ptiUser: PTOKEN_USER;
  snu: SID_NAME_USE;
  ProcessHandle: THandle;
  UserSize, DomainSize: DWORD;
  bSuccess: Boolean;
begin
  Result := False;
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
  if ProcessHandle <> 0 then
  begin
  //  EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
    begin
      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
      ptiUser  := nil;
      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
      begin
        ReallocMem(ptiUser, cbBuf);
        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
      end;
      CloseHandle(hToken);
      if not bSuccess then
        Exit;
      UserSize := 0;
      DomainSize := 0;
      LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
      if (UserSize <> 0) and (DomainSize <> 0) then
      begin
        SetLength(User, UserSize);
        SetLength(Domain, DomainSize);
        if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
          PChar(Domain), DomainSize, snu) then
        begin
          Result := True;
          User := StrPas(PChar(User));
          Domain := StrPas(PChar(Domain));
        end;
      end;
      if bSuccess then
        FreeMem(ptiUser);
    end;
    CloseHandle(ProcessHandle);
  end;
end;
{ Get Process ID                                    }
function ProcessID(AppExe: String): Cardinal;
var Snapshot: THandle;
    ProcessEntry: TProcessEntry32;
begin
  Result:=1;
  Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if Snapshot = THandle(-1) then
    Exit;
  ProcessEntry.dwSize:=SizeOf(ProcessEntry);
  if not Process32First(Snapshot, ProcessEntry) then
    Exit;
  Result:=0;
  if ProcessEntry.szExeFile = AppExe then
    Result:=ProcessEntry.th32ProcessID;
  ProcessEntry.dwSize:=SizeOf(ProcessEntry);
  while Process32Next(Snapshot, ProcessEntry) do
  begin
    ProcessEntry.dwSize:=SizeOf(ProcessEntry);
    if ProcessEntry.szExeFile = AppExe then
      Result:=ProcessEntry.th32ProcessID;
  end;
  CloseHandle(Snapshot);
end;
{Usage}
function Username : string;
var
  Domain, User: string;
begin
   if GetUserAndDomainFromPID(ProcessID('explorer.exe'), User, Domain) then
      Result :=  User;
end;


dit heeft bij mij vaak goed gewerkt, dus misschien ook voor jou probleem, de engels comment is wegens het feit dat het stuk ergens staat in mijn Handy Source File :D
Pagina: 1