Creando una herramienta para hacer Ping utilizando Indy10

En éste artículo os traigo una herramienta llamada "Thundax Ping", la cuál nos permite hacer los mismo que el comando "ping" de windows para saber si un equipo remoto está vivo o no. Mediante los componentes de Indy10, creo una pequeña clase que hereda de TThread para utilizar el componente IdCmpClient y vuelca el resultado en un TMemo. La aplicación es bastante simple y la mayor parte del trabajo la hace el componente de Indy.

Para la configuración de la aplicación utilizaremos los siguientes componentes:

Un TIdIcmpClient y un TIdAntiFreeze. Luego el componente Icmp lo pasaremos a nuestra clase para que lo utilice. Para la realización del código, he cogido varios ejemplos de la red y he hecho un pequeño mix entre éstas para lo que yo quería.


El código fuente de la unidad para el uso del TIdIcmpClient .

unit PingLib;

interface

uses
    SysUtils, Variants, Classes, Graphics,
    StdCtrls, IdBaseComponent,
    IdComponent, IdRawBase, IdRawClient, IdIcmpClient, IdException, ExtCtrls;

type
    TPingThread = class(TThread)
    protected
        procedure Execute; override;
    private
        Line: string;
        ThisDelay: Integer;
    public
        IdIcmp: TIdIcmpClient;
        IP: string;
        Delay: integer;
        Memo: TMemo;
        Timer: TTimer;
        Cyclic: boolean;
        procedure IdIcmpReplay(ASender: TComponent; const AReplyStatus: TReplyStatus);
        procedure Write;
        procedure CyclicExecution;
        procedure SetParametres(IdICMpClient : TIdIcmpClient; Ip : String; Delay : integer; Cyclic : Boolean; Memo : TMemo; Timer : TTimer; Lbl, LblAvg : TLabel);
    end;

implementation

procedure TPingThread.SetParametres(IdICMpClient: TIdIcmpClient; Ip: String; Delay: integer; Cyclic: Boolean; Memo: TMemo; Timer: TTimer; Lbl, LblAvg: TLabel);
begin
    IdIcmp := IdICMpClient;
    Self.Ip := IP;
    Self.Delay := Delay;
    Self.Cyclic := Cyclic;
    Self.Memo := Memo;
    Self.Timer := Timer;
    Self.Lbl := Lbl;
    Self.LblAvg := LblAvg;
    FreeOnTerminate := true;
end;

procedure TPingThread.Write;
begin
    Memo.Lines.Add(Line);
end;

procedure TPingThread.CyclicExecution;
begin
    Timer.Enabled := true;
end;

procedure TPingThread.Execute;
begin
    inherited;
    IdIcmp.Host := IP;
    IdIcmp.ReceiveTimeout := Delay;
    IdIcmp.OnReply := IdIcmpReplay;
    Line := 'Pinging ' + IdIcmp.Host;
    Synchronize(LblCaption);
    try
        IdIcmp.Ping;
    except
        on A: EIdIcmpException do
        begin
            Line := Timetostr(Time) + ' - ' + A.Message;
            Synchronize(Write);
            Line := 'Ready!';
            if Cyclic then
                Synchronize(CyclicExecution);
        end;
        on A: EIdSocketError do
        begin
            if A.LastError = 11001 then
                Line := TimeToStr(Time) + ' - ' + 'Host Not Found or Invalid'
            else
                Line := TimeToStr(Time) + ' - ' + A.Message + ' - ' + IntToStr(A.LastError);
            Synchronize(Write);
            Line := 'Ready!';
            if Cyclic then
                Synchronize(CyclicExecution);
        end;
    end;
end;

procedure TPingThread.IdIcmpReplay(ASender: TComponent; const AReplyStatus: TReplyStatus);
var
    Reply, Status: string;
    Fail: boolean;
begin
    Reply := 'Reply from '+ IP +' time<' + InttoStr(AReplyStatus.MsRoundTripTime) + 'ms';
    Fail := true;
    case AReplyStatus.ReplyStatusType of
        rsEcho:
            begin
                Status := '';
                ThisDelay := AReplyStatus.MsRoundTripTime;
                Fail := false;
            end;
        rsError: Status := ' - Error Ocurred.';
        rsTimeOut: Status := ' - TimeOut Exceeded';
        rsErrorUnreachable: Status := ' - Unreachable IP';
        rsErrorTTLExceeded: Status := ' - TTL Exceeded';
    end;
    Line := TimeToStr(Time) + ' - ' + Reply + Status;
    Synchronize(Write);
    if Cyclic then
        Synchronize(CyclicExecution);
    Line := 'Ready! ' + IdIcmp.Host;
end;

end.

Fijaros que al componente solo hay que pasarle la IP o Host y ejecutar el método Ping. Todo el otro trabajo es saber la respuesta del Ping, por eso utilizamos un hilo, porqué enviamos la pregunta y tenemos que esperar la respuesta.

Comments

  1. Hola, me parece muy ilustrativo, pero me encuentro con varios fallos al intentar pasar unit PingLib a delphi xe5.
    Serías tan amable de poner en descarga todo el código fuente del exe. Para poder contemplar mejor su comportamiento.

    En caso contrario, podrías decirme que necesito para adaptarlo a delphi xe5.

    Muchas gracias.

    Te felicito por tu blog, he encontrado muchos artículos interesantes.

    ReplyDelete
    Replies
    1. Hola Fco Javier,

      Creo que tienes el reto aqui de utilizar la ultima version de Indy que viene con Delphi XE5. El codigo es el que hay, no hay mas.

      Muchas gracias por visitar mi blog.

      Un Saludo
      Jordi

      Delete

Post a Comment

Popular Posts