[usfire]

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

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

Код:

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

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.

Код:

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

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.