Skip to content

Instantly share code, notes, and snippets.

@HemulGM
Created November 25, 2020 18:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save HemulGM/22764ccfa913552a885a5a894fe86807 to your computer and use it in GitHub Desktop.
Save HemulGM/22764ccfa913552a885a5a894fe86807 to your computer and use it in GitHub Desktop.
Delphi, Indy, Async Ping
uses
IdComponent, IdIcmpClient, System.Threading;
type
TPing = class
private
FMySelf: TPing;
FProc: TProc<Integer>;
procedure FOnReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
procedure FOnStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
procedure FStart(const Host: string; Proc: TProc<Integer>);
public
class procedure Start(const Host: string; Proc: TProc<Integer>);
end;
{ TPing }
procedure TPing.FOnReply(ASender: TComponent; const AReplyStatus: TReplyStatus);
begin
TThread.Synchronize(nil,
procedure
begin
FProc(AReplyStatus.MsRoundTripTime);
end);
end;
procedure TPing.FOnStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
begin
TThread.ForceQueue(nil,
procedure
begin
FProc(-1);
end);
end;
procedure TPing.FStart(const Host: string; Proc: TProc<Integer>);
begin
FProc := Proc;
TTask.Run(
procedure
var
Client: TIdIcmpClient;
begin
Client := TIdIcmpClient.Create(nil);
try
try
Client.ReceiveTimeout := 2000;
Client.Host := Host;
Client.OnReply := FOnReply;
Client.OnStatus := FOnStatus;
Client.Ping;
except
TThread.ForceQueue(nil,
procedure
begin
FProc(-1);
end);
end;
finally
Client.Free;
FMySelf.Free;
end;
end);
end;
class procedure TPing.Start(const Host: string; Proc: TProc<Integer>);
begin
TPing.Create.FStart(Host, Proc);
end;
procedure TForm14.Button1Click(Sender: TObject);
begin
TPing.Start('yayayayaya.ru',
procedure(Time: Integer)
begin
Memo1.Lines.Add(Time.ToString);
end);
end;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment