İyi günler.
Şöyle bir örneği delphi derleyicisinin unicode desteğine göre düzenleyince (aşağıdaki şekilde) sanırım çalışıyor.
unit UTWSInfo;
interface
uses
SysUtils, Classes, Windows;
type
TWorkStationInfo = class
private
class function GetTSClientName: string;
public
class function GetWorkstationID: string;
class function IsTSRemoteSession: Boolean;
end;
implementation
type
_WTS_INFO_CLASS = (
WTSInitialProgram,
WTSApplicationName,
WTSWorkingDirectory,
WTSOEMId,
WTSSessionId,
WTSUserName,
WTSWinStationName,
WTSDomainName,
WTSConnectState,
WTSClientBuildNumber,
WTSClientName,
WTSClientDirectory,
WTSClientProductId,
WTSClientHardwareId,
WTSClientAddress,
WTSClientDisplay,
WTSClientProtocolType);
{$EXTERNALSYM _WTS_INFO_CLASS}
WTS_INFO_CLASS = _WTS_INFO_CLASS;
TWtsInfoClass = WTS_INFO_CLASS;
TWTSQuerySessionInformationFunction = function(hServer: THandle;
SessionId: DWORD;
WTSInofClass: Byte; var ppBuffer: PChar; var pBytesReturned:
DWORD): BOOL; stdcall;
TWTSFreeMemoryProcedure = procedure(pMemory: Pointer); stdcall;
const
SM_REMOTESESSION = $1000;
var
sWorkStationID: string;
{ TWorkStationInfo }
class function TWorkStationInfo.GetTSClientName: string;
var
LibHandle: HMODULE;
WTSQuerySessionInformation: TWTSQuerySessionInformationFunction;
WTSFreeMemory: TWTSFreeMemoryProcedure;
ClientName: PChar;
cByteseturned: Cardinal;
begin
Result := '';
LibHandle := LoadLibrary('wtsapi32.dll');
if LibHandle <> 0 then
begin
try
{$IFDEF UNICODE}
@WTSQuerySessionInformation := GetProcAddress(LibHandle, 'WTSQuerySessionInformationW');
{$ELSE}
@WTSQuerySessionInformation := GetProcAddress(LibHandle, 'WTSQuerySessionInformationA');
{$ENDIF}
@WTSFreeMemory := GetProcAddress(LibHandle, 'WTSFreeMemory');
WTSQuerySessionInformation(0, DWORD(-1), Ord(WTSClientName), ClientName, cByteseturned);
try
Result := ClientName;
finally
WTSFreeMemory(Pointer(ClientName));
end;
finally
FreeLibrary(LibHandle);
end;
end;
end;
class function TWorkStationInfo.GetWorkstationID: string;
var
szComputerName: packed array[0..MAX_COMPUTERNAME_LENGTH] of Char;
iSize: Cardinal;
begin
if sWorkStationID = '' then
begin
if IsTSRemoteSession then
begin
// we are a terminal services client so get the client
// workstation name
sWorkStationID := UpperCase(GetTSClientName);
end
else
begin
iSize := MAX_COMPUTERNAME_LENGTH + 1;
GetComputerName(szComputerName, iSize);
sWorkStationID := UpperCase(szComputerName);
end;
end;
Result := sWorkStationID;
end;
class function TWorkStationInfo.IsTSRemoteSession: Boolean;
begin
// are we running as a TS client?
Result := GetSystemMetrics(SM_REMOTESESSION) <> 0;
end;
end.Bunu da aşaüıdaki kodla test ettiğimde aradığınız cevap açısından bir problem çıkmadı.
if TWorkStationInfo.IsTSRemoteSession then ShowMessage('Uzak masa üstü bağlantısı yapan bilgisayar adı..:'+TWorkStationInfo.GetWorkstationID)
else ShowMessage('Bağlantı yapılmayan oturumun açıldığı bilgisayar adı..:'+TWorkStationInfo.GetWorkstationID);
