Traсert, Принцип трассировки маршрута прохождения сетевого запроса

////////////////////////////////////////////////////////////////////////////////
//
// Демонстрационная программа Tracert.exe
// Цель: показать принцип трассировки
//
// Автор: Александр (Rouse_) Багель
// mailto: rouse79@yandex.ru
//
// Отдельное спасибо Игорю Шевченко за тестирование кода
// и указание на ошибки, которые могут возникнуть при компиляции
// в различных версиях Delphi, а также за советы по оптимизации кода
//
// 8 апреля 2004 года
//
////////////////////////////////////////////////////////////////////////////////
//
// Как это работает?
//
// Для начала нужно вспомнить формат заголовка IP-пакета,
// точнее одно из его полей - TTL (Time To Live).
// Это восьмибитное поле задает максимальное число хопов
// (hop - "прыжок" - прохождение дейтаграммы от одного маршрутизатора к другому)
// в течение которого пакет может находиться в сети.
// Каждый маршрутизатор, обрабатывающий эту дейтаграмму,
// выполняет операцию TTL=TTL-1.
// Когда TTL становится равным нулю,
// маршрутизатор уничтожает пакет,
// отправителю высылается ICMP-сообщение Time Exceeded.
//
// Утилита посылает в направлении заданного хоста пакет с TTL=1,
// и ждет, от кого вернется ответ time exceeded.
// Отвечающий записывается как первый хоп
// (результат первого шага на пути к цели).
// Затем посылаются последовательно пакеты с TTL=2, 3, 4 и т.д. по порядку,
// пока при некотором значении TTL пакет не достигнет цели
// и не получит от нее ответ.
//
// © http://www.nvkz.net/taifun/xak/tracert.htm
//
////////////////////////////////////////////////////////////////////////////////
unit uMain;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, WinSock, Spin;
{$DEFINE NO_MESSAGE}
const
 ICMP = 'ICMP.DLL';
 RES_UNKNOWN = 'Unknown';
 WSA_TYPE = $101;
 STR_TRACE = 'Трассировка маршрута к ';
 STR_JUMP = 'с максимальным числом прыжков ';
 STR_DONE = 'Трассировка завершена.' + #13#10;
 HOST_NOT_REPLY = 'Превышен интервал ожидания для запроса.';
type
 IP_INFO = packed record
 Ttl: Byte;
 Tos: Byte;
 IPFlags: Byte;
 OptSize: Byte;
 Options: Pointer;
 end;
 PIP_INFO = ^IP_INFO;
 ICMP_ECHO = packed record
 Source: Longint;
 Status: Longint;
 RTTime: Longint;
 DataSize: Word;
 Reserved: Word;
 pData: Pointer;
 i_ipinfo: IP_INFO;
 end;
 TfrmMain = class(TForm)
 gbTracert: TGroupBox;
 memShowTracert: TMemo;
 edAddr: TEdit;
 btnStart: TButton;
 sedCount: TSpinEdit;
 lblHost: TLabel;
 lblHop: TLabel;
 procedure btnStartClick(Sender: TObject);
 end;
 TTraceThread = class(TThread)
 private
 DestAddr: in_addr;
 TraceHandle: THandle;
 DestinationAddress,
 ReportString: String;
 IterationCount: Byte;
 public
 procedure Execute; override;
 procedure Log;
 function Trace(const Iteration: Byte): Longint;
 end;
var
 frmMain: TfrmMain;
implementation
{$R *.dfm}
function IcmpCreateFile: THandle; stdcall; external ICMP name 'IcmpCreateFile';
function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall;
 external ICMP name 'IcmpCloseHandle';
