Bueno, samupe, te dejo esta unidad a ver si con esto tienes suficiente para lo tuyo.
Tienes 3 funciones:
- una te dice si existe o no sesión de TS en el ordenadorr,
- las otras 2, en caso de que exista sesión, la IP y nombre de ordenador.
Suerte!!
Código Delphi
[-]
unit WTSManager;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
WM_WTSSESSION_CHANGE = $2B1;
WTS_CONSOLE_CONNECT = 1;
WTS_CONSOLE_DISCONNECT = 2;
WTS_REMOTE_CONNECT = 3;
WTS_REMOTE_DISCONNECT = 4;
WTS_SESSION_LOGON = 5;
WTS_SESSION_LOGOFF = 6;
WTS_SESSION_LOCK = 7;
WTS_SESSION_UNLOCK = 8;
WTS_SESSION_REMOTE_CONTROL = 9;
WTS_CURRENT_SERVER_HANDLE = THandle(0);
{$EXTERNALSYM WTS_CURRENT_SERVER_HANDLE}
WTS_CURRENT_SESSION = DWORD(-1);
{$EXTERNALSYM WTS_CURRENT_SESSION}
NOTIFY_FOR_THIS_SESSION = 0;
NOTIFY_FOR_ALL_SESSIONS = 1;
SM_REMOTESESSION = $1000;
type
TWTSConnectStateClass = (WTSActive, WTSConnected, WTSConnectQuery,
WTSShadow, WTSDisconnected, WTSIdle, WTSListen, WTSReset, WTSDown,
WTSInit);
TWTSInfoClass = (WTSInitialProgram, WTSApplicationName, WTSWorkingDirectory,
WTSOEMId, WTSSessionId, WTSUserName, WTSWinStationName, WTSDomainName,
WTSConnectState, WTSClientBuildNumber, WTSClientName, WTSClientDirectory,
WTSClientProductId, WTSClientHardwareId, WTSClientAddress, WTSClientDisplay,
WTSClientProtocolType);
TWTSSessionInfoW = packed record
SessionID: DWord;
pWinStationName: PWideChar;
State: TWTSConnectStateClass;
end;
PWTSSessionInfoW = ^TWTSSessionInfoW;
TWTS_CLIENT_ADDRESS = record
AddressFamily: DWORD; Address: array [0..19] of BYTE; end;
PWTS_CLIENT_ADDRESS = ^TWTS_CLIENT_ADDRESS;
TWTSEnumerateSessionsW = function (hServer: THandle; Reserved, Version: DWord;
out ppSessionInfo: PWTSSessionInfoW; out pCount: DWord): Bool; stdcall;
{$EXTERNALSYM TWTSEnumerateSessionsW}
TWTSQuerySessionInformation = function (hServer: THandle; SessionId: DWord;
WTS_INFO_CLASS: TWTSInfoClass; var ppBuffer: Pointer; var pBytesReturned: DWord): Bool; stdcall;
{$EXTERNALSYM TWTSQuerySessionInformation}
TWTSFreeMemory = procedure (PMemory: pointer); stdcall;
{$EXTERNALSYM TWTSFreeMemory}
function WTSInSession: boolean;
function WTSComputerIP: string;
function WTSComputerName: string;
var
hWTSapi32dll: THandle;
WTSEnumerateSessions: TWTSEnumerateSessionsW;
WTSQuerySessionInformation: TWTSQuerySessionInformation;
WTSFreeMemory: TWTSFreeMemory;
implementation
var
FWTSApiDispo: boolean;
function WTSInSession: boolean;
begin
result := GetSystemMetrics(SM_REMOTESESSION) <> 0;
end;
function WTSComputerIP: string;
var buf: pointer;
nbcar: DWord;
bon: boolean;
begin
result := '';
buf := nil;
if FWTSApiDispo and WTSInSession then
begin
bon := WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientAddress, buf, nbcar);
if bon then
begin
try
with TWTS_CLIENT_ADDRESS(buf^) do
result := IntToStr(Address[2]) + '.' +
IntToStr(Address[3]) + '.' +
IntToStr(Address[4]) + '.' +
IntToStr(Address[5]);
finally
WTSFreeMemory(buf);
end;
end
end
end;
function WTSComputerName: string;
var pbuf: pointer;
nbcar: DWord;
bon: boolean;
begin
result := '';
pbuf := nil;
nbcar := 100;
if FWTSApiDispo and WTSInSession then
begin
bon := WTSQuerySessionInformation(WTS_CURRENT_SERVER_HANDLE, WTS_CURRENT_SESSION, WTSClientName, pbuf, nbcar);
if bon then
begin
try
result := trim(PChar(pbuf));
finally
WTSFreeMemory(pbuf);
end;
end
end
end;
initialization
hWTSAPI32DLL := LoadLibrary('Wtsapi32.dll');
if hWTSAPI32DLL > 0 then
begin
FWTSApiDispo := true;
@WTSEnumerateSessions := GetProcAddress(hWTSAPI32DLL, 'WTSRegisterSessionNotification');
@WTSQuerySessionInformation := GetProcAddress(hWTSAPI32DLL, 'WTSQuerySessionInformationA');
@WTSFreeMemory := GetProcAddress(hWTSAPI32DLL, 'WTSFreeMemory');
end
else
FWTSApiDispo := false;
finalization
if hWTSapi32dll > 0 then
FreeLibrary(hWTSAPI32DLL);
end.