На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
Модераторы: Rouse_, jack128, Krid
  
    > Traсert , Принцип трассировки маршрута прохождения сетевого запроса...
    Guru Rouse_
    Сообщ. #1 ,

      Moderator
      *******
      Профиль · PM
      Поощрения: 4 Dgm
      Рейтинг (т): 320
      ExpandedWrap disabled
        ////////////////////////////////////////////////////////////////////////////////
        //
        //  Демонстрационная программа 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
      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
      0 пользователей:


        Рейтинг@Mail.ru
        [ Script execution time: 0,0541 ]   [ 16 queries used ]   [ Generated: 3.05.24, 04:35 GMT ]  
        Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.