Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

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

Страницы: < 1 2
linuxoid © (2010-07-19 09:38:00)
Здравствуйте!
не могу разобраться с потоком.
хотел чтоб работала отдельно от основного кода, но не получается.

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

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.

Anatoly Podgoretsky (2010-07-19 12:57:00) [21]

> linuxoid (19.07.10 10:55) [9]

Ты код давай

Anatoly Podgoretsky (2010-07-19 12:56:00) [22]
> Dennis I. Komarov (19.07.2010 10:53:08) [8]

Ты код давай.

Anatoly Podgoretsky (2010-07-19 12:56:00) [23]
> Dennis I. Komarov (19.07.2010 10:06:05) [5]

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

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

linuxoid (2010-07-19 12:53:00) [24]

> а мы не видим

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.

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

linuxoid (2010-07-19 12:25:00) [25]

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

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

brother (2010-07-19 11:40:00) [26]
тебя чем вариант с таймером не устроил?
зы. имхо, говнокод...

Dennis I. Komarov (2010-07-19 11:17:00) [27]

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

а мы не видим

И. Павел (2010-07-19 11:00:00) [28]
> пытаюсь поток создать не получается. может кто нить подсказать.

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

Плохиш (2010-07-19 10:56:00) [29]

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

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

linuxoid (2010-07-19 10:55:00) [30]
пытаюсь поток создать не получается. может кто нить подсказать.

Dennis I. Komarov (2010-07-19 10:53:00) [31]

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

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

Плохиш (2010-07-19 10:33:00) [32]

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

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

Leonid Troyanovsky (2010-07-19 10:17:00) [33]

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

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

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

--
Regards, LVT.

Dennis I. Komarov (2010-07-19 10:06:00) [34]

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

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

И. Павел (2010-07-19 10:03:00) [35]
> как это сделать. я с потоками впервые работаю...

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

Anatoly Podgoretsky (2010-07-19 10:01:00) [36]
А где потоки в примере?

linuxoid (2010-07-19 09:56:00) [37]

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

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

И. Павел (2010-07-19 09:46:00) [38]
Обработчик таймера работает в главном потоке. Создавайте потомка TThread.

Страницы: < 1 2

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »