Problemas cuando elimino un componente en RunTime

[darkamerico]

Saludos amigos:
Estoy realizando un panel de control en Delphi 10.3 para conocer la conectividad de los servidores del data center, basado en Ping.
Este es el aspecto de la pantalla principal:



Asumiremos que solo hay 2 servidores en la BD: 192.168.1.10 y 192.168.1.11.

Al Iniciar el programa el Ping de ambos servidores funcionan bien y se listan en el panel de la izquierda.

Luego de un tiempo el servidor 192.168.1.11 cae, al presionar el botón Actualizar ahora tenemos a 192.168.1.10 en el panel izquierdo (activos) y a 192.168.1.11 en el panel derecho (inactivos).

Luego de un tiempo mas el server 11 vuelve a tener ping, ahí ocurre el error: al presionar el botón actualizar.

Dejo la unidad completa para documentación:

Código Delphi [-]
unit uPrincipal;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VrControls, VrLights, cxGraphics,
  cxControls, cxLookAndFeels, cxLookAndFeelPainters, dxSkinsCore, dxSkinBasic,
  dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee,
  dxSkinDarkroom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
  dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast,
  dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
  dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
  dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
  dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
  dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
  dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinOffice2016Colorful,
  dxSkinOffice2016Dark, dxSkinOffice2019Black, dxSkinOffice2019Colorful,
  dxSkinOffice2019DarkGray, dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven,
  dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
  dxSkinSpringtime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
  dxSkinTheBezier, dxSkinsDefaultPainters, dxSkinValentine,
  dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
  dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
  dxSkinXmas2008Blue, Vcl.ExtCtrls, cxScrollBox, Vcl.Menus, Vcl.StdCtrls,
  cxButtons, Vcl.Mask, AdvEdit, AdvIPEdit, VrSwitch, VrLeds;

type
  TfrmPrincipal = class(TForm)
    Panel1: TPanel;
    scrollActivos: TcxScrollBox;
    Splitter1: TSplitter;
    scrollInactivos: TcxScrollBox;
    btnSalir: TcxButton;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    txtBuscaIP: TAdvIPEdit;
    btnActualizar: TcxButton;
    procedure btnSalirClick(Sender: TObject);
    procedure btnActualizarClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    function Ping(const AHost: string): Boolean;
    procedure ActualizarPanelServers;
  end;

var
  frmPrincipal: TfrmPrincipal;
  panx, pany:TPanel;
  lblTitulo1, lblTitulo2, lblNombre1, lblNombre2, lblIp1, lblIp2: TLabel;
  txtNombre1, txtNombre2, txtIP1, txtIP2: TEdit;
  led1, led2: TVrUserLed;

implementation

{$R *.dfm}

uses uDM, IdIcmpClient, IdGlobal, uTest;

function TfrmPrincipal.Ping(const AHost: string): Boolean;
var
  MyIdIcmpClient : TIdIcmpClient;
begin
  Result := True;

  MyIdIcmpClient := TIdIcmpClient.Create(self);
  MyIdIcmpClient.ReceiveTimeout := 200;
  MyIdIcmpClient.Host := AHost;
  MyIdIcmpClient.PacketSize := 24;
  MyIdIcmpClient.Protocol := 1;
  MyIdIcmpClient.IPVersion := Id_IPv4;

  try
    MyIdIcmpClient.Ping;
    Sleep(250);
  except
    Result := False;
    Exit;
  end;
  if MyIdIcmpClient.ReplyStatus.ReplyStatusType <> rsEcho Then result := False;

  MyIdIcmpClient.Free;
end;

procedure TfrmPrincipal.btnActualizarClick(Sender: TObject);
var
  indice:integer;
begin
(*
    for indice := 0 to 500 do
    begin
      if Assigned('pan'+IntToStr(indice)) then
      begin
        panx.Free;
        panx.Assign(nil);
      end;
    if Assigned(lblTitulo) then
    begin
      lblTitulo.Free;
      lblTitulo.Assign(nil);
    end;
    if Assigned(lblNombre) then lblNombre.Free;
    if Assigned(lblIP) then lblIP.Free;
    if Assigned(txtNombre) then txtNombre.Free;
    if Assigned(txtIP) then txtIP.Free;
    if Assigned(led) then led.Free;
    end;

*)
  ActualizarPanelServers;
end;

procedure TfrmPrincipal.btnSalirClick(Sender: TObject);
begin
  Halt;
end;

procedure TfrmPrincipal.Button1Click(Sender: TObject);
begin
  frmTest.Show;
end;

procedure TfrmPrincipal.FormActivate(Sender: TObject);
begin
  ActualizarPanelServers;
end;

procedure TfrmPrincipal.ActualizarPanelServers;
var
  L1, L2:Tlist;
  x, y,i, j, Index:integer;
begin
  for x := scrollActivos.ControlCount -1 downto 0 do
  begin
    if scrollActivos.Controls[x] is TPanel then
       TPanel(scrollActivos.Controls[x]).Free;
  end;

  for y := scrollInactivos.ControlCount -1 downto 0 do
  begin
    if scrollInactivos.Controls[y] is TPanel then
       TPanel(scrollInactivos.Controls[y]).Free;
  end;

  L1 := TList.Create();
  L2 := TList.Create();

  dm.q_Servidores.Close;
  dm.q_Servidores.Open;
  dm.q_Servidores.Active:=True;
  dm.q_Servidores.First;

  i:=0;
  j:=100;

  while not dm.q_Servidores.Eof do
  begin
    try
      if Ping(dm.q_Servidores.FieldByName('ipv4').AsString) then
      begin
        panx:=TPanel.Create(Self);
        panx.Name:='pan1_' + IntToStr(i);
        panx.Caption:='';
        panx.Parent:=scrollActivos;
        panx.Align:=alTop;
        panx.Color:=clInfoBk;
        panx.Height:=81;
        panx.Visible:=True;

        // Contenido de cada Panel
        lblTitulo1:=TLabel.Create(panx);
        lblTitulo1.Name:='titulo1_' + IntToStr(i);
        lblTitulo1.Parent:=panx;
        lblTitulo1.Left:=8;
        lblTitulo1.Top:=5;
        lblTitulo1.Font.Style:=[fsBold];
        lblTitulo1.Caption:='Servidor';

        lblNombre1:=TLabel.Create(panx);
        lblNombre1.Name:='nombre1_'+IntToStr(i);
        lblNombre1.Parent:=panx;
        lblNombre1.Left:=32;
        lblNombre1.Top:=24;
        lblNombre1.Caption:='[-] Nombre:';

        lblIp1:=TLabel.Create(panx);
        lblIp1.Name:='ip1_'+IntToStr(i);
        lblIp1.Parent:=panx;
        lblIp1.Left:=32;
        lblIp1.Top:=48;
        lblIp1.Caption:='[-] IP:';

        txtNombre1:=TEdit.Create(panx);
        txtNombre1.Name:='txtNombre1_'+IntToStr(i);
        txtNombre1.Parent:=panx;
        txtNombre1.Left:=95;
        txtNombre1.Top:=21;
        txtNombre1.Width:=184;
        txtNombre1.Text:=dm.q_Servidores.FieldByName('nombre').AsString;
        txtNombre1.Color:=cl3DLight;
        txtNombre1.ReadOnly:=True;

        txtIP1:=TEdit.Create(panx);
        txtIP1.Name:='txtIP1_'+IntToStr(i);
        txtIP1.Parent:=panx;
        txtIP1.Left:=95;
        txtIP1.Top:=45;
        txtIP1.Width:=121;
        txtIP1.Text:=dm.q_Servidores.FieldByName('ipv4').AsString;
        txtIP1.Color:=cl3DLight;
        txtIP1.ReadOnly:=True;

        led1:=TVrUserLed.Create(panx);
        led1.Name:='led1_'+IntToStr(i);
        led1.Parent:=panx;
        led1.Left:=222;
        led1.Top:=45;
        led1.Width:=57;
        led1.Height:=22;
        led1.PaletteEx.High1:=clLime;
        led1.PaletteEx.Low1:=clMaroon;
        led1.Active:=True;

        Index:=L1.Add(panx);

        Inc(i);
      end
      else
      begin
        pany:=TPanel.Create(Self);
        pany.Name:='pan2_' + IntToStr(i);
        pany.Caption:='';
        pany.Parent:=scrollInactivos;
        pany.Align:=alTop;
        pany.Color:=clInfoBk;
        pany.Height:=81;
        pany.Visible:=True;

        // Contenido de cada Panel
        lblTitulo2:=TLabel.Create(panx);
        lblTitulo2.Name:='titulo2_' + IntToStr(i);
        lblTitulo2.Parent:=pany;
        lblTitulo2.Left:=8;
        lblTitulo2.Top:=5;
        lblTitulo2.Font.Style:=[fsBold];
        lblTitulo2.Caption:='Servidor';

        lblNombre2:=TLabel.Create(panx);
        lblNombre2.Name:='nombre2_'+IntToStr(i);
        lblNombre2.Parent:=pany;
        lblNombre2.Left:=32;
        lblNombre2.Top:=24;
        lblNombre2.Caption:='[-] Nombre:';

        lblIp2:=TLabel.Create(panx);
        lblIp2.Name:='ip2_'+IntToStr(i);
        lblIp2.Parent:=pany;
        lblIp2.Left:=32;
        lblIp2.Top:=48;
        lblIp2.Caption:='[-] IP:';

        txtNombre2:=TEdit.Create(panx);
        txtNombre2.Name:='txtNombre2_'+IntToStr(i);
        txtNombre2.Parent:=pany;
        txtNombre2.Left:=95;
        txtNombre2.Top:=21;
        txtNombre2.Width:=184;
        txtNombre2.Text:=dm.q_Servidores.FieldByName('nombre').AsString;
        txtNombre2.Color:=cl3DLight;
        txtNombre2.ReadOnly:=True;

        txtIP2:=TEdit.Create(panx);
        txtIP2.Name:='txtIP2_'+IntToStr(i);
        txtIP2.Parent:=pany;
        txtIP2.Left:=95;
        txtIP2.Top:=45;
        txtIP2.Width:=121;
        txtIP2.Text:=dm.q_Servidores.FieldByName('ipv4').AsString;
        txtIP2.Color:=cl3DLight;
        txtIP2.ReadOnly:=True;

        led2:=TVrUserLed.Create(panx);
        led2.Name:='led2_'+IntToStr(i);
        led2.Parent:=pany;
        led2.Left:=222;
        led2.Top:=45;
        led2.Width:=57;
        led2.Height:=22;
        led2.PaletteEx.High1:=clLime;
        led2.PaletteEx.Low1:=clMaroon;
        Inc(j);
        led2.Active:=False;

        Index:=L2.Add(panx);
      end;

    except

    end;
    dm.q_Servidores.Next;
  end;
end;
end.

Por ultimo la estructura de la tabla de SQL Server:

Código SQL [-]
CREATE TABLE [serv].[lista_servers] (
  [id_servidor] bigint  NOT NULL,
  [nombre] varchar(100) COLLATE Modern_Spanish_CI_AS  NULL,
  [ipv4] varchar(15) COLLATE Modern_Spanish_CI_AS  NULL,
  [estado] char(1) COLLATE Modern_Spanish_CI_AS  NULL,
  CONSTRAINT [PK__servidor__6F92154122B4C15E] PRIMARY KEY CLUSTERED ([id_servidor])
WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON)  
ON [PRIMARY]
)

[Neftali [Germán.Estévez]]

Empezado por darkamerico

Luego de un tiempo mas el server 11 vuelve a tener ping, ahí ocurre el error: al presionar el botón actualizar.

Y lo más importante, ¿qué error te da?
Hay bastantes cosas a comentar sobre el código, pero si nos centramos en el error, deberías dar más información.
Por otro lado, ¿lo has ejecutado paso a paso? ¿dónde se produce?


Si saber más, de todas formas te puedo decir algo que te va a dar problemas. Estás definiendo variables globales (panx, lblTitulo1,...) y luego estás usando las mismas variables para crear varios paneles. La segunda vez que las uses estará perdiendo las referencias. Eso además de pérdidas de memoria seguramente te va a generar problemas (accesss violations) a la hora de destruir esos componentes.
También están las listas L1, L2, que he visto que se crean, pero no veo dónde se destruyen.

