помогите с потоком

← →
linuxoid (2010-07-19 09:38) [0]

Здравствуйте!
не могу разобраться с потоком.
хотел чтоб работала отдельно от основного кода, но не получается.

параллельно хочу запустить другие операции

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, winsock, stdctrls, ExtCtrls;

type
ip_option_information = packed record
Ttl : byte;
Tos : byte;
Flags : byte;
OptionsSize : byte;
OptionsData : Pointer;
end;

icmp_echo_reply = packed record
Address : u_long;
Status : u_long;
RTTime : u_long;

DataSize : u_short;
Reserved : u_short;
Data : Pointer;
Options : ip_option_information;
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;
IcmpCreateFile()
DestAddress : u_long;
RequestData : PVOID;
RequestSize : Word;
RequestOptns : PIPINFO;

ReplyBuffer : PVOID;
ReplySize : DWORD;
Timeout : DWORD
) : DWORD; stdcall; external "ICMP.DLL" name "IcmpSendEcho";

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

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(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;
i:integer;
adress : array [1..30] of pansichar;
begin
memo1.Clear;
// Ñîçäàåì 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);

adress[1]:="192.168.0.1";
adress[2]:="192.168.0.2";
adress[3]:="192.168.0.3";
adress[4]:="192.168.0.4";
adress[5]:="192.168.0.5";

for i:=1 to 5 do begin

pHostEn := gethostbyname(adress[i]);

destAddress := PInAddr(pHostEn^.h_addr_list^)^;

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

error := GetLastError();
if (error <> 0) then
begin
//Memo1.SetTextBuf("Error in call to "+
// "IcmpSendEcho()");
Memo1.Lines.Add(inet_ntoa(destAddress) +" Error code: "+IntToStr(error));
continue;
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");

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

end.

← →
И. Павел © (2010-07-19 09:46) [1]

Обработчик таймера работает в главном потоке. Создавайте потомка TThread.

← →
linuxoid (2010-07-19 09:56) [2]

> Обработчик таймера работает в главном потоке. Создавайте
> потомка TThread.

как это сделать. я с потоками впервые работаю...

← →
Anatoly Podgoretsky © (2010-07-19 10:01) [3]

А где потоки в примере?

← →
И. Павел © (2010-07-19 10:03) [4]

> как это сделать. я с потоками впервые работаю...

http://www.sdteam.com/?tid=386

← →
Dennis I. Komarov © (2010-07-19 10:06) [5]

> Anatoly Podgoretsky © (19.07.10 10:01) [3]

Их там нету, с ними и надо помочь... :)

← →
Leonid Troyanovsky © (2010-07-19 10:17) [6]

> И. Павел © (19.07.10 10:03) [4]

> http://www.sdteam.com/?tid=386

Не совсем удачный пример.

--
Regards, LVT.

← →
Плохиш © (2010-07-19 10:33) [7]

> Dennis I. Komarov © (19.07.10 10:06) [5]
> Их там нету, с ними и надо помочь...

Я правильно понимаю, помочь = дать код для копи/паста?

← →
Dennis I. Komarov © (2010-07-19 10:53) [8]

> Плохиш © (19.07.10 10:33) [7]

"А ты не умничай..."

← →
linuxoid (2010-07-19 10:55) [9]

пытаюсь поток создать не получается. может кто нить подсказать.

← →
Плохиш © (2010-07-19 10:56) [10]

> linuxoid (19.07.10 10:55) [9]
>
> пытаюсь поток создать не получается. может кто нить подсказать.
>

Подсказываю - неправильно создаёшь, прочитай инструкцию.

← →
И. Павел © (2010-07-19 11:00) [11]

> пытаюсь поток создать не получается. может кто нить подсказать.

Для Delphi 7: File->New->Other->Thread Object и писать в exceute то, что должен выполнять поток. Доступ к VCL оборачивать в synchronize.

← →
Dennis I. Komarov © (2010-07-19 11:17) [12]

> пытаюсь поток создать не получается...

а мы не видим

← →
brother © (2010-07-19 11:40) [13]

тебя чем вариант с таймером не устроил?
зы. имхо, говнокод...

← →
linuxoid (2010-07-19 12:25) [14]

> тебя чем вариант с таймером не устроил?

она параллельно не выполняет другие операции

← →
linuxoid (2010-07-19 12:53) [15]

> а мы не видим

unit Unit1;

interface

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

type
TThreadScan = class(TThread)
msg : string;
msg2 : string;
private
{ Private declarations }
protected
procedure Execute; override;
end;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

uses WinSock;

type
ip_option_information = packed record

Ttl : byte;
Tos : byte;
Flags : byte;
OptionsSize : byte;
OptionsData : Pointer;
end;

icmp_echo_reply = packed record
Address : u_long;
Status : u_long;
RTTime : u_long;

DataSize : u_short;
Reserved : u_short;
Data : Pointer;
Options : ip_option_information;
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;
IcmpCreateFile()
DestAddress : u_long;
RequestData : PVOID;
RequestSize : Word;
RequestOptns : PIPINFO;

ReplyBuffer : PVOID;
ReplySize : DWORD;
Timeout : DWORD
) : DWORD; stdcall; external "ICMP.DLL" name "IcmpSendEcho";

