[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