Eso sumado a que este procedimiento se llama continuamente, se van a convertir en problemas graves.


Otra sugerencia, es que uses Frames. Define un Frame que contenga toda la información de 1 servidor, y crear y destruyes ese frame con 1 línea. Eso te evita el crear y destruir un montón de componentes. Más sencillo, simple y seguro.

[darkamerico]

En primer lugar agradecer la atención estimado Neftalí, si, lo sé, como te puedes dar cuenta, este código adolece de muchas deficiencias, y en parte se debe a que nunca trabaje antes con creación dinámica de componentes, de modo que no conozco la lógica de creación y destrucción de los mismos, voy a dejar el código de este proyecto al completo, así cualquier aporte será bienvenido.
En este proyecto se están usando las siguientes librerías de terceros:
- DevExpress 23.1.4.
- TMS Component Pack 9.0.2.0.

Enlace al Proyecto: Aqui
Video del error: Aqui

Agradecería si hubiera una forma sencilla de corregir el código ya existente, pero bien escrito, jeje

Atte
Américo

Empezado por Neftali [Germán.Estévez]

Y lo más importante, ¿qué error te da?
Hay bastantes cosas a comentar sobre el código, pero si nos centramos en el error, deberías dar más información.
Por otro lado, ¿lo has ejecutado paso a paso? ¿dónde se produce?


Si saber más, de todas formas te puedo decir algo que te va a dar problemas. Estás definiendo variables globales (panx, lblTitulo1,...) y luego estás usando las mismas variables para crear varios paneles. La segunda vez que las uses estará perdiendo las referencias. Eso además de pérdidas de memoria seguramente te va a generar problemas (accesss violations) a la hora de destruir esos componentes.
También están las listas L1, L2, que he visto que se crean, pero no veo dónde se destruyen.

Eso sumado a que este procedimiento se llama continuamente, se van a convertir en problemas graves.


Otra sugerencia, es que uses Frames. Define un Frame que contenga toda la información de 1 servidor, y crear y destruyes ese frame con 1 línea. Eso te evita el crear y destruir un montón de componentes. Más sencillo, simple y seguro.

[Neftali [Germán.Estévez]]

El error que aparece al destruir componentes (por lo que he visto).

[darkamerico]

Empezado por Neftali [Germán.Estévez]

El error que aparece al destruir componentes (por lo que he visto).

Eso es correcto amigo. Debido a mi poca expertice en el manejo de objetos en Runtime, no puedo tener la idea clara de como arreglar este inconveniente.

[Neftali [Germán.Estévez]]

Este seguramente, porque en la parte del ELSE añades a la lista esto:

Código Delphi [-]
Index:=L2.Add(panx);

En lugar de esto:

Código Delphi [-]
Index:=L2.Add(pany);

Eso provoca el "Accesss Violatoin" al destruir los componentes.

[cloayza]

Estimado Darkamerico...creo que sería una buena opción que utilizara TFrame...Simplificaría creo, el problema.

Como estoy de vacaciones y un poquito aburrido, le envío un ejemplo a ver si le ayuda en su problema...De lo contrario lo arroja al tacho de la basura...

ServerFrame_Sample_Cloayza

Saludos cordiales

[darkamerico]

Muchas gracias bro,
lo voy a revisar


Un Abrazo

Empezado por cloayza

Estimado Darkamerico...creo que sería una buena opción que utilizara TFrame...Simplificaría creo, el problema.

Como estoy de vacaciones y un poquito aburrido, le envío un ejemplo a ver si le ayuda en su problema...De lo contrario lo arroja al tacho de la basura...

ServerFrame_Sample_Cloayza

Saludos cordiales