{$R *.dfm}
procedure TThreadScan.Execute;
var
hIP : THandle;
pingBuffer : array [0..31] of Char;
pIpe : ^icmp_echo_reply;
pHostEn : PHostEnt;
wVersionRequested : WORD;
lwsaData : WSAData;
error : DWORD;
destAddress : In_Addr;
i:integer;
adress : array [1..30] of pansichar;
IPReply: string;

begin

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

Exit;
end;

adress[1]:="192.168.0.1";
adress[2]:="192.168.0.2";
adress[3]:="192.168.0.3";
adress[4]:="192.168.0.4";
adress[5]:="192.168.0.5";
for i:=1 to 5 do begin

pHostEn := gethostbyname(adress[i]);
error := GetLastError();
if (error <> 0) then
begin

msg:=("Error code: "+IntToStr(error));
Exit;
end;

destAddress := PInAddr(pHostEn^.h_addr_list^)^;

// 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),
100);

error := GetLastError();
if (error <> 0) then
begin

msg:=("Error code: "+IntToStr(error));
continue;
end;

IPReply:=("Reply from "+
IntToStr(LoByte(LoWord(pIpe^.Address)))+"."+
IntToStr(HiByte(LoWord(pIpe^.Address)))+"."+
IntToStr(LoByte(HiWord(pIpe^.Address)))+"."+
IntToStr(HiByte(HiWord(pIpe^.Address))));
msg2:=("Reply time: "+IntToStr(pIpe.RTTime)+" ms");
end;
IcmpCloseHandle(hIP);
WSACleanup();
FreeMem(pIpe);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
////...
////...
////...
end;

end.

вот вроде создал поток. как теперь в баттоне запустить его?

← →
Anatoly Podgoretsky © (2010-07-19 12:56) [16]

> Dennis I. Komarov (19.07.2010 10:06:05) [5]

Неправда, цитата

> я с потоками впервые работаю

← →
Anatoly Podgoretsky © (2010-07-19 12:56) [17]

> Dennis I. Komarov (19.07.2010 10:53:08) [8]

Ты код давай.

← →
Anatoly Podgoretsky © (2010-07-19 12:57) [18]

> linuxoid (19.07.10 10:55) [9]

Ты код давай

← →
linuxoid (2010-07-19 13:03) [19]

> Ты код давай

см.15

← →
linuxoid (2010-07-19 13:03) [20]

Удалено модератором

← →
Dennis I. Komarov © (2010-07-19 13:07) [21]

> вот вроде создал поток. как теперь в баттоне запустить его?

Ткни пальцем, в каком месте его создал?

...
[11] читал, или это для Пушкина написали...

← →
linuxoid (2010-07-19 13:12) [22]

> type
> TThreadScan = class(TThread)
> msg : string;
> msg2 : string;
> private
> { Private declarations }
> protected
> procedure Execute; override;
> end;

← →
Dennis I. Komarov © (2010-07-19 13:15) [23]

> linuxoid (19.07.10 13:12) [22]

"И что это, что это за народное творчество?"

← →
linuxoid (2010-07-19 13:20) [24]

объявил, затем в Execute; закинул код которые должен выполняться...

← →
linuxoid (2010-07-19 13:22) [25]

или она обязательно должна выполняться в отдельном юните?

← →
Dennis I. Komarov © (2010-07-19 13:22) [26]

> linuxoid (19.07.10 13:20) [24]

А я просил показать, где создал

В статье [4] написано - как запустить поток... Строчка прямо под комментарием: {Создаем и сразу запускаем два процесса}.

> или она обязательно должна выполняться в отдельном юните?

нет, но считай что да...

← →
linuxoid (2010-07-19 13:31) [29]

> А я просил показать, где создал

TThreadScan.Create(false);

> linuxoid (19.07.10 13:31) [29]

Это не твой код...

← →
linuxoid (2010-07-19 13:37) [31]

> то не твой код...

ну и как сделать тада?

> ну и как сделать тада?

Чего как, делай давай...
или [29] у тебя где-то в коде нарисовано?

← →
linuxoid (2010-07-19 13:54) [33]

на форме прописал его.

procedure TForm1.FormCreate(Sender: TObject);
begin
TThreadScan.Create(false);
end;

а вот остальное понять не могу.
как добавлять в мемо и т д.

> type
> TForm1 = class(TForm)
> Memo1: TMemo;
> Button1: TButton;
> procedure Button1Click(Sender: TObject);

не было такого...

← →
linuxoid (2010-07-19 14:06) [35]

> не было такого...

это был прежний код. потом изменил я

> это был прежний код. потом изменил я

И что с этого? Я кофе не пью - жарко...

← →
linuxoid (2010-07-19 14:38) [37]

> И что с этого? Я кофе не пью - жарко...

я вообще не понимаю смысл ваших слов.

у мя есть код, который хотел бы одновременно запустить.
как мне то реализовать.
я в этом толк не имею. а то что вы спрашиваете, не могу понять...

может опишите .......

Чего же тут не понятного? Ну откуда я знаю что где кто поменял.

помогите с потоком Найти похожие ветки