Esta publicação é um complemento ao post anterior, Executando aplicações dentro de um Terminal Service. O objetivo desse post é mostrar como podemos obter o IP de uma máquina conectada e executando uma aplicação dentro de um Terminal Service.

A função desenvolvida utiliza a JEDI Windows API, que você pode obter aqui.

unit WTSControl;

interface

uses
  Classes,
  JwaWinsock2,
  JwaWinType,
  JwaWtsApi32,
  SysUtils;

type
  TWTSSession = record
    ClientIP: string;
    Session: Integer;
  end;

  TWTSSessionArray = array of TWTSSession;
  PWtsSessionInfoAArray = ^TWtsSessionInfoAArray;
  TWtsSessionInfoAArray = array [0 .. ANYSIZE_ARRAY - 1] of WTS_SESSION_INFOA;

function GetClientIP(const Server: string): TWTSSessionArray;

implementation

function GetClientIP(const Server: string): TWTSSessionArray;
var
  ASession: PWtsSessionInfoAArray;
  FBytes: Cardinal;
  FClientAdd: PWtsClientAddress;
  FHandle: THandle;
  FIP: string;
  I: Cardinal;
  X: Integer;
begin
  if Trim(Server) = '' then
    FHandle := WTS_CURRENT_SERVER
  else
    FHandle := WTSOpenServer(PChar(Server));

  if WTSEnumerateSessions(FHandle, 0, 1, PWTS_SESSION_INFO(ASession), I) then
  begin
    SetLength(Result, I);

    for X := 0 to I - 1 do
    begin
      WTSQuerySessionInformation(FHandle, ASession^[X].SessionId,
        WTSClientAddress, Pointer(FClientAdd), FBytes);

      case FClientAdd^.AddressFamily of
        AF_INET:
          begin
            FIP := Format('%d.%d.%d.%d', [FClientAdd^.Address[2],
              FClientAdd^.Address[3], FClientAdd^.Address[4],
              FClientAdd^.Address[5]]);
          end;
        AF_INET6:
          begin
            FIP := 'IPv6 address not yet supported';
          end;
        AF_IPX:
          begin
            FIP := 'IPX is not supported';
          end;
        AF_NETBIOS:
          begin
            FIP := 'NETBIOS is not supported';
          end;
        AF_UNSPEC:
          begin
            FIP := 'Console and listener session have no address';
          end;
      end;
      Result[X].ClientIP := FIP;
      Result[X].Session := ASession^[X].SessionId;
      WTSFreeMemory(FClientAdd);
    end;
  end;
end;

end.

Criei o record TWTSSession para retornar um array, definido como TWTSSessionArray, de todas as sessões existentes no servidor Terminal Service. Segue abaixo um exemplo de utilização:

procedure Executar;
var
  AWTS: TWTSSessionArray;
  FCount: Integer;
begin
  AWTS := GetClientIP('');
  for FCount := Low(AWTS) to High(AWTS) do
  begin
    ShowMessage('Session: ' + FormatFloat('00000', AWTS[FCount].Session) +
      ' IP: ' + AWTS[FCount].ClientIP);
  end;
end;

O download do código-fonte pode ser feito aqui.