function IcmpSendEcho(IcmpHandle : THandle; DestAddress: Longint;
 RequestData: Pointer; RequestSize: Word; RequestOptns: PIP_INFO;
 ReplyBuffer: Pointer; ReplySize, Timeout: DWORD): DWORD; stdcall;
 external ICMP name 'IcmpSendEcho';
{ Other functions }
// Функция возвращает имя хоста по его IP адресу
function GetNameFromIP(const IP: String): String;
const
 ERR_INADDR = 'Can not convert IP to in_addr.';
 ERR_HOST = 'Can not get host information.';
 ERR_WSA = 'Can not initialize WSA.';
var
 WSA : TWSAData;
 Host : PHostEnt;
 Addr : u_long;
 Err : Integer;
begin
 Result := RES_UNKNOWN;
 Err := WSAStartup(WSA_TYPE, WSA);
 if Err <> 0 then
 begin
 {$IFNDEF NO_MESSAGE}
 MessageDlg(ERR_WSA, mtError, [mbOK], 0);
 {$ENDIF}
 Exit;
 end;
 try
 Addr := inet_addr(PChar(IP));
 if Addr = u_long(INADDR_NONE) then
 begin
 {$IFNDEF NO_MESSAGE}
 MessageDlg(ERR_INADDR, mtError, [mbOK], 0);
 {$ENDIF}
 Exit;
 end;
 Host := gethostbyaddr(@Addr, SizeOf(Addr), PF_INET);
 if Assigned(Host) then
 Result := Host.h_name
 {$IFNDEF NO_MESSAGE}
 else
 MessageDlg(ERR_HOST, mtError, [mbOK], 0)
 {$ENDIF}
 ;
 finally
 WSACleanup;
 end;
end;
// Функция преобразует IP адрес в его строковый эквивалент
function GetDottetIP(const IP: Longint): String;
begin
 Result := Format('%d.%d.%d.%d', [IP and $FF,
 (IP shr 8) and $FF, (IP shr 16) and $FF, (IP shr 24) and $FF]);
end;
{ TfrmMain }
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
 // Чтобы программа не подвисала
 // запускаем трассировку в отдельном потоке
 with TTraceThread.Create(False) do begin
 FreeOnTerminate := True;
 // Передаем имя хоста
 DestinationAddress := edAddr.Text;
 // и максимальное число прыжков
 IterationCount := sedCount.Value;
 Resume;
 end;
end;
{ TTraceThread }
procedure TTraceThread.Execute;
var
 WSAData: TWSAData; // Служебные
 Host: PHostEnt; // переменные
 Error, // для просмотра кодов ошибок
 TickStart: DWORD; // для подсчета времени ответа на пинг
 Result: Longint; // содержит результат выполнения Trace
 I, // для цикла
 Iteration: Byte; // используется для увеличения TTL
 HostName: String; // содержит имя хоста
 HostReply: Boolean; // флаг False если хост не ответил 3 раза на пинг
 HostIP: LongInt; // при ответе хоста сюда заносится его IP (во избежания глюка)
