Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 1 045

/ вопрос открыт /

Здравствуйте!
Я так долго старался но у меня не получается. Если Вам не трудно уважаемые Ехперты отправьте мне исходник. Кароче...
У меня часто проблема с сетью и у меня много айпи-ов чтобы каждого по отдельности пинговать. Как сделать чтобы я ввел в Edit1 айпи например 192.168.1.1 -t то в Мемо1 он показал бы вточь-вточь похожую на пинг кторую на стандартном командном строке.
Если Вам не трудно уважаемые Ехперты то отправьте исходник на почту mehroj-1@mail.ru
C уважением Мехродж.

POWER Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: POWER (статус: Посетитель)
Вопрос отправлен: 28 октября 2007, 19:38
Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Feniks

Здравствуйте, POWER!
Навряд ли тут кто-то будет польностью писать за Вас всю программу, а вот наставить на путь истинный – это запросто ;-)

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

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

Вариант 1.

// Запуск консольного приложения и перехват вывода
procedure ExecCmdine(const CmdLine: string; CmdResult: TStrings);
var
Output: PIOFile;
Buffer: PChar;
TempString: string;
Line: string;
BytesRead: Integer;

const
BufferSize: Integer = 1000;

begin
Output := popen(PChar(CmdLine), 'r');
GetMem(Buffer, BufferSize);
if Assigned(Output) then
try
while feof(Output) = 0 do
begin
BytesRead := Libc.fread(Buffer, 1, BufferSize, Output);
SetLength(TempString, Length(TempString)+BytesRead);
memcpy(@TempString[length(TempString)-(BytesRead-1)], Buffer, BytesRead);
while Pos(#10, TempString) > 0 do
begin
Line := Copy(TempString, 1, Pos(#10, TempString)-1);
if CmdResult<>nil then CmdResult.Add(Line);
TempString := copy(TempString, Pos(#10, TempString)+1, Length(TempString));
end;
end;
finally
Libc.pclose(output);
wait(nil);
FreeMem(Buffer,BufferSize);
end;
end;

Function Ping(host:string):boolean;
var params, CommandLine:string;
t:TStringList;
i:integer;
begin
Params := Format('-s%d ', [32]);
Params := Params+Format('-c%d ', [1]);
CommandLine := Format('ping %s%s', [Params, host]);
t:=TStringList.Create;
ExecCmdine(CommandLine, t);
Result:=pos('1 received, 0% packet loss', t.text)>0;
t.free;
end;


Примечание - под отладчиком Kylix код может не работать. Надо запускать приложение не под Kylix для того чтобы удостовериться что код работает.

Вариант 2.

1. Запускаем Delphi;
2. В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
3. Вставляем "winsock";
4. объявляем структурку для IP-заголовка:
type
IPINFO = record
Ttl: char;
Tos: char;
IPFlags: char;
OptSize: char;
Options: ^char;
end;


5. объявляем структурку для хранения ICMP пакета:
type
ICMPECHO = record
Source: longint;
Status: longint;
RTTime: longint;
DataSize: Shortint;
Reserved: Shortint;
pData: ^variant;
i_ipinfo: IPINFO;
end;


6. Объявляем функции и процедуры, которые мы будем вызывать из 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}


7. В 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.

Ответ отправил: Feniks (статус: Бакалавр)
Время отправки: 30 октября 2007, 15:07


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 26 сентября 2018, 09:53
Выполнено за 0.06 сек.
Рейтинг@Mail.ru