PDA

Просмотр полной версии : Многопоточность с использованием CreateThread [Delphi]


GlooK
24.10.2009, 05:09
Нужна помощь в понимании потоков :)

До этого момента писал софт однопоточный. Сейчас хочу научиться писать многопоточные программы.

Как я понимаю есть несколько реализаций. Знаю что можно написать используя класс TThread и CreateThread (или как пишут, правильней через BeginThread).

Интересует именно CreateThread.

Есть например такой код:

program threads;

{$APPTYPE CONSOLE}

uses
SysUtils,
WinSock;

const
mstimeout = 10000;
buffsize = 1024;

var
hSocket: TSocket;
FData: string;

function fWSRecv(wHost, wRequest: string):string;
var
wsData: TWSAData;
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hData: string;
hBuffer: array[0..buffsize] of char;
begin
WSAStartup($202, wsData);
hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
hData := '';
Send(hSocket, wRequest[1], length(wRequest), 0);
while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;
CloseSocket(hSocket);
WSACleanup;
result := hData;
end;

begin

FData := fWSRecv('google.ru',
'GET /search?q=abc' + #13#10 +
'Host: google.ru' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10);

Writeln;
Writeln('Done!');
readln;
end.


Как сделать его многопоточным?

Я попробовал так:

program threads;

{$APPTYPE CONSOLE}

uses
SysUtils,
WinSock,
Windows;

const
mstimeout = 10000;
buffsize = 1024;

var
hSocket: TSocket;
FData: string;
wsData: TWSAData;
idThread: integer;
HThread: array[0..20] of THandle;

function fWSRecv(wHost, wRequest: string):string;
var
hHost: PHostEnt;
hAddr: TSockAddrIn;
hTimeout: TTimeVal;
iRead: integer;
hData: string;
hBuffer: array[0..buffsize] of char;
begin

hSocket := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
hHost := gethostbyname(PChar(wHost));
hAddr.sin_family := AF_INET;
hAddr.sin_port := htons(80);
hAddr.sin_addr := pinaddr(hHost^.h_addr^)^;
hTimeout.tv_usec := 0;
hTimeout.tv_sec := mstimeout;
setsockopt(hSocket, SOL_SOCKET, SO_RCVTIMEO, @hTimeout, sizeof(ttimeval));
connect(hSocket, hAddr, SizeOf(hAddr));
hData := '';
Send(hSocket, wRequest[1], length(wRequest), 0);
while (TRUE) do
begin
FillChar(hBuffer, SizeOf(hBuffer), 0);
iRead := Recv(hSocket, hBuffer, length(hBuffer), 0);
hData := hData + copy(hBuffer, 0, iRead);
if (iRead <= 0) then break;
end;
CloseSocket(hSocket);
result := hData;
end;

function fThread(ptr: pointer):integer;
begin
FData := fWSRecv('google.ru',
'GET /search?q=abc' + #13#10 +
'Host: google.ru' + #13#10 +
'User-Agent: Mozilla/5.0' + #13#10 +
'Accept: text/html' + #13#10 +
'Accept-Language: ru' + #13#10 +
'Accept-Charset: windows-1251' + #13#10 +
'Connection: close' + #13#10#13#10);
ExitThread(0);
result := 0;
end;

begin
WSAStartup($202, wsData);

for idThread := 0 to 10 do
HThread[idThread] := CreateThread(nil, 0, @fThread, nil, 0, HThread[idThread]);

//WSACleanup;
Writeln;
Writeln('Done!');
readln;
end.

Но запросы не отправляются.
Имеет ли вообще данный код право на жизнь?
Можно ли так свободно использовать функции в потоке?
Если есть, дайте линки на исходники программ с использованием Winsock + CreateThread.

Espectro
24.10.2009, 15:51
держи
http://forum.sources.ru/index.php?showtopic=255212

slesh
24.10.2009, 17:23
код почти нормальный, но
1) если ты ничего больше с потоками делать не будешь, то сразу закрывай дискриптор потока, а не храни его в массиве
2) прототип функции которая вызывает в потоке чуть другой.
т.е. не function fThread(ptr: pointer):integer;
а function fThread(ptr: pointer):dword; stdcall;
3) после запуска потоков ты должен дождаться их завершения
в твоем случае потоки запустятся, но прога сразу же завершит свою работу.
Для таких вещей можно заюзать функцию WaitForMultipleObjects которая имеет вид;
DWORD WaitForMultipleObjects(
DWORD nCount, // кол-во хендлов
const HANDLE* lpHandles, // адрес массива с хендлами
BOOL bWaitAll, // TRUE - ожидать завершения всех, FALSE - хотябы одного
DWORD dwMilliseconds // таймаут. ставиш INFINITE - бесконечно.
);

GlooK
25.10.2009, 00:07
код почти нормальный, но
1) если ты ничего больше с потоками делать не будешь, то сразу закрывай дискриптор потока, а не храни его в массиве
2) прототип функции которая вызывает в потоке чуть другой.
т.е. не function fThread(ptr: pointer):integer;
а function fThread(ptr: pointer):dword; stdcall;
3) после запуска потоков ты должен дождаться их завершения
в твоем случае потоки запустятся, но прога сразу же завершит свою работу.
Для таких вещей можно заюзать функцию WaitForMultipleObjects которая имеет вид;
DWORD WaitForMultipleObjects(
DWORD nCount, // кол-во хендлов
const HANDLE* lpHandles, // адрес массива с хендлами
BOOL bWaitAll, // TRUE - ожидать завершения всех, FALSE - хотябы одного
DWORD dwMilliseconds // таймаут. ставиш INFINITE - бесконечно.
);

1. Как закрыть дескриптор потока?
2. Функция WaitForMultipleObjects должна выглядить так:
WaitForMultipleObjects(количество_акт ивных_потоков, HThread, TRUE, INFINITE)?
Так? т.е. количество активных потоков в моем примере 10.
Я правильно понял?

slesh
25.10.2009, 10:48
1) CloseHandle - но т.к. ты юзаеш WaitForMultipleObjects то толжен делать после него закрытие.
2) WaitForMultipleObjects вроде правильно

mr. ZetRikS
25.10.2009, 17:46
http://narod.ru/disk/14455913000/%D0%BF%D0%BE%D1%82%D0%BE%D0%BA%D0%B8.rar.html

Вот исходничек... я когда то программил... помоему то, что нужно...
Асинхронная работа...

>>serhio<<
25.10.2009, 19:26
Плз отредактируйте две задачки на Pascale, а то постоянные ошибки достали:(!!!

program chast1;
uses crt;
var a,y,x: real;
b:=Pi;
c:=2*Pi;
dety:=Pi/4;
y:=b;
while y < = c do
begin
x:=1-2*cos(a*y)+ln(y);
a:=ln(y)/ln(2);
writeln(y,x,a);
y:=y+dety;
end;
readln;
end.

program chast2;
x,y,a,b,c,dety:real;
i,n:integer
begin
b:=pi;
c:=2*pi;
det y:=pi/4;
n:=trune ((c-b)/det y);
for i:=0 to n do
begin
y:=b+(dety*i);
a:=logln(y)/ln(2);
x:=1-2*cos(a*y)+ln(y);
writeln(x,a,y);
end;
readln;
end.