Conexiones TCP abiertas en una computadora

[elrayo76]

Buenas,


Espero que me puedan ayudar. Tengo una función realizada en Delphi 11 con Windows 10. El problema es que me da error de "Range Check Error". Les pongo la función:

Código Delphi [-]
const
  {$REGION 'Constantes'}

  ANY_SIZE = 1;
  TCP_TABLE_OWNER_PID_ALL = 5;
  MIB_TCP_STATE: array[1..12] of string =
    (
     'CLOSED', 'LISTEN', 'SYN-SENT ', 'SYN-RECEIVED', 'ESTABLISHED', 'FIN-WAIT-1', 'FIN-WAIT-2',  'CLOSE-WAIT', 
     'CLOSING', 'LAST-ACK', 'TIME-WAIT', 'delete TCB'
    );

type
  TCP_TABLE_CLASS = Integer;

  PMIB_TCPROW_OWNER_PID = ^MIB_TCPROW_OWNER_PID;
  MIB_TCPROW_OWNER_PID = packed record
    dwState: DWORD;
    dwLocalAddr: DWORD;
    dwLocalPort: DWORD;
    dwRemoteAddr: DWORD;
    dwRemotePort: DWORD;
    dwOwningPid: DWORD;
  end;

  PMIB_TCPTABLE_OWNER_PID = ^MIB_TCPTABLE_OWNER_PID;
  MIB_TCPTABLE_OWNER_PID = packed record
    dwNumEntries: DWORD;
    table: array[0..ANY_SIZE - 1] of MIB_TCPROW_OWNER_PID;
  end;

var
  // API de Windows.
  GetExtendedTcpTable: function(pTcpTable: Pointer; pdwSize: PDWORD; bOrder: BOOL; ulAf: ULONG; TableClass: TCP_TABLE_CLASS; Reserved: ULONG): DWORD; stdcall;

procedure TfrmMain.LoadTCPConnections;
const
  CNT_EXTERNAL_IP = 'http://dynupdate.no-ip.com/ip.php';

var
  recIpAddress: in_addr;
  objSnapshot: THandle;
  recTcpTable: PMIB_TCPTABLE_OWNER_PID;
  objListItem: TListItem;
  blnIsLocal: Boolean;
  dwdResult: DWORD;
  dwdTableSize: DWORD;
  carCurrentPid: Cardinal;
  carServer: Cardinal;
  i: Integer;
  strExternalIp: string;
  strRemoteIP: string;

begin
  lvConnections.Items.BeginUpdate;

  try
    lvConnections.Items.Clear;

    carCurrentPid := GetCurrentProcessId;
    strExternalIp := GetExternalIP(CNT_EXTERNAL_IP);
    dwdTableSize := 0;
    dwdResult := GetExtendedTcpTable(nil, @dwdTableSize, False, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0);

    if dwdResult <> ERROR_INSUFFICIENT_BUFFER then Exit;
    GetMem(recTcpTable, dwdTableSize);

    try
       objSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

       if GetExtendedTcpTable(recTcpTable, @dwdTableSize, True, AF_INET, TCP_TABLE_OWNER_PID_ALL, 0) = NO_ERROR then
       begin
          for i := 0 to recTcpTable.dwNumEntries - 1 do
          begin
           // Acá en el IF cuando pasa por "(recTcpTable.Table[i].dwRemoteAddr" es donde da el error de "Range Check Error"

           if (recTcpTable.Table[i].dwOwningPid <> 0) and (recTcpTable.Table[i].dwOwningPid <> carCurrentPid) and (recTcpTable.Table[i].dwRemoteAddr <> 0) then
            begin
               recIpAddress.s_addr := recTcpTable.Table[i].dwRemoteAddr;

               strRemoteIP := string(inet_ntoa(recIpAddress));
               carServer := recTcpTable.Table[i].dwRemoteAddr;
               blnIsLocal := (FLocalIpAddresses.IndexOfIP(strRemoteIP) >= 0) or (carServer = 0) or (carServer = 16777343);

               if chkOnlyRemoteConnections.Checked and blnIsLocal then Continue;
               if recTcpTable.Table[i].dwRemoteAddr = 0 then recTcpTable.Table[i].dwRemotePort := 0;

               objListItem := lvConnections.Items.Add;

               objListItem.ImageIndex := -1;
               objListItem.Caption := IntToStr(recTcpTable.Table[i].dwOwningPid);
               objListItem.SubItems.Add(GetPIDName(objSnapshot, recTcpTable.Table[i].dwOwningPid));
               objListItem.SubItems.Add('TCP');
               objListItem.SubItems.Add(FLocalComputerName);

               recIpAddress.s_addr := recTcpTable.Table[i].dwLocalAddr;
               objListItem.SubItems.Add(string(inet_ntoa(recIpAddress)));
               objListItem.SubItems.Add(IntToStr(recTcpTable.Table[i].dwLocalPort));

               objListItem.SubItems.AddObject('', Pointer(recTcpTable.Table[i].dwRemoteAddr));

               recIpAddress.s_addr := recTcpTable.Table[i].dwRemoteAddr;
               objListItem.SubItems.Add(strRemoteIP);
               objListItem.SubItems.Add(IntToStr(recTcpTable.Table[i].dwRemotePort));
               objListItem.SubItems.Add(MIB_TCP_STATE[recTcpTable.Table[i].dwState]);

               objListItem.SubItems.Add('');
               objListItem.SubItems.Add('');
               objListItem.SubItems.Add('');
               objListItem.SubItems.Add('');
            end;
          end;
       end;
    finally
       FreeMem(recTcpTable);
    end;
  finally
    lvConnections.Items.EndUpdate;
  end;
