|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Помогите с программой PING
Уже перебрал несколько вариантов пинга, но всюду ошибки....
При использовании компонента IdIcmpClient, если компьютер в сети выключен - выдет ошибку "Non-echo typr response received" и программа останавливается. Нашел еще один вариант реализации, но в нем использован компонент ICMP, и выдет ошибку File not found "Icmp.dcu". Пожалуйста помогите, может кто нибуть хоть что то посоветует. Вот первый вариант: Код:
function TForm1.Ping(const AHost : string; const ATimes : integer; out AvgMS:Double) : Boolean; var R : array of Cardinal; i : integer; begin Result := True; AvgMS := 0; if ATimes>0 then with TIdIcmpClient.Create(Self) do try Host := AHost; ReceiveTimeout:=999; //TimeOut du ping SetLength(R,ATimes); {Pinguer le client} for i:=0 to Pred(ATimes) do begin try Ping(); Application.ProcessMessages; //ne bloque pas l'application R[i] := ReplyStatus.MsRoundTripTime; except Result := False; Exit; end; if ReplyStatus.ReplyStatusType<>rsEcho Then result := False; //pas d'йcho, on renvoi false. end; {Faire une moyenne} for i:=Low(R) to High(R) do begin Application.ProcessMessages; AvgMS := AvgMS + R[i]; end; AvgMS := AvgMS / i; finally Free; end; end; Вот второй: Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, PingThrd; type TForm1 = class(TForm) doPing1: TButton; doExit: TButton; HostNames: TMemo; LogWindow: TMemo; doPingAll: TButton; doTrace: TButton; procedure doExitClick(Sender: TObject); procedure doPingClick(Sender: TObject); procedure doTraceClick(Sender: TObject); private { Private declarations } procedure PingThreadTermPing(Sender: TObject); procedure PingThreadTermTrace (Sender: TObject); public { Public declarations } end; const TraceMax = 32; MaxErrors = 8; var Form1: TForm1; TraceAddr: array [1..TraceMax] of string; Trace1st: integer; TraceErrs: integer; TraceIPAddr: string; TraceDoneFlag: boolean; RevLook1st: integer; StopFlag: boolean; PendingPings: integer; implementation {$R *.DFM} procedure TForm1.doExitClick(Sender: TObject); begin Close; end; procedure TForm1.PingThreadTermPing (Sender: TObject); const response1 = 'Thread %d for %s, %s' ; response2 = 'Thread %d for %s, received %d bytes from %s in %dms' ; var info: string; begin if Application.Terminated then exit ; begin with Sender as TPingThread do if ReplyTotal <> 0 then LogWindow.Lines.Add (Format (response2, [PingId, PingHostName, ReplyDataSize, ReplyIPAddr, ReplyRTT])) else LogWindow.Lines.Add (Format (response1, [PingId, PingHostName, ErrString])) ; end; end; procedure TForm1.doPingClick(Sender: TObject); var I, T: integer ; begin T := HostNames.Lines.Count ; if T = 0 then exit ; if Sender = doPing1 then T := 1 ; LogWindow.Lines.Add ('') ; for I := 0 to Pred (T) do begin if HostNames.Lines [i] <> '' then begin with TPingThread.Create (True) do begin PingAddThread (ThreadId) ; FreeOnTerminate := True; PingId := succ (I) ; OnTerminate := PingThreadTermPing ; response PingHostName := HostNames.Lines [i] ; address to ping PingTimeout := 4000 ; PingTTL := 32 ; PingLookupReply := false ; Resume ; end ; end; end ; end; procedure TForm1.PingThreadTermTrace (Sender: TObject); const response1 = 'Ping of %d bytes took %d msecs' ; response2 = '%2d %4d %-16s %s' ; var logline, addrstr: string ; I: integer ; begin if PendingPings > 0 then dec (PendingPings) ; if stopflag then exit ; if Application.Terminated then exit ; with Sender as TPingThread do begin if ErrCode <> 0 then begin if PingId = -1 then begin TraceIPAddr := DnsHostIP ; LogWindow.Lines.Add ('Can Not Ping Host (' + DnsHostIP + ') : ' + ErrString) ; exit ; end ; if TraceDoneFlag then exit ; logline := Format (response2, [PingId, 0, ' ', 'Request timed out']) ; inc (TraceErrs) ; if TraceErrs >= MaxErrors then begin LogWindow.Lines.Add ('Stopped Due to Excessive Errors') ; TraceDoneFlag := true ; end ; end else begin if PingId = -1 then begin TraceIPAddr := DnsHostIP ; LogWindow.Lines.Add (Format (response1, [ReplyDataSize, ReplyRTT])) ; exit ; end ; addrstr := ReplyIPAddr ; if addrstr <> '' then begin if TraceIPAddr = addrstr then TraceDoneFlag := true ; for I := 1 to TraceMax do begin if TraceAddr [i] = addrstr then exit ; end ; end ; TraceAddr [PingId] := addrstr ; logline := Format (response2, [PingId, ReplyRTT, addrstr, ReplyHostName]) ; end ; while LogWindow.Lines.Count <= (Trace1st + PingId) do LogWindow.Lines.Add ('') ; LogWindow.Lines [Trace1st + PingId] := TrimRight (logline) ; PingRemoveThread (PingThreadNum) ; end ; end ; procedure TForm1.doTraceClick(Sender: TObject); var newaddr, firstaddr, info, logline: string; I: integer; EndTimer, timeout: longword; threadnums: array of integer; begin if HostNames.Lines.Count = 0 then exit ; try try StopFlag := false ; TraceDoneFlag := false ; if HostNames.Lines [0] = '' then exit ; doTrace.Enabled := false ; doExit.Enabled := false ; newaddr := LongAddr2Dotted (HostNames.Lines [0]) ; LogWindow.Lines.Add ('') ; LogWindow.Lines.Add ('Trace Route to: ' + HostNames.Lines [0]) ; Trace1st := LogWindow.Lines.Count - 1 ; TraceErrs := 0 ; timeout := 4000 ; PendingPings := 0 ; SetLength (threadnums, TraceMax) ; for I := 1 to TraceMax do TraceAddr [i] := '' ; TraceIPAddr := '' ; with TPingThread.Create (True) do begin PingThreadNum := PingAddThread (ThreadId) ; threadnums [0] := PingThreadNum ; FreeOnTerminate := True; PingId := -1 ; OnTerminate := PingThreadTermTrace ; PingHostName := newaddr ; PingTimeout := timeout ; PingTTL := TraceMax ; PingLookupReply := false ; Resume ; inc (PendingPings) ; end; EndTimer := GetTickCount + timeout + 1000 ; while (PendingPings > 0) {and (NOT StopFlag)} do begin Application.ProcessMessages ; if GetTickCount > EndTimer then break ; end ; if TraceIPAddr = '' then exit ; Trace1st := LogWindow.Lines.Count - 1 ; for I := 1 to TraceMax do begin with TPingThread.Create (True) do begin PingThreadNum := PingAddThread (ThreadId) ; threadnums [pred (I)] := PingThreadNum ; FreeOnTerminate := True; PingId := I ; OnTerminate := PingThreadTermTrace ; PingHostName := TraceIPAddr ; PingTimeout := timeout ; // ms PingTTL := I ; // increasing for each hop PingLookupReply := true ; Resume ; // start it now inc (PendingPings) ; EndTimer := GetTickCount + 500 ; while (PendingPings > 0) do begin Application.ProcessMessages; if (GetTickCount > EndTimer) and (PendingPings < 6) then break; end ; if StopFlag then break; if TraceDoneFlag then break; end ; end ; EndTimer := GetTickCount + 30000 ; while (PendingPings > 0) and (NOT StopFlag) do begin Application.ProcessMessages ; if GetTickCount > EndTimer then break ; end ; if (PendingPings > 0) then begin for I := 1 to TraceMax do PingTerm1Thread (threadnums [pred (I)]); end ; if StopFlag then LogWindow.Lines.Add ('Stopped by User'); LogWindow.Lines.Add ('Trace Route Completed'); beep ; except LogWindow.Lines.Add ('Error Sending Pings'); beep ; end ; finally doTrace.Enabled := true; doExit.Enabled := true; end ; end; end. Последний раз редактировалось Admin, 31.03.2011 в 14:34. |
#2
|
|||
|
|||
Тоже писал программу пинг! Только массовый! Так IdICMP тоже выдаёт ошибку если компьютер не подключен к сети! Никак не поборал, да сильно и не старался! Просто воспользовался
Код:
Try Except End; |
#3
|
|||
|
|||
Подскажите еще пожалуйста, а как встоить "try except end;" в код програмы?
|
#4
|
|||
|
|||
Цитата:
И первая же ссылка |
#5
|
|||
|
|||
Прочитал, конечно же....
Перепробывал все варианты. Но все равно выдет ошибку. Хоть и сделал все как было написано... Може хоть кто нибуть подскажет где ошибка? Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, IdBaseComponent, IdComponent, IdRawBase, IdRawClient, IdIcmpClient, StdCtrls, jpeg, ExtCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; IdIcmpClient1: TIdIcmpClient; Image1: TImage; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; i : integer; a: array [1..32] of string; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin a[1]:= '10.105.127.69'; IdIcmpClient1 := TIdIcmpClient.Create(nil); IdIcmpClient1.Host := (a[1]); IdIcmpClient1.TTL := 128; IdIcmpClient1.ReceiveTimeout := 3000; try IdIcmpClient1.Ping; except end; If IdIcmpClient1.ReplyStatus.FromIpAddress <> IdIcmpClient1.Host Then Begin IdIcmpClient1.Free; Close; Exit; End; If IdIcmpClient1.ReplyStatus.FromIpAddress = IdIcmpClient1.Host Then Begin IdIcmpClient1.Free; Image1.Show; end; end; end. Последний раз редактировалось Admin, 04.04.2011 в 16:02. |
#6
|
|||
|
|||
этот кусок нужно тоже внести в TRY секцию (думаю что так)
Код:
If IdIcmpClient1.ReplyStatus.FromIpAddress <> IdIcmpClient1.Host Then Begin IdIcmpClient1.Free; Close; Exit; End; If IdIcmpClient1.ReplyStatus.FromIpAddress = IdIcmpClient1.Host Then Begin IdIcmpClient1.Free; Image1.Show; end; Код:
IdIcmpClient1.Free; взялся из неоткуда, ничего не прошу, помогаю просто так ICQ: 593977748 - стучать в случае КРАЙНЕЙ необходимости, ну, или если вы со Ставрополя |
#7
|
||||
|
||||
запусти не в режиме разработки, а уже скомпилированный екзешник
|
#8
|
|||
|
|||
Спасибо за ответы, перепробывал все - но все равно выдает ошибку "Non-echo type responsed recived"....
Уже даже и не знаю что делать.... Последний раз редактировалось geret, 04.04.2011 в 16:46. |