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

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

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

Вопрос задал: 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;

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}

 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;

 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

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

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

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