我进行了大量搜索并发现了一些有用的提示 right here on Stackoverflow获取用户名和计算机名称 - 我什至 found some code Norrit 在 Delphipages 上发布的内容完全符合我的需要 - 除了在 Win64 目标平台下运行它时,获取全名不起作用 - 它返回一个空字符串。运行 Win32 构建时它会返回全名。
GetCurrentUser 和 GetDomainServerName 函数在 Win32 和 Win64 中均有效。
在 Google 上搜索“delphi netusergetinfo”会得到很多 10 多年前的结果 - 甚至在 Delphi 有 Win64 之前。它还提出了一个 Experts-Exchange 答案,该答案链接到一些 lanman 示例代码,该代码在我身上是 404,所以我有点卡在那里。
有谁知道我必须进行哪些更改才能使 GetDomainFullName 在 Win64 下工作 - 或者有人有我可以用来获取当前登录用户的全名的替代代码吗?
下面显示了完整的代码,以防链接失效。
unit NetAPI32;
interface
uses
Windows, SysUtils;
function GetCurrentUser(): String;
function GetDomainServerName(): String;
function GetDomainFullName(ServerName, UserName: String): String;
implementation
function NetUserGetInfo(ServerName, UserName: PWideChar; Level: DWORD; var Buffer: Pointer): DWORD; stdcall; external 'netapi32.dll' name 'NetUserGetInfo';
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall; external 'netapi32.dll' name 'NetApiBufferFree';
function NetWkstaUserGetInfo(ServerName: PWideChar; Level: DWORD; var Buffer: Pointer): Longint; stdcall; external 'netapi32.dll' name 'NetWkstaUserGetInfo';
type
TUserInfo1 = packed record
UserName: PWideChar;
DomainName : PWideChar;
OtherDomainNames: PWideChar;
ServerName: PWideChar;
end;
PUserInfo1 = ^TUserInfo1;
TUserInfo2 = packed record
Name: PWideChar;
Password: PWideChar;
PasswordAge: DWORD;
Priv: DWORD;
HomeDir: PWideChar;
Comment: PWideChar;
Flags: DWORD;
ScriptPath: PWideChar;
AuthorFlags: DWORD;
FullName: PWideChar;
UserComment: PWideChar;
Params: PWideChar;
WorkStations: PWideChar;
LastLogon: DWORD;
LastLogoff: DWORD;
AccountExpires: DWORD;
MaxStorage: DWORD;
UnitsPerWeek: DWORD;
LogonHours: DWORD;
BadPasswordCount: DWORD;
LogonCount: DWORD;
Server: PWideChar;
CountryCode: DWORD;
Codepage: DWORD;
end;
PUserInfo2 = ^TUserInfo2;
function GetCurrentUser(): String;
var
username: String;
size: DWORD;
begin
size := 255;
SetLength(username, size) ;
if GetUserName(PChar(username), size) then
Result := Copy(username, 1, size - 1)
else
Result := '';
end;
function GetDomainServerName(): String;
var
PUI1: PUserInfo1;
begin
Result := '';
if NetWkstaUserGetInfo(nil, 1, Pointer(PUI1)) = 0 then
begin
try
Result := WideCharToString(PUI1^.ServerName);
finally
NetApiBufferFree(PUI1);
end;
end;
end;
function GetDomainFullName(ServerName, UserName: String): String;
var
PUI2: PUserInfo2;
begin
Result := '';
if NetUserGetInfo(PWideChar(WideString(ServerName)), PWideChar(WideString(UserName)), 2, Pointer(PUI2)) = 0 then
try
Result := WideString(PUI2^.FullName);
finally
NetApiBufferFree(PUI2);
end;
end;
end.
使用示例:
ShowMessage(GetDomainFullName(GetDomainServerName(), GetCurrentUser()));
在 Windows 2012 R2 上运行的 Delphi XE6
最佳答案
使用packed
是错误的,而且一直都是错误的。你刚刚逃脱了它,因为碰巧 32 位上的布局与对齐的包装相同。
从结构声明中删除 packed
修饰符,您的代码将正常工作。
由于您已迁移到 Unicode Delphi,现在可以停止使用 WideString
。
function GetDomainFullName(const ServerName, UserName: string): string;
var
PUI2: PUserInfo2;
begin
if NetUserGetInfo(PChar(ServerName), PChar(UserName), 2, Pointer(PUI2)) = 0 then
try
Result := PUI2^.FullName;
finally
NetApiBufferFree(PUI2);
end
else
Result := '';
end;
关于delphi - Delphi Win64中如何获取当前用户的全名,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/25653004/