end;

Se que el error se debe por el tipo de dato, pero el record que usa tiene los mismos tipos de datos que indica la documentación de Microsoft.

Como esto lo saque de interent de otro foro creo que puede ser que hay algo que no funciona en Delphi 11 y que esto este si funciona si lo pruebo en Delphi 7 (Digo esto porque todos los ejemplos que he encontrado en Interent son algo viejos y exponen que están hechos con Delphi 7).

He obviado la parte donde llamo a la función de la DLL "iphlpapi.dll", pero si consideran que falta algo me lo dicen.

Saludos,
El Rayo

[Casimiro Notevi]

¿Y algo así?

Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetTcpConnections: string;
const
  TCP_TABLE_BASIC_ALL = 4;
type
  TCP_TABLE_BASIC_ALL = record
    dwNumEntries: DWORD;
    table: array [0..0] of MIB_TCPROW_OWNER_PID;
  end;
var
  tcpTable: TCP_TABLE_BASIC_ALL;
  dwSize: DWORD;
  i: Integer;
begin
  Result := '';

  dwSize := 0;
  if GetExtendedTcpTable(nil, @dwSize, False, AF_INET, TCP_TABLE_BASIC_ALL, 0) = ERROR_INSUFFICIENT_BUFFER then
  begin
    SetLength(Result, dwSize);
    if GetExtendedTcpTable(@tcpTable, @dwSize, False, AF_INET, TCP_TABLE_BASIC_ALL, 0) = NO_ERROR then
    begin
      for i := 0 to tcpTable.dwNumEntries - 1 do
      begin
        Result := Result + Format('LocalAddr: %s, LocalPort: %d, RemoteAddr: %s, RemotePort: %d, PID: %d',
          [IntToIP(tcpTable.table[i].dwLocalAddr), ntohs(tcpTable.table[i].dwLocalPort),
           IntToIP(tcpTable.table[i].dwRemoteAddr), ntohs(tcpTable.table[i].dwRemotePort),
           tcpTable.table[i].dwOwningPid]) + sLineBreak;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Lines.Text := GetTcpConnections;
end;

end.

[Delphi01]

El error de "Range Check Error" ocurre cuando se accede a un índice fuera de los límites de un array. En el código que has proporcionado, el error ocurre en la línea donde se accede a recTcpTable.Table[i].dwRemoteAddr. Esto puede suceder si el valor de i es mayor o igual al número de entradas en la tabla recTcpTable.
Para solucionar este error, asegúrate de que el valor de i esté dentro de los límites válidos de la tabla. Puedes hacer esto verificando que i sea menor que recTcpTable.dwNumEntries antes de acceder a recTcpTable.Table[i].dwRemoteAddr.
Aquí tienes un ejemplo de cómo puedes realizar esta verificación:

for i := 0 to recTcpTable.dwNumEntries - 1 do
begin
  if (i >= recTcpTable.dwNumEntries) then
    Break;
  
  // Resto del código...
end;

Creo que al realizar esta verificación, te aseguras de que i no exceda los límites válidos de la tabla y evitas el error de "Range Check Error".
Pruébalo...

[elrayo76]

Empezado por Delphi01

El error de "Range Check Error" ocurre cuando se accede a un índice fuera de los límites de un array. En el código que has proporcionado, el error ocurre en la línea donde se accede a recTcpTable.Table[i].dwRemoteAddr. Esto puede suceder si el valor de i es mayor o igual al número de entradas en la tabla recTcpTable.

Se que el error es en ese punto, pero no es por lo que dices. Si te fijas en el IF veras que se acceder a los otros valores del record y he comprobado que los otros no dan error. El error me suena mas a que algo no funciona en Delphi 11 con respecto a los tipos de datos que dice la documentación de Microsoft para el record que uso.

Si buscas en Internet podrás ver que usan cosas similares, pero solo que está pensado con Delphi 7.

He probado cambiar el tipo de dato del record para "dwRemoteAddr" y el error no se da, pero no es lógico dado que la documentación de Microsoft como dije utiliza un DWORD. Este cambio hace que tenga que cambpiar y revisar todo el código.

Lo que se me ocurre pensándolo bien es que dwRemoteAddr este guardando una dirección de IPv6 y que que como utilizo todo con IPv4 por eso da el error. Pero ya te digo que no lo se, tendría que buscar la forma de ver que es lo que intenta obtener

La validación que dices de poner no la veo lógica, por mas que pueda funcionar, ya que si le dices que el ciclo este entre 0 y el máximo - 1 de la tabla no debería nunca pasarse de la cantidad de items del array.

Casimiro, voy a probar con lo que tu me dices, puede que el problema como comente una líneas mas arriba puede ser dado por la versión de IP que quiere obtener y que el tipo de dato no sea el adecuado. Si es así y lo que propones funciona sería una solución y luego vería el tema de las direcciónes de IPv6

Saludos

[elrayo76]

He podido probar las dos opciones que mencionan, tanto lo de Delphi01 como lo de Casimiro y ninguna funciona.

Lo de Delphi01 nunca sucede, no se pasa del máximo de la tabla. Lo que comenta Casimiro he modificado para usar "
TCP_TABLE_BASIC_ALL" en la función pero no da resultado, después el resto es todo igual a como lo tengo yo, sacando donde se muestran los datos, pero ese no es el problema porque nunca llega esa parte.

Saludos