Трассировка пути до определенного IP адреса (Traceroute) |
Previous Top Next |
Трассировка пути до определенного IP адреса (как tracert.exe в Windows)
Пример использования модуля:
Code: |
procedure TForm1.Button1Click(Sender: TObject); var RT : TTraceRoute; begin RT := TTraceRoute.Create; RT.Trace('192.168.5.12', ListBox1.Items); RT.Free; end; |
В ListBox1 выведется путь в таком формате:
IP;TIME;TTL;STATUS
Сам модуль:
Code: |
unit TraceRt; interface
// =========================================================================== // TRACEROUTE Class // Mike Heydon Dec 2003 // // Method // Trace(IpAddress : string; ResultList : TStrings) // Returns semi-colon delimited list of ip routes to target // format .. IP ADDRESS; PING TIME MS; TIME TO LIVE; STATUS // // Properties // IcmpTimeOut : integer (Default = 5000ms) // IcmpMaxHops : integer (Default = 40) // ===========================================================================
uses Forms, Windows, Classes, SysUtils, IdIcmpClient;
type TTraceRoute = class(TObject) protected procedure ProcessResponse(Status : TReplyStatus); procedure AddRoute(AResponseTime : DWORD; AStatus: TReplyStatus; const AInfo: string ); private FIcmpTimeOut, FIcmpMaxHops : integer; FResults : TStringList; FICMP : TIdIcmpClient; FPingStart : cardinal; FCurrentTTL : integer; procedure PingTarget; public constructor Create; procedure Trace(const AIpAddress : string; AResultList : TStrings); property IcmpTimeOut : integer read FIcmpTimeOut write FIcmpTimeOut; property IcmpMaxHops : integer read FIcmpMaxHops write FIcmpMaxHops; end;
// --------------------------------------------------------------------------- implementation
// ======================================== // Create the class and set defaults // ========================================
constructor TTraceRoute.Create; begin IcmpTimeOut := 5000; IcmpMaxHops := 40; end;
// ============================================= // Use Indy component to ping hops to target // =============================================
procedure TTraceRoute.PingTarget; var wOldMode : DWORD; begin Application.ProcessMessages; inc(FCurrentTTL);
if FCurrentTTL < FIcmpMaxHops then begin FICMP.TTL := FCurrentTTL; FICMP.ReceiveTimeout := FIcmpTimeOut; FPingStart := GetTickCount; wOldMode := SetErrorMode(SEM_FAILCRITICALERRORS);
try FICMP.Ping; ProcessResponse(FICMP.ReplyStatus); except FResults.Add('0.0.0.0;0;0;ERROR'); end;
SetErrorMode(wOldMode); end else FResults.Add('0.0.0.0;0;0;MAX HOPS EXCEEDED'); end;
// ============================================================ // Add the ping reply status data to the returned stringlist // ============================================================
procedure TTraceRoute.AddRoute(AResponseTime : DWORD; AStatus: TReplyStatus; const AInfo: string ); begin FResults.Add(AStatus.FromIPAddress + ';' + IntToStr(GetTickCount - AResponseTime) + ';' + IntToStr(AStatus.TimeToLive) + ';' + AInfo); end;
// ============================================================ // Process the ping reply status record and add to stringlist // ============================================================
procedure TTraceRoute.ProcessResponse(Status : TReplyStatus); begin case Status.ReplyStatusType of // Last Leg - Terminate Trace rsECHO : AddRoute(FPingStart,Status,'OK');
// More Hops to go - Continue Pinging rsErrorTTLExceeded : begin AddRoute(FPingStart,Status,'OK'); PingTarget; end;
// Error conditions - Terminate Trace rsTimeOut : AddRoute(FPingStart,Status,'TIMEOUT'); rsErrorUnreachable : AddRoute(FPingStart,Status,'UNREACHABLE'); rsError : AddRoute(FPingStart,Status,'ERROR'); end; end;
// ====================================================== // Trace route to target IP address // Results returned in semi-colon delimited stringlist // IP; TIME MS; TIME TO LIVE; STATUS // ======================================================
procedure TTraceRoute.Trace(const AIpAddress : string; AResultList : TStrings); begin FICMP := TIdIcmpClient.Create(nil); FICMP.Host := AIpAddress; FResults := TStringList(AResultList); FResults.Clear; FCurrentTTL := 0; PingTarget; FICMP.Free; end;
{eof} end. |
©Drkb::03354
Автор: p0s0l
Взято с Vingrad.ru http://forum.vingrad.ru