[Admin]

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153

(*   Simple web server exemple     tdjprog 1998 - 2015   tdjprog@yahoo.fr *)   unit Main;   interface   uses   Windows, Messages, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,   SysUtils, Classes, IdIcmpClient, IdBaseComponent, IdComponent, IdRawBase, IdRawClient;     type   TfrmPing = class(TForm)     Panel1: TPanel;     btPing: TButton;     mReplies: TMemo;     btStop: TButton;     edHosts: TEdit;     procedure btPingClick(Sender: TObject);     procedure btStopClick(Sender: TObject);   private     procedure OnThreadPingTerminate(Sender: TObject);   public   end;     TPing = class (TThread)   private     FPing: TIdIcmpClient;     FPingResult: String;       function GetPHost: String;     procedure PingReplay(ASender: TComponent; const ReplyStatus: TReplyStatus);   protected     procedure DoPingHost;     procedure Execute; override;   public     constructor Create(const PAddr: String; OnTerminateEvent: TNotifyEvent);     destructor Destroy; override;       property PResults: String read FPingResult;     property PHost: String read GetPHost;   end;   var   frmPing: TfrmPing;   StopThreads: Boolean = False;   implementation {$R *.DFM}   function TPing.GetPHost: String; begin   Result:= '';   if Assigned(FPing) then     Result:= FPing.Host; end;   procedure TPing.PingReplay(ASender: TComponent; const ReplyStatus: TReplyStatus); var   sTime: string; begin           // TODO: check for error on ping reply (ReplyStatus.MsgType?)   if (ReplyStatus.MsRoundTripTime = 0) then     sTime := '<1'   else     sTime := '=';     FPingResult:= Format('%s%d bytes from %s: icmp_seq=%d ttl=%d time%s%d ms',                       [FPingResult,                        ReplyStatus.BytesReceived,                        ReplyStatus.FromIpAddress,                        ReplyStatus.SequenceId,                        ReplyStatus.TimeToLive,                        sTime,                        ReplyStatus.MsRoundTripTime]) + #13#10; end;   constructor TPing.Create(const PAddr: String; OnTerminateEvent: TNotifyEvent); begin   inherited Create(True);       FreeOnTerminate      := True;   OnTerminate          := OnTerminateEvent;     FPing                := TIdIcmpClient.Create(nil);   FPing.ReceiveTimeout := 1000;   FPing.Host           := PAddr;   FPing.OnReply        := PingReplay;   //FAddr                := PAddr;   FPingResult          := ''; end;   destructor TPing.Destroy; begin   if Assigned(FPing) then     FPing.Free;         inherited Destroy; end;   procedure TPing.DoPingHost; begin   FPing.Ping;   Application.ProcessMessages; end;   procedure TPing.Execute; var i: Byte; begin   i:= 1;   while (i <= 4) and (not Terminated) and (not StopThreads) do   begin     Synchronize(DoPingHost);     Inc(i);   end; end;   procedure TfrmPing.OnThreadPingTerminate(Sender: TObject); begin   with (Sender as TPing) do   begin     mReplies.Lines.Add(Format('Host [%s]', [PHost]));     mReplies.Lines.Add(Format('%s', [PResults]));   end; end;   procedure TfrmPing.btPingClick(Sender: TObject); var i: Integer; begin   StopThreads:= False;   for i:= 210 to 230 do   begin     if StopThreads then       Break;       with TPing.Create(Format(edHosts.Text, [i]), OnThreadPingTerminate) do       Resume;       Application.ProcessMessages;   end; end;   procedure TfrmPing.btStopClick(Sender: TObject); begin   StopThreads:= True; end;   end.

Автор: cs_AccessToYou
Ссылка: http://codes-sources.commentcamarche...101103/1374211