Пингуем (Ping) под Delphi - Delphi, Pascal, ObjectPascal - Программирование
Навигация по сайту
Сайт:

Дополнительно:

Файловый архив:

Каталог статей:

Форум:


Категории раздела
Delphi, Pascal, ObjectPascal [18]
Программирование на Delphi, Pascal, ObjectPascal
C, C++, C# [7]
Программирование на C, C++, C#
ПХП (PHP) [6]
Все что связано с программированием на PHP.
DirectX [0]
Программирование с использованием графического API DirectX
OpenGL [0]
Программирование с использованием графического API OpenGL
Работа с базами данных (БД) [0]
Работа с базами данных MySQL и т.д. Разработка, теории, алгоритмы.
Сетевое программирование [0]
Сетевое программирование, организация сетей.
Программирование игр [0]
Все что связано с программированием игр, организацией их разработки.
Работа с мультимедиа данными [0]
Загрузка, обработка, воспроизведение и все что связано со звуком и видео.
Работа с устройсвами ввода и вывода [0]
Программирование устройств ввода и вывода. Работа с геймпадом, рулем и многим другим.
Программирование HTML 5 игр [0]
Программирование HTML 5 игр, html верстка, JS (JavaScript)
Остальное [0]
Все остальное, что не попадает ни под одну категорию.

Мини-Опрос
Чему вы отдаете большее предпочтение?
Всего ответов: 416

Партнеры сайта
....

Пингуем (Ping) под Delphi

00:35
Протокол Ping предназначен для тестирования компьютерных соединений в Интернете путём посылки через протокол Internet Protocol (IP) по обределённому адресу сообщения и ожидания от него ответа.

ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.

Запускаем Delphi;

В Новом проекте добавляем в форму Tbutton, Tedit и
Tmemo;

Вставляем "winsock”;

объявляем структурку для IP-заголовка:

type IPINFO = record

Ttl : char;

Tos : char;

IPFlags : char;

OptSize : char;

Options : ^char;

end;

Объявляем структурку для хранения ICMP пакета:

type ICMPECHO = record

Source : longint;

Status : longint;

RTTime : longint;

DataSize : Shortint;

Reserved : Shortint;

pData : ^variant;

i_ipinfo : IPINFO;

end;

Объявляем функции и процедуры, которые мы будем вызывать из ICMP.DLL

TIcmpCreateFile =

function():integer;{$IFDEF WIN32} stdcall; {$ENDIF}

TIcmpCloseHandle =

procedure(var handle:integer);{$IFDEF WIN32} stdcall;{$ENDIF}

TIcmpSendEcho =

function(var handle:integer; endereco:DWORD; buffer:variant;

tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD;

tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

В Tbutton в событие Onclick вставляем следующий код:

procedure TForm1.Button1Click(Sender: TObject);

var

wsadt : wsadata;

icmp :icmpecho;

HNDicmp : integer;

hndFile :integer;

Host :PHostEnt;

Destino :in_addr;

Endereco :^DWORD;

IP : ipinfo;

Retorno :integer;

dwRetorno :DWORD;

x :integer;

IcmpCreateFile : TIcmpCreateFile;

IcmpCloseHandle : TIcmpCloseHandle;

IcmpSendEcho : TIcmpSendEcho;

begin

if (edit1.Text = '') then begin

Application.MessageBox('Enter a HostName ro a IP Adress',

'Error', MB_OK);

exit;

end;

HNDicmp := LoadLibrary('ICMP.DLL');

if (HNDicmp 0) then begin

@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');

@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');

@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');

if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or

(@IcmpSendEcho=nil) then begin

Application.MessageBox('Error getting ICMP Adress','Error', MB_OK);

FreeLibrary(HNDicmp);

end;

end;

Retorno := WSAStartup($0101,wsadt);

if (Retorno 0) then begin

Application.MessageBox('Can?t Load WinSockets','WSAStartup', MB_OK);

WSACleanup();

FreeLibrary(HNDicmp);

end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));

if (Destino.S_addr = 0) then begin

Host := GetHostbyName(PChar(Edit1.text));

end

else begin

Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);

end;

if (host = nil) then begin

Application.MessageBox('Host not found','Error', MB_OK);

WSACleanup();

FreeLibrary(HNDicmp);

exit;

end;

memo1.Lines.Add('Pinging ' + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();

for x:= 0 to 4 do begin

Ip.Ttl := char(255);

Ip.Tos := char(0);

Ip.IPFlags := char(0);

Ip.OptSize := char(0);

Ip.Options := nil;

dwRetorno := IcmpSendEcho(

HNDFile,

Endereco^,

null,

0,

Ip,

Icmp,

sizeof(Icmp),

DWORD(5000));

Destino.S_addr := icmp.source;

Memo1.Lines.Add('Ping ' + Edit1.text);

end;

IcmpCLoseHandle(HNDFile);

FreeLibrary(HNDicmp);

WSACleanup();

end;

У данного примера есть один недостаток - программа не воспримет доменное имя, только IP-адресс. Для пользователей NT не используйте функцию IcmpCloseHandle. Это всё.....

Ну и в конце полный исходный код примера:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

winsock, StdCtrls;

type

IPINFO = record

Ttl :char;

Tos :char;

IPFlags :char;

OptSize :char;

Options :^char;

end;

type

ICMPECHO = record

Source :longint;

Status :longint;

RTTime :longint;

DataSize:Shortint;

Reserved:Shortint;

pData :^variant;

i_ipinfo:IPINFO;

end;

TIcmpCreateFile =

function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}

TIcmpCloseHandle =

procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}

TIcmpSendEcho =

function(var handle:integer; endereco:DWORD; buffer:variant;

tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD;

tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

Edit1: TEdit;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

var

wsadt : wsadata;

icmp :icmpecho;

HNDicmp : integer;

hndFile :integer;

Host :PHostEnt;

Destino :in_addr;

Endereco :^DWORD;

IP : ipinfo;

Retorno :integer;

dwRetorno :DWORD;

x :integer;

IcmpCreateFile : TIcmpCreateFile;

IcmpCloseHandle : TIcmpCloseHandle;

IcmpSendEcho : TIcmpSendEcho;

begin

if (edit1.Text = '') then begin

Application.MessageBox('Digite um HostName ou um End. IP',

'Error', MB_OK);

exit;

end;

HNDicmp := LoadLibrary('ICMP.DLL');

if (HNDicmp 0) then begin

@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');

@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');

@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');

if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or

(@IcmpSendEcho=nil) then begin

Application.MessageBox('Erro pegando endereзos ICMP','Error', MB_OK);

FreeLibrary(HNDicmp);

end;

end;

Retorno := WSAStartup($0101,wsadt);

if (Retorno 0) then begin

Application.MessageBox('Nгo foi possнvel carregar WinSockets',

'WSAStartup',MB_OK);

WSACleanup();

FreeLibrary(HNDicmp);

end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));

if (Destino.S_addr = 0) then begin

Host := GetHostbyName(PChar(Edit1.text));

end

else begin

Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);

end;

if (host = nil) then begin

Application.MessageBox('Host nгo encontrado','Error', MB_OK);

WSACleanup();

FreeLibrary(HNDicmp);

exit;

end;

memo1.Lines.Add('Pinging ' + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();

for x:= 0 to 4 do begin

Ip.Ttl := char(255);

Ip.Tos := char(0);

Ip.IPFlags := char(0);

Ip.OptSize := char(0);

Ip.Options := nil;

dwRetorno := IcmpSendEcho(

HNDFile,

Endereco^,

null,

0,

Ip,

Icmp,

sizeof(Icmp),

DWORD(5000));

Destino.S_addr := icmp.source;

Memo1.Lines.Add('Pingou ' + Edit1.text);

end;

IcmpCLoseHandle(HNDFile);

FreeLibrary(HNDicmp);

WSACleanup();

end;

end.


Категория: Delphi, Pascal, ObjectPascal | Просмотров: 1638 | Добавил: ДядяВолк (11.08.2010) | Рейтинг: 0.0/0
Теги: (Ping), Пингуем, delphi, под
Источник: http://codenet.ru |
HTML ссылка на материал:
BB ссылка на материал:
Похожие материалы :
Возможно вам будет интересно:
Исключения в C++ (0)
Создание рикошета пуль от стены (4)
3d Rad - Про конструктор (0)
О игрострое, движках и людях (1)
Создание заставки (Intro) (0)
Создание наземного врага в платформере (2)
Создание текстовой игры (0)
Знакомство с Движком! (0)
Статья по движку Maratis (0)
Borland Assembler (BASM) уроки для начинающих (урок 6) (0)
То, что нужно знать всем, кто движется в сфере геймдева. (1)
Установка Yogurt3D и Adobe Stage3D API на ваш компьютер. (0)
3D Rad - небольшая статья. (2)
Переменные в ГМ (0)
PHP и MySQL – Теоретический курс. Введение. (2)
Всего комментариев: 1
1 DonReba   (13.12.2010 09:29)
Оформление кода просто ужасно. Дичайше не удобно читать

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Мы в социальных сетях

Поиск
Поиск по всему сайту:
Поиск по разделу:

Панель пользователя
Здравствуйте, Гость


Ник:
Пароль:
Запомнить :

Ваш IP: 50.16.17.16

Случайные конструкторы

Случайные движки

Случайные статьи

Статистика
Онлайн всего: 6
Гостей: 6
Пользователей: 0

На сайте были:
Конструктор , ZiP , Filinshein , FireOfSteel , buxdagger , SINILIAN , Joke_Jensen

При полном или частичном копировании материалов сайта ссылка на Make-Games.ru обязательна. Make-Games.ru © 2008 - 2016 Хостинг от uWeb
Топ Разработка игр Рейтинг@Mail.ru