VPF::Проблема с многопоточным доступом к TStringList

Alkash

Дата 26.4.2012, 10:11 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

Рад приветствовать Вас, господа. Пишу многопоточный чекер, в программе - я загоняю список в формате ip:port - в TStringList, затем создаю потоки для проверки:

Код


setlength(CheckThread,threads);
   {the number of currently active threads set to zero}
   threads_alive:=0;
   {create threads}
   for counter:=0 to threads-1 do CheckThread[counter] := TCheckThread.Create;
   {wait until they have fulfilled all we have created a multithreaded}

   while threads_alive<>0 do Application.ProcessMessages();

каждый поток работает следующим образом:

Код


TCheckThread = class(TThread)
     public
        constructor Create(); overload;
     protected
        procedure Execute; override;
     end;
***********

constructor TCheckThread.Create;
begin
   Create(false);
   FreeOnTerminate := True;
   Priority := tpLower;
end;

procedure TCheckThread.Execute;
var
 s: TSOCKET;
 addr: sockaddr_in;
 sendbuff, ip, port, str, reply, item: string;
 i: integer;//counter
 g: integer;//good counter
begin
 g:=0;
 i:=0;
 InterlockedIncrement(threads_alive);
 Form2.ProgressBar1.Min := 0;
 Form2.ProgressBar1.Max := ProxyList.Count;
 Form2.lblCount.Caption:=inttostr(ProxyList.Count);
 Form2.lblGood.Caption:=inttostr(g);
 //for i:= 0 to (ProxyList.Count - 1) do
 for item in ProxyList do
  begin
     i:=i+1;
     cs0.Enter;
     str:= item;
      form2.lblT.Caption:=inttostr(threads_alive);
     cs0.Leave;
     ip:=copy(str,0,pos(':',str)-1);
     port:=copy(str,pos(':',str)+1,length(str)-pos(':',str));
     {if in the end of the line there are spaces - remove them}
     while pos(' ',port)<>0 do setlength(port,length(port)-1);
     {create socket}
     s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
     FillChar(addr, SizeOf(sockaddr_in), 0);
     addr.sin_family:=AF_Inet;
     addr.sin_port:=htons(strtoint(port));
     addr.sin_addr.S_addr:=inet_addr(PAnsiChar(ip));
     {connect}
     Connect(S,addr,SizeOf(TSockAddr));
     sendbuff := 'GET / HTTP/1.1'+ #13#10 +
                 'Host: google.com'+ #13#10#13#10;
     {send query}
     send(s, sendbuff[1] , Length(sendbuff), 0);
     {read answer}
     reply:=recvdata(s);
     {close socket}
     closesocket(s);

     cs0.Enter;
     Form2.logmemo.Lines.Add('get:'+#13+reply+'from:'+#13+ip);
     Form2.lblChecked.Caption:=IntToStr(i+1);
     Form2.ProgressBar1.Position:= i;
     cs0.Leave;

    {If the answer is the correct line to us - we finish the list of "good"
      ip and port used by proxy
      (using a critical section)}
     if pos('<html>',reply)<>0 then
     begin
        cs1.Enter;
          g:=g+1;
          Form2.lblGood.Caption:=inttostr(g);
          append(good);
          writeln(good,ip+':'+port);
          try
          closefile(good);
          finally;
          end;
        cs1.Leave;
     end;
  end;
{reduce the count of unfinished (active) threads at 1}
InterlockedDecrement(threads_alive);
Form2.ProgressBar1.Position:=0;
end;

Так вот, проблема заключается в том, в методе execute - как я только не организовывал цикл, программа при работе допустим в 30 потоков - прогоняет 1 и тот же элемент списка.
Например на вход даю TStringList с:

Код


 94.78.100.58:8080
 180.243.252.94:8080

и запустив в 3 потока на выходе получаю:

Код


get:
from:
 94.78.100.58
get:
from:
 94.78.100.58
get:
from:
 94.78.100.58
get:
from:
 180.243.252.94
get:
from:
 180.243.252.94
get:
from:
 180.243.252.94

Вопрос заключается в том - как собственно разрешить данный затык.

--------------------

Подпись >> /dev/null

MetalFan

Дата 26.4.2012, 10:26 (ссылка)

(голосов:1)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

Мда. Рекомендую "выкинуть" данный код.
А затем пойти читать до просветления: Многопоточность - как это делается в Дельфи. Не используйте потоки, не прочитав это

--------------------

There are always someone smarter than you...

Alkash

Дата 27.4.2012, 10:26 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

Почитал....подумал....допилил следующим образом:

Код


type
  TCheckThread = class(TThread)
    protected
        procedure UpdateCounters;
        Procedure InitCounters;
        procedure UpdateThreads;
        procedure Execute; override;
     private
     public
        s: TSOCKET;
        addr: sockaddr_in;
        sendbuff, ip, port, str, reply: string;
        i: integer;//counter
        g: integer;//good counter
        constructor Create(); overload;

     end;
*****
{ TCheckThread }

constructor TCheckThread.Create;
begin
   Create(false);
   FreeOnTerminate := True;
   Priority := tpLower;
  // Resume;
end;

procedure TCheckThread.Execute;
var
curitem: integer;
begin
 InterlockedIncrement(threads_alive);
  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;
  while Work do
   begin
 if item<ProxyList.Count then curitem:=item else work:= false;
 //for i:= 0 to (ProxyList.Count - 1) do
 if Work = true then
  begin
    // i:=i+1;
     cs0.Enter;
     str:= ProxyList.Strings[item];
     inc(item);
     cs0.Leave;
   //  synchronize();
     ip:=copy(str,0,pos(':',str)-1);
     port:=copy(str,pos(':',str)+1,length(str)-pos(':',str));
     {if in the end of the line there are spaces - remove them}
     while pos(' ',port)<>0 do setlength(port,length(port)-1);
     {create socket}
     s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
     FillChar(addr, SizeOf(sockaddr_in), 0);
     addr.sin_family:=AF_Inet;
     addr.sin_port:=htons(strtoint(port));
     addr.sin_addr.S_addr:=inet_addr(PAnsiChar(ip));
     {connect}
     Connect(S,addr,SizeOf(TSockAddr));
     sendbuff := 'GET / HTTP/1.1'+ #13#10 +
                 'Host: ya.ru'+ #13#10#13#10;
     {send query}
     send(s, sendbuff[1] , Length(sendbuff), 0);
     {read answer}
     reply:=recvdata(s);
     {close socket}
     closesocket(s);
     synchronize(UpdateCounters);
    {If the answer is the correct line to us - we finish the list of "good"
      ip and port used by proxy
      (using a critical section)}
     if pos('<html>',reply)<>0 then
     begin
        cs1.Enter;
          g:=g+1;
          Form2.lblGood.Caption:=inttostr(g);
          append(good);
          writeln(good,ip+':'+port);
          try
          closefile(good);
          finally;
          synchronize(initcounters);
          end;
        cs1.Leave;
     end;
  end;
{reduce the count of unfinished (active) threads at 1}

//Form2.ProgressBar1.Position:=0;
end;
InterlockedDecrement(threads_alive);
end;

procedure TCheckThread.InitCounters;
begin
Form2.lblCount.Caption:=inttostr(ProxyList.Count);
Form2.lblGood.Caption:=inttostr(g);
end;

procedure TCheckThread.UpdateCounters;
begin
     Form2.logmemo.Lines.Add('get:'+#13+reply+'from:'+#13+ip);
     Form2.lblChecked.Caption:=IntToStr(item);
     Form2.ProgressBar1.Position:= i;

end;

procedure TCheckThread.UpdateThreads;
begin
form2.lblT.Caption:=inttostr(threads_alive);
end;

Заработало.

--------------------

Подпись >> /dev/null

XperT

Дата 27.4.2012, 12:15 (ссылка)

(голосов:1)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 269
Регистрация: 19.8.2006

Репутация: 1
Всего: 4

Немного критики (в образовательных целях):

Код


  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;

В данном случае использование критических секций лишнее, так как функция UpdateThreads будет выполнена в основном потоке и каждый поток, который дойдёт до выполнения этого кода и так будет ждать, пока предыдущий завершит работу.

К тому же, настоятельно рекомендую использовать критические секции вместе с конструкцией try...finaly, иначе, если вылетит где-то ошибка между открытием и закрытием критической секции, то все потоки подвиснут.

В остальном, если не считать выравнивания кода, всё вроде нормально.

Alkash

Дата 27.4.2012, 12:26 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

Цитата(XperT @ 27.4.2012, 12:15)

Немного критики (в образовательных целях):

Код


  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;

ЭТо тоже заметил, и пофиксил - где заметил:

Код


procedure TCheckThread.Execute;
var
curitem: integer;
begin
 InterlockedIncrement(threads_alive);
  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;
  while Work do
   begin
 if item<ProxyList.Count then curitem:=item else work:= false;
 //for i:= 0 to (ProxyList.Count - 1) do
 if Work = true then
  begin
    // i:=i+1;
     cs0.Enter;
     str:= ProxyList.Strings[item];
     inc(item);
     cs0.Leave;
   //  synchronize();
     ip:=copy(str,0,pos(':',str)-1);
     port:=copy(str,pos(':',str)+1,length(str)-pos(':',str));
     {if in the end of the line there are spaces - remove them}
     while pos(' ',port)<>0 do setlength(port,length(port)-1);
     {create socket}
     s:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
     FillChar(addr, SizeOf(sockaddr_in), 0);
     addr.sin_family:=AF_Inet;
     addr.sin_port:=htons(strtoint(port));
     addr.sin_addr.S_addr:=inet_addr(PAnsiChar(ip));
     {connect}
     Connect(S,addr,SizeOf(TSockAddr));
     //sendbuff := 'GET / HTTP/1.1'+ #13#10 +
                 //'Host: ya.ru'+ #13#10#13#10;
     sendbuff:='GET / HTTP/1.1'+ #13#10 +
               'User-Agent: Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.10.229 Version/11.62'+ #13#10+
               'Host: ya.ru'+ #13#10 +
               'Accept: text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/webp, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1' + #13#10+
               'Accept-Language: ru-RU,ru;q=0.9,en;q=0.8'+ #13#10 +
               'Accept-Encoding: gzip, deflate'+ #13#10 +
               'Connection: Keep-Alive'+ #13#10;
     {send query}
    // CopyMemory(@sbuff,PAnsiChar(sendbuff),length(sendbuff));
    // send(s,sbuff,length(sbuff),0);
     send(s, sendbuff[1] , Length(sendbuff), 0);
     {read answer}
     reply:=recvdata(s);
     //recv(s,rbuff,length(rbuff),0);
     {close socket}
    // reply(rbuff);
    // SetString(reply,Pchar(@rbuff),length(rbuff));
     closesocket(s);
     synchronize(UpdateCounters);
    {If the answer is the correct line to us - we finish the list of "good"
      ip and port used by proxy
      (using a critical section)}
     if pos('Set-Cookie',reply)<>0 then
     begin
        cs1.Enter;
          g:=g+1;
          append(good);
          writeln(good,ip+':'+port);
          try
          closefile(good);
          finally;
          synchronize(initcounters);
          end;
        cs1.Leave;
     end;
  end;
{reduce the count of unfinished (active) threads at 1}
end;
InterlockedDecrement(threads_alive);
Synchronize(UpdateThreads);
end;

Это сообщение отредактировал(а) MetalFan - 27.4.2012, 17:18

--------------------

Подпись >> /dev/null

MetalFan

Дата 27.4.2012, 17:19 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 16
Всего: 128

Цитата(Alkash @ 27.4.2012, 12:26

)

ЭТо тоже заметил, и пофиксил - где заметил

Цитата(Alkash @ 27.4.2012, 12:26

)

  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;

Что-то сразу и не скажешь)

--------------------

There are always someone smarter than you...

Alkash

Дата 28.4.2012, 07:59 (ссылка)

(нет голосов)

Загрузка ...

коллекционер жизни

Профиль
Группа: Участник
Сообщений: 516
Регистрация: 5.7.2004
Где: /

Репутация: нет
Всего: нет

Цитата(MetalFan @ 27.4.2012, 17:19)

Цитата(Alkash @ 27.4.2012, 12:26

)

ЭТо тоже заметил, и пофиксил - где заметил

Цитата(Alkash @ 27.4.2012, 12:26

)

  cs0.Enter;
  Synchronize(UpdateThreads);
  cs0.Leave;

Что-то сразу и не скажешь)

Ну я же говорю - где заметил-)) Спасибо за тык носом-)

--------------------

Подпись >> /dev/null

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: WinAPI и системное программирование \| Следующая тема »