Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Coloboración Paypal con ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 03-02-2024
elrayo76 elrayo76 is offline
Miembro
 
Registrado: ene 2004
Ubicación: En la tierra, por eso mis archivos en la tierra y no en la nuebe...
Posts: 304
Poder: 21
elrayo76 Va por buen camino
Conexiones TCP abiertas en una computadora

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
__________________
Si tienes una función o procedimiento con diez parámetros, probablemente hayas olvidado uno
Responder Con Cita
  #2  
Antiguo 03-02-2024
Avatar de Casimiro Notevi
Casimiro Notevi Casimiro Notevi is offline
Moderador
 
Registrado: sep 2004
Ubicación: En algún lugar.
Posts: 32.257
Poder: 10
Casimiro Notevi Tiene un aura espectacularCasimiro Notevi Tiene un aura espectacular
¿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.
Responder Con Cita
  #3  
Antiguo 03-02-2024
Delphi01 Delphi01 is offline
Miembro
 
Registrado: nov 2015
Ubicación: Barcelona,España
Posts: 68
Poder: 9
Delphi01 Va por buen camino
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:
Código:
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...
Responder Con Cita
  #4  
Antiguo 04-02-2024
elrayo76 elrayo76 is offline
Miembro
 
Registrado: ene 2004
Ubicación: En la tierra, por eso mis archivos en la tierra y no en la nuebe...
Posts: 304
Poder: 21
elrayo76 Va por buen camino
Cita:
Empezado por Delphi01 Ver Mensaje
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
__________________
Si tienes una función o procedimiento con diez parámetros, probablemente hayas olvidado uno
Responder Con Cita
  #5  
Antiguo 04-02-2024
elrayo76 elrayo76 is offline
Miembro
 
Registrado: ene 2004
Ubicación: En la tierra, por eso mis archivos en la tierra y no en la nuebe...
Posts: 304
Poder: 21
elrayo76 Va por buen camino
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
__________________
Si tienes una función o procedimiento con diez parámetros, probablemente hayas olvidado uno
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Cerrar conexiones que quedan abiertas arantzal Varios 4 02-05-2007 13:40:45
Tu computadora en cualquier computadora egostar La Taberna 2 17-03-2007 04:46:40
instancias abiertas muli Firebird e Interbase 0 07-07-2004 20:48:23
Tablas Abiertas Ulises Providers 2 02-03-2004 13:50:23
Ventanas abiertas Isaac Varios 3 11-02-2004 17:44:37


La franja horaria es GMT +2. Ahora son las 01:08:05.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi