IP's en Terminal Service

[samupe]

Hola rcuevas:

Yo estoy intentando hacer algo parecido, el servidor al detectar una conexión de TS debería leer la IP del equipo cliente pero no tengo ni idea de como meterle mano.

Gracias,

[rcuevas]

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
  // The WM_WTSSESSION_CHANGE message notifies applications of changes in session state.
  WM_WTSSESSION_CHANGE = $2B1;

  // wParam values:
  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}
 
  // Only session notifications involving the session attached to by the window
  // identified by the hWnd parameter value are to be received.
  NOTIFY_FOR_THIS_SESSION = 0;
  // All session notifications are to be received.
  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;           // AF_INET, AF_IPX, AF_NETBIOS, AF_UNSPEC
    Address: array [0..19] of BYTE; // indirizzo IP del client
  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.

[samupe]

Gracias rcuevas, me ha venido como anillo al dedo. Ahora con un poquito de tiempo podré implementarlo...