begin
 // Инициализируем Winsock
 Error := WSAStartup(WSA_TYPE, WSAData);
 if Error <> 0 then
 begin
 ReportString := SysErrorMessage(WSAGetLastError);
 Synchronize(Log);
 Exit;
 end;
 try
 // Пытаемся получить IP адрес
 // до которого будем проводить трассировку
 Host := gethostbyname(PChar(DestinationAddress));
 if not Assigned(Host) then
 begin
 ReportString := SysErrorMessage(WSAGetLastError);
 Synchronize(Log);
 Exit;
 end;
 // Запоминаем полученый адрес
 DestAddr := PInAddr(Host.h_addr_list^)^;
 // Подготавливаемся к отправке эхозапросов (пинга)
 TraceHandle := IcmpCreateFile;
 if TraceHandle = INVALID_HANDLE_VALUE then
 begin
 ReportString := SysErrorMessage(GetLastError);
 Synchronize(Log);
 Exit;
 end;
 try
 // Выводим информационные строки вида:
 // Трассировка маршрута к www.delphimaster.ru [62.118.251.90]
 // с максимальным числом прыжков 30:
 ReportString := STR_TRACE + DestinationAddress
 + ' [' + GetDottetIP(DestAddr.S_addr)+ ']' + #13#10;
 Synchronize(Log);
 ReportString := STR_JUMP + IntToStr(IterationCount) + ':' + #13#10;
 Synchronize(Log);
 // Инициализируем переменные
 Result := 0;
 Iteration := 0;
 // Начинаем трассировку до тех пор
 while (Result <> DestAddr.S_addr) and // пока IP адреса не совпадут
 (Iteration < IterationCount) do // или кол-во прыжков достигнет максимального
 begin
 Inc(Iteration); // Увеличиваем время жизни пакета
 HostReply := False; // Выставляем флаг, "хост пока не ответил"
 // Запускаем серию из 3 эхозапросов
 for I := 0 to 2 do
 begin
 TickStart := GetTickCount; // Для каждого засекаем время
 Result := Trace(Iteration); // Делаем пинг
 if Result = -1 then // Если нет ответа выводим звезду
 ReportString := ' * '
 else
 begin // Если есть ответ - выводим данные (результатом будет IP ответившего)
 ReportString := Format('%6d ms', [GetTickCount - TickStart]);
 HostReply := True; // и не забываем выставить флаг
 HostIP := Result;
 end;
 if I = 0 then
 ReportString := Format('%3d: %s', [Iteration, ReportString]);
 Synchronize(Log);
 end;
 if HostReply then // Если хост ответил хотябы на 1 пинг
 begin
 // Получаем преобразованный в строковый вид IP
 ReportString := GetDottetIP(HostIP);
 // Получаем имя хоста
 HostName := GetNameFromIP(ReportString);
 // Вывод данных в зависимости от того - получено ли имя хоста
 if HostName <> RES_UNKNOWN then
 ReportString := HostName + '[' + ReportString + ']';
 ReportString := ReportString + #13#10;
 end
 else
 ReportString := HOST_NOT_REPLY + #13#10;
 ReportString := ' ' + ReportString;
 Synchronize(Log);
 end;
 finally
 IcmpCloseHandle(TraceHandle);
 end;
 // Выводим информационную строку "Трассировка завершена."
 ReportString := STR_DONE;
 Synchronize(Log);
 finally
 WSACleanup;
 end;
end;
// Процедура отвечает за вывод информации в memShowTracert
procedure TTraceThread.Log;
begin
 frmMain.memShowTracert.Text :=
 frmMain.memShowTracert.Text + ReportString;
 SendMessage(frmMain.memShowTracert.Handle, WM_VSCROLL, SB_BOTTOM, 0);
end;
// Однократная посылка эхозапроса
function TTraceThread.Trace(const Iteration: Byte): Longint;
var
 IP: IP_INFO;
 ECHO: ^ICMP_ECHO;
 Error: Integer;
begin
 GetMem(ECHO, SizeOf(ICMP_ECHO));
 try
 with IP do // Заполнение заголовка
 begin
 Ttl := Iteration; // Самый важный момент в трассировке - постепенное увеличение TTL
 Tos := 0;
 IPFlags := 0;
 OptSize := 0;
 Options := nil;
 end;
 // Непосредственно посылка эхозапроса
 Error := IcmpSendEcho(TraceHandle,
 DestAddr.S_addr,
 nil,
 0,
 @IP,
 ECHO,
 SizeOf(ICMP_ECHO),
 5000);
 // Проверка на ошибки
 if Error = 0 then
 begin
 Result := -1;
 Exit;
 end;
 // Если ошибок не обнаружено результатом будет IP адрес ответившего хоста
 Result := ECHO.Source;
 finally
 FreeMem(ECHO);
 end;
end;
end.
Проект также доступен по адресу: http://rouse.front.ru/tracert.zip
Author: Rouse_
Source: http://forum.sources.ru
ID: 03586
Category:Связь
Category:Web