Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2006.03.19;
Скачать: [xml.tar.bz2];

Вниз

Многопоточность.   Найти похожие ветки 

 
guru-ru   (2006-03-04 09:53) [0]

послушайте, как сделать многопоточность.
Чтобы был массив потоков.
В общем задача такая! Есть в базе более 100 URL адресов (программа проверяет установлена ли на них обратная ссылка, т.е. для обмена ссылками и поддержания их в актуальном состоянии) мне нужно реализовать многопоточность, чтобы проверка проходила в 10 потоков (или более, задается в спец.поле). я делаю так.

type
 THttpThread = class(TThread)
 protected
   procedure Execute; override;
   procedure ShowInfo;
   procedure add;
 public
  URL:string;
 end;

procedure ThttpThread.ShowInfo;
begin
  //просто для информации сколько ща потоков работает
  Form1.LineNow:=Form1.linenow+1;
  form1.Caption:=inttostr(Form1.LineNow);
end;

procedure ThttpThread.add;
begin
  //с лист бокс добавляем очередной проверенный урл
  form1.Listbox2.Items.add(URL);
end;

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
// вот так я уничтожаю потоки

  Form1.LineNow:=Form1.linenow-1;
  form1.Caption:=inttostr(Form1.LineNow);
  (sender as Thttpthread).free;
//после уничтожения и записываю лист бокс в файл.
  listbox2.Items.SaveToFile("link.txt");

end;

procedure ThttpThread.Execute;
begin
  Synchronize(ShowInfo);

  memo1:=Tstringlist.Create;
  memo1.Clear;
  http:=TidHTTP.Create(nil);
  urls:=Тут я реализую выборку из бд урл
  //отправляю запрос
  memo1.Text := HTTP.Get(urls);
  s1:="";
  for x:=0 to memo1.Count-1 do
     s1:=s1+memo1.Strings[x];

  //и начинаю искать мою ссылку
  while (length(s1)>0)and(pos("http://",s1)>0) do
     begin
        k:=pos("http://",s1);
        ss:="";
        while (s1[k]<>""")and(s1[k]<>"<")and(s1[k]<>">")and(s1[k]<>"""")and(s1[k]<>" ")and(s1[k]<>")")and(length(s1)>=k) do
           begin
              ss:=ss+s1[k];
              inc(k)
           end;

        delete(s1,1,k);
        if (pos(".gif",ss)<1)and(pos(".jpg",ss)<1)and(pos(".png",ss)<1)and(pos(".GIF",ss)<1 )and(pos(".JPG",ss)<1)and(pos(".PNG",ss)<1) then
          begin
             if моя ссылка then
              begin
             URL:=ss+":"+" ok";
             synchronize(add);
              end;
          end;
     end;
     http.Free;
     memo1.Free;
     application.ProcessMessages;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//создаю 10 потоков.
for t:=1 to 10 do
begin
 httpThread[t] := ThttpThread.Create(false);
 httpThread[t].OnTerminate:=ThreadTerminate;
end;
end;

httpThread[t]- массив потоков.

Но проблема в том, что он как-то слишком быстро отрабатывает, и есественно неправильно. Вот только почему????

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


 
Dmitrij_K   (2006-03-04 10:06) [1]

1. Нельзя уничтожать класс в его же событии
procedure TForm1.ThreadTerminate(Sender: TObject);
...
 (sender as Thttpthread).free;

Есть такая штука TThread.FreeOnTerminate
2. application.ProcessMessages;
В контексте потока это бесполезно делать
3. Я бы сделал еще  так

...
try
 memo1.Text := HTTP.Get(urls);
...
Finally
 http.free;
...
end


 
guru-ru   (2006-03-04 10:12) [2]

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


 
Dmitrij_K   (2006-03-04 10:27) [3]

Например что-то типа такого
THttpThread
...
public
 Index:Integer;
...
end

Создание
for t:=1 to 10 do
begin
httpThread[t] := ThttpThread.Create(True);
httpThread[t].OnTerminate:=ThreadTerminate;
httpThread[t].Index := t;
httpThread[t].Resume
end;

Завершение
procedure TForm1.ThreadTerminate(Sender: TObject);
begin
...
 k := (sender as Thttpthread).Index;
 httpThread[k] := nil;
 if Естm url then
 begin
   httpThread[k] := ThttpThread.Create(True);
   httpThread[k].OnTerminate:=ThreadTerminate;
   httpThread[k].Index := t;
   httpThread[k].Resume    
 end
 else ShowMessage("Конец")
end;


 
guru-ru   (2006-03-04 10:45) [4]

Спасибо, так рулит, но все равно не так как нужно. при сохранении не все данные в файл сохраняет. такое ощущение, что поток уничтожается, неуспев доработать. можно не memo1:=Tstringlist.Create нужно сохранять, а что-то другое, и не form1.Listbox2.Items.add(ss); делать. может он просто не успевает сохранять туда данные? или разные потоки данные перезаписывают там?


 
Kolan ©   (2006-03-04 12:40) [5]


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


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


 
Cybernik ©   (2006-03-04 13:02) [6]

Поток не может уничтожется не успев доработать если не вызвать руками его терминате.


 
Kolan ©   (2006-03-04 13:45) [7]

А я говорю, что когда он отработает ненадо спешить его удалять...

> мне же нужно после того как один
> > поток отработал, если в бд еще есть урл, запустить новый

Я имел в виду что зачем запускать новый если есть уже запушенный



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2006.03.19;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.014 c
6-1133119368
asd
2005-11-27 22:22
2006.03.19
Edit и web страничка?


2-1141130984
Make
2006-02-28 15:49
2006.03.19
Прорисовка StringGrid


2-1141368131
dera
2006-03-03 09:42
2006.03.19
Как в TeeView узнать, что вибрана ветвь№1, а не ветвь№2?


2-1141320061
Alex7
2006-03-02 20:21
2006.03.19
Неисправность


6-1133691903
samalex
2005-12-04 13:25
2006.03.19
Сделать почтовые сообщения по-русски





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский