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
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
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;
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;
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]
)