Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> не работает отправка ping в xp 
:(
    Опции темы
hawkins
Дата 24.11.2006, 18:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003

Репутация: нет
Всего: нет
Помогите с проблемой:
Нужно делать проверку соединения с интернет. Нашел пример
как это делается посылкой ping сообщения на сервер. Скомпилил
 в Delphi6 на 98, и в 98 работает нормально, а в Windows XP, которую загружаю с другого винта - не работает  вызов IcmpSendEcho , запрос вообще не отправляется, т.е.
 в свойствах сединения в строке "отправлено байт" ничего не меняется.
 Может кто сталкивался с такой проблемой?
PM MAIL   Вверх
_hunter
Дата 24.11.2006, 18:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 8564
Регистрация: 24.6.2003
Где: Europe::Ukraine:: Kiev

Репутация: 5
Всего: 98
файрволл отключить попробуй...


--------------------
Tempora mutantur, et nos mutamur in illis...
PM ICQ   Вверх
hawkins
Дата 24.11.2006, 19:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003

Репутация: нет
Всего: нет
А в xp есть встроенный фаервол и как его тогда отключить? А то файервол специально сам не устанавливал.

Может компилить обязательно надо на xp?
Сама эта процедура IcmpCreateFile загружается динамически
из библиотеки  icmp.dll в 9x, а в XP из библиотеки Iphlpapi.dll.
Но в проге это учтено и версия винды определяется правильно (проверял). 
PM MAIL   Вверх
Snowy
Дата 24.11.2006, 20:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484
А из коммандной строки пингуется?
PM MAIL   Вверх
Matematik
Дата 24.11.2006, 20:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50
Случайно права юзера не влияют на работу IcmpSendEcho?
PM MAIL WWW ICQ   Вверх
Rodman
Дата 24.11.2006, 20:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


CIO
****


Профиль
Группа: Участник
Сообщений: 6144
Регистрация: 7.5.2006
Где: Ukraine ⇛ Kyiv ci ty

Репутация: нет
Всего: 122
пуск-настройки-панель интсрументов -  цнетр обеспечения безопасности

там если надо файрвол отключи


--------------------

Лотереи мира
PM MAIL WWW Skype GTalk YIM MSN   Вверх
hawkins
Дата 24.11.2006, 22:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003

Репутация: нет
Всего: нет
Snowy, 
пингуется, и пргой EssentialNet tools тоже нормально

вот зделал тестовый прект, скачать можно по ссылке: 
Pinger1_test

Если кому не сложно скомпильте на XP, ну и проверить можно сразу. 
PM MAIL   Вверх
Matematik
Дата 24.11.2006, 23:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50
Рабочий код,
сравнивай
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, winsock;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
    ip_option_information = packed record  // Информация заголовка IP (Наполнение
                    // этой структуры и формат полей описан в RFC791.
        Ttl : byte;            // Время жизни (используется traceroute-ом)
        Tos : byte;            // Тип обслуживания, обычно 0
        Flags : byte;        // Флаги заголовка IP, обычно 0
        OptionsSize : byte;        // Размер данных в заголовке, обычно 0, максимум 40
        OptionsData : Pointer;    // Указатель на данные
    end;

   icmp_echo_reply = packed record
        Address : u_long;          // Адрес отвечающего
        Status : u_long;          // IP_STATUS (см. ниже)
        RTTime : u_long;          // Время между эхо-запросом и эхо-ответом
                         // в миллисекундах
        DataSize : u_short;          // Размер возвращенных данных
        Reserved : u_short;          // Зарезервировано
        Data : Pointer;         // Указатель на возвращенные данные
        Options : ip_option_information; // Информация из заголовка IP
    end;

    PIPINFO = ^ip_option_information;
    PVOID = Pointer;

        function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
        function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle';
        function IcmpSendEcho(
                          IcmpHandle : THandle;    // handle, возвращенный IcmpCreateFile()
                          DestAddress : u_long;    // Адрес получателя (в сетевом порядке)
                          RequestData : PVOID;     // Указатель на посылаемые данные
                          RequestSize : Word;      // Размер посылаемых данных
                          RequestOptns : PIPINFO;  // Указатель на посылаемую структуру
                                               // ip_option_information (может быть nil)
                          ReplyBuffer : PVOID;     // Указатель на буфер, содержащий ответы.
                          ReplySize : DWORD;       // Размер буфера ответов
                          Timeout : DWORD          // Время ожидания ответа в миллисекундах
                         ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function LongToIp(Long:LongInt):string;
 var
  ipx:array[0..3] of byte;
  i:byte;
 begin
  longint(ipx):=long;
  Result:='';
  for i:=0 to 3 do result:=result+IntToStr(ipx[i])+'.';
  SetLength(Result,Length(Result)-1);
 end;

procedure TForm1.Button1Click(Sender: TObject);
const s=31;
      k=4;
var
    hIP : THandle;
    pingBuffer : array [0..s] of Char;
    pIpe : ^icmp_echo_reply;
    pIinfo : PIPINFO;
    pHostEn : PHostEnt;
    wVersionRequested : WORD;
    lwsaData : WSAData;
    error : DWORD;
    destAddress : In_Addr;
    lpMsgBuf : array[0..255] of Char;
    i : integer;
begin
    pingBuffer := 'Билл ГЕЙ-ц - ЛОХ';
    // Создаем handle
    hIP := IcmpCreateFile();
    GetMem( pIpe, sizeof(icmp_echo_reply) + sizeof(pingBuffer));
    pIpe.Data := @pingBuffer;
    pIpe.DataSize := sizeof(pingBuffer);

    GetMem(pIinfo, sizeof(ip_option_information));
    pIinfo.Ttl := 200;
    pIinfo.Tos := 0;
    pIinfo.Flags := 0;
    pIinfo.OptionsSize := 0;
    pIinfo.OptionsData := nil;

    wVersionRequested := MakeWord(1,1);
    error := WSAStartup(wVersionRequested,lwsaData);
    if (error <> 0) then
    begin
         Memo1.SetTextBuf('Error in call to '+
                          'WSAStartup().');
         Memo1.Lines.Add('Error code: '+IntToStr(error));
         Exit;
    end;

    pHostEn := gethostbyname(Pchar(edit1.text));
    error := GetLastError();
    if (error <> 0) then
    begin
      FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,GetSystemDefaultLangID,lpMsgBuf,sizeof(lpMsgBuf),nil);
      Memo1.SetTextBuf('Error in call to'+
                          'gethostbyname().');
      Memo1.Lines.Add(lpMsgBuf);
         Exit;
    end;

     destAddress := PInAddr(pHostEn^.h_addr_list^)^;
    Memo1.Lines.Add('');
      // Посылаем ping-пакет
    Memo1.Lines.Add('Пинг ' +
                    pHostEn^.h_name+' ['+
                    inet_ntoa(destAddress)+'] '+
                    ' with '+
                    IntToStr(sizeof(pingBuffer)) +
                    ' bytes of data:');
  for i:=1 to k do
    Begin
      IcmpSendEcho(hIP,
                   destAddress.S_addr,
                   @pingBuffer,
                   sizeof(pingBuffer),
                   pIinfo,
                   pIpe,
                   sizeof(icmp_echo_reply) + sizeof(pingBuffer),
                   1000);
      error := GetLastError();
      if (error <> 0) then
        begin
          FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,GetSystemDefaultLangID,lpMsgBuf,sizeof(lpMsgBuf),nil);
          Memo1.Lines.Add('Error ' + lpMsgBuf);
          Exit;
        end;
     // Смотрим некоторые из вернувшихся данных
      Memo1.Lines.Add('Ответ от '+LongToIp(pIpe^.Address)+' '+
                      'число байт: '+IntToStr(pIpe.DataSize)+' '+
                      'время: '+IntToStr(pIpe.RTTime)+' мс'+' '+
                      'TTL: '+IntToStr(pIpe.Options.Ttl));
    end;
 //   IcmpCloseHandle(hIP);
    WSACleanup();
    FreeMem(pIpe);
end;

end.
PM MAIL WWW ICQ   Вверх
hawkins
Дата 25.11.2006, 00:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 148
Регистрация: 8.9.2003

Репутация: нет
Всего: нет
Спасибо!!! Этот код в XP работает, буду разбираться где была ошибка... 
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0532 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.