[usfire]

https://drive.google.com/open?id=1DG...wn0bwuU3TL6vMR

https://drive.google.com/open?id=1vs...iCun2IH2ZOhw4q

Код:

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, WinSock, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type 
     ip_option_information = packed record  // Информация заголовка IP (Наполнение 
                     // этой структуры и формат полей описан в RFC791. 
         Ttl : byte;         // Время жизни (используется traceroute-ом) 
         Tos : byte;         // Тип обслуживания, обычно 0 
         Flags : byte;       // Флаги заголовка IP, обычно 0
         OptionsSize : byte;     // Размер данных в заголовке, обычно 0, максимум 40 
         OptionsData : Pointer;  // Указатель на данные 
     end; 

    icmp_echo_reply = packed record 
         Address : u_long;            // Адрес отвечающего 
         Status : u_long;             // IP_STATUS (см. ниже) 
         RTTime : u_long;             // Время между эхо-запросом и эхо-ответом 
                          // в миллисекундах 
         DataSize : u_short;              // Размер возвращенных данных 
         Reserved : u_short;              // Зарезервировано 
         Data : Pointer;          // Указатель на возвращенные данные 
         Options : ip_option_information; // Информация из заголовка IP 
     end; 

     PIPINFO = ^ip_option_information; 
     PVOID = Pointer; 

         function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile'; 
         function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle'; 
         function IcmpSendEcho( 
                           IcmpHandle : THandle;    // handle, возвращенный IcmpCreateFile() 
                           DestAddress : u_long;    // Адрес получателя (в сетевом порядке) 
                           RequestData : PVOID;     // Указатель на посылаемые данные 
                           RequestSize : Word;      // Размер посылаемых данных 
                           RequestOptns : PIPINFO;  // Указатель на посылаемую структуру 
                                                // ip_option_information (может быть nil) 
                           ReplyBuffer : PVOID;     // Указатель на буфер, содержащий ответы. 
                           ReplySize : DWORD;       // Размер буфера ответов 
                           Timeout : DWORD          // Время ожидания ответа в миллисекундах
                          ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';  

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var 
     hIP : THandle; 
     pingBuffer : array [0..31] of Char; 
     pIpe : ^icmp_echo_reply; 
     pHostEn : PHostEnt; 
     wVersionRequested : WORD; 
     lwsaData : WSAData; 
     error : DWORD; 
     destAddress : In_Addr; 
 begin 
     
     // Создаем handle 
     hIP := IcmpCreateFile(); 
     
     GetMem( pIpe, 
             sizeof(icmp_echo_reply) + sizeof(pingBuffer)); 
     pIpe.Data := @pingBuffer; 
     pIpe.DataSize := sizeof(pingBuffer); 

     wVersionRequested := MakeWord(1,1); 
     error := WSAStartup(wVersionRequested,lwsaData); 
     if (error <> 0) then 
     begin 
          Memo1.SetTextBuf('Error in call to '+'WSAStartup().');
          Memo1.Lines.Add('Error code: '+IntToStr(error));
          Exit; 
     end; 
     
     pHostEn := gethostbyname('ya.ru'); 
     error := GetLastError(); 
     if (error <> 0) then 
     begin 
          Memo1.SetTextBuf('Error in call to'+ 
                           'gethostbyname().'); 
          Memo1.Lines.Add('Error code: '+IntToStr(error)); 
          Exit; 
     end; 
       
      destAddress := PInAddr(pHostEn^.h_addr_list^)^; 

       // Посылаем ping-пакет 
     Memo1.Lines.Add('Pinging ' + 
                     pHostEn^.h_name+' ['+ 
                     inet_ntoa(destAddress)+'] '+ 
                     ' with '+ 
                     IntToStr(sizeof(pingBuffer)) + 
                     ' bytes of data:'); 

     IcmpSendEcho(hIP, 
                  destAddress.S_addr, 
                  @pingBuffer, 
                  sizeof(pingBuffer), 
                  Nil, 
                  pIpe, 
                  sizeof(icmp_echo_reply) + sizeof(pingBuffer), 
                  5000); 

     error := GetLastError(); 
     if (error <> 0) then 
     begin 
          Memo1.SetTextBuf('Error in call to '+ 
                           'IcmpSendEcho()'); 
          Memo1.Lines.Add('Error code: '+IntToStr(error)); 
          Exit; 
     end; 

      // Смотрим некоторые из вернувшихся данных 
     Memo1.Lines.Add('Reply from '+ 
                 IntToStr(LoByte(LoWord(pIpe^.Address)))+'.'+ 
                 IntToStr(HiByte(LoWord(pIpe^.Address)))+'.'+ 
                 IntToStr(LoByte(HiWord(pIpe^.Address)))+'.'+ 
                 IntToStr(HiByte(HiWord(pIpe^.Address)))); 
     Memo1.Lines.Add('Reply time: '+IntToStr(pIpe.RTTime)+' ms'); 

     IcmpCloseHandle(hIP); 
     WSACleanup(); 
     FreeMem(pIpe);
end;

end.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, XPMan, ComCtrls,WinSock;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Memo2: TMemo;

    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
potok = class(TThread) //Этой строкой мы унаследовали класс потока
  private
   str: string;//в разделе private описываются переменные с помощью которых мы
   nomer : Integer;//будем передавать значения между процедурами внутри потока
  protected
    procedure Execute; override;//это главная процедура потока, она начинает свою работу
//после того как мы создали поток
  public
    procedure synchro;//в разделе public вы можете объявить процедуры какие только душе
//угодно
    constructor Create(CreateSuspended: Boolean);//эта строка говорит о том, что мы в
//implementation опишем конструкцию
//потока
  end;

var
a: array [1..10] of potok;
  Form1: TForm1;
   nom:integer;
implementation
constructor potok.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);//Эта строка говорит о том, что поток после создания
//будет приостановлен если ему передать значение true при создание, если false, то сразу
//начнёт работу.
end;
{$R *.dfm}
type
    ip_option_information = packed record  // Информация заголовка IP (Наполнение 				    // этой структуры и формат полей описан в RFC791.
        Ttl : byte;			// Время жизни (используется traceroute-ом)	
        Tos : byte;			// Тип обслуживания, обычно 0
        Flags : byte;		// Флаги заголовка IP, обычно 0
        OptionsSize : byte;		// Размер данных в заголовке, обычно 0, максимум 40
        OptionsData : Pointer;	// Указатель на данные 
    end;

   icmp_echo_reply = packed record
        Address : u_long; 	    	 // Адрес отвечающего
        Status : u_long;	    	 // IP_STATUS (см. ниже)
        RTTime : u_long;	    	 // Время между эхо-запросом и эхо-ответом 
				         // в миллисекундах
        DataSize : u_short; 	    	 // Размер возвращенных данных
        Reserved : u_short; 	    	 // Зарезервировано
        Data : Pointer; 		 // Указатель на возвращенные данные
        Options : ip_option_information; // Информация из заголовка IP
    end;

    PIPINFO = ^ip_option_information;
    PVOID = Pointer;

        function IcmpCreateFile() : THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
        function IcmpCloseHandle(IcmpHandle : THandle) : BOOL; stdcall; external 'ICMP.DLL'  name 'IcmpCloseHandle';
        function IcmpSendEcho(// handle, возвращенный IcmpCreateFile()
                          DestAddress : u_long;    
                          RequestData : PVOID;    
                          RequestSize : Word;      // Размер посылаемых данных
                          RequestOptns : PIPINFO;  // Указатель на посылаемую структуру 
                       		                   // ip_option_information (может быть nil)
                          ReplyBuffer : PVOID;     // Указатель на буфер, содержащий ответы.
                          ReplySize : DWORD;       // Размер буфера ответов 
                          Timeout : DWORD          // Время ожидания ответа в миллисекундах
                         ) : DWORD; stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';


procedure TForm1.Button1Click(Sender: TObject);
var
pot:integer;
begin
for pot:=1  to 10 do  //цикл запускает 10 потоков, которые будут изменять заголовок
  a[pot]:=potok.Create(false); //формы, так же идёт добавление в массив, что бы потом вы могли их уничтожить по одному.

 //  Ping('127.0.0.1', Memo1);
  end;

procedure potok.Execute;//начинаем описывать главную процедуру потока
var
I:integer;
begin
for i:=0 to 100 do
begin
sleep(1000);
synchronize(synchro);//этой строкой мы вызываем процедуру synchro в единичном экземпляре
end;
end;

procedure potok.synchro; //описываем ещё одну процедуру потока, которая будет менять
//загаловок form1
begin
inc(nom);
//form1.Caption:=' '+inttostr(nom);

//Form1.Memo1.Lines.Add(inttostr(nom));

// Ping(form1.memo2.lines.strings[0], form1.Memo1);

end;


end.