Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.133.86.172] |
|
Страницы: (2) [1] 2 все ( Перейти к последнему сообщению ) |
Сообщ.
#1
,
|
|
|
Сделал Proxy Парсер по ссылкам и что бы форма не зависала переместил в отдельный поток.
Мужики, знатоки в потоках помогите решить задачу: Как сделать что бы программа работала в 50 потоков. И предполагаю что это что то типа (В моем случае): for i:=0 to 50 do begin TPotok.Create(true); end; Вот готовый одно-поточный вариант (Очень надеюсь на вашу помощь, Уважаемые программисты!): unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdHTTP, Buttons, RegExpr, sMemo, sSkinProvider, sSkinManager, acPNG, ExtCtrls, jpeg, sButton, sLabel, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze; type TForm1 = class(TForm) SaveDialog1: TSaveDialog; sSkinManager1: TsSkinManager; sSkinProvider1: TsSkinProvider; sMemo1: TsMemo; sMemo2: TsMemo; sLabel1: TsLabel; sLabel2: TsLabel; sButton1: TsButton; IdAntiFreeze1: TIdAntiFreeze; Label1: TLabel; Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; Label2: TLabel; procedure Image4Click(Sender: TObject); procedure sButton1Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); procedure sMemo2Change(Sender: TObject); private { Private declarations } public { Public declarations } end; // Поток type TPotok = class(TThread) private html: WideString; procedure reg; protected procedure Execute; override; end; var Form1: TForm1; Potok: TPotok; HTTP: TIdHTTP; site, html, s: string; rege: tregexpr; i: integer; implementation uses Unit2; {$R *.dfm} procedure TPotok.reg; begin Form1.sMemo2.Lines.Add(rege.Match[0]); end; procedure TPotok.Execute; begin for i := 0 to Form1.sMemo1.Lines.Count - 1 do begin try site := Form1.sMemo1.Lines.Strings[i]; html := HTTP.Get(site); except end; if rege.Exec(html) then repeat Synchronize(reg); until (not rege.ExecNext) or Potok.Terminated; if Potok.Terminated then break; end; HTTP.Free; rege.Free; end; procedure TForm1.Button1Click(Sender: TObject); begin sMemo2.clear; end; procedure TForm1.Button2Click(Sender: TObject); begin if SaveDialog1.Execute then sMemo2.Lines.SaveToFile(SaveDialog1.FileName); end; procedure TForm1.Button3Click(Sender: TObject); begin if not Assigned(Potok) then ShowMessage('Программа не запущена') else begin Potok.Terminate; end; end; procedure TForm1.Button4Click(Sender: TObject); begin HTTP := TIdHTTP.Create(nil); // экземпляр tidhttp rege := tregexpr.Create; rege.Expression := '\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}:\d{1,5}'; Potok := TPotok.Create(true); // т.к запускаем через Resume Potok.Priority := tpLower; Potok.FreeOnTerminate := true; Potok.Resume; end; procedure TForm1.Button5Click(Sender: TObject); begin Potok.suspend; end; procedure TForm1.Image4Click(Sender: TObject); begin sMemo2.clear; end; procedure TForm1.sButton1Click(Sender: TObject); var i, j: integer; begin for i := sMemo2.Lines.Count - 1 downto 0 do for j := i - 1 downto 0 do if sMemo2.Lines[i] = sMemo2.Lines[j] then sMemo2.Lines.Delete(i); end; procedure TForm1.sMemo2Change(Sender: TObject); begin Label1.Caption := IntToStr(sMemo2.Lines.Count); end; end. |
Сообщ.
#2
,
|
|
|
Цитата Kirilis2018 @ for i := 0 to Form1.sMemo1.Lines.Count - 1 do А как ты хочешь это расспаралелить? |
Сообщ.
#3
,
|
|
|
^D^ima,я тут даже не знаю как правильней это сделать ? Я так понял тут нужно что бы они синхронно работали ?
|
Сообщ.
#4
,
|
|
|
Я в потоках не силен, но ты уверен что это даст сильный прирост скорости?
|
Сообщ.
#5
,
|
|
|
^D^ima, А такой вариант реален: один тред = одному URL ?
Добавлено ^D^ima, В любом случае сбор адресов будет быстрее. Я видел как у других разработчиков в раз 10 быстрее работает в 5 потоков нежели в один. |
Сообщ.
#6
,
|
|
|
как в первом посте написали код через цикл так и запускайте, только в каждый поток передавайте юрл ссылку из списка, ну и синхронизация через критические секции.
|
Сообщ.
#7
,
|
|
|
vasya2019, Помогите сделать в потоках я не силен!
|
Сообщ.
#8
,
|
|
|
код не заработает, так как надо дочесать, просто скопипастил с вашего, но думаю смысл понятен
function ThreadFunc(Info: Pointer): Integer; stdcall; var i: Integer; HTTP: TIdHTTP; html: WideString; begin HTTP := TIdHTTP.Create(nil); html := HTTP.Get(Info); rege.Exec(html) if rege.Exec(html) then repeat EnterCriticalSection(CriticalSection); Form1.sMemo2.Lines.Add(rege.Match[0]); LeaveCriticalSection(CriticalSection); until (not rege.ExecNext); HTTP.Free; ExitThread(4); end; procedure TForm1.Button1Click(Sender: TObject); var i: Integer; TID: Cardinal; begin InitializeCriticalSection(CriticalSection); for i := 0 to sMemo2.Lines.Count - 1 do CreateThread(nil, 0, @ThreadFunc, @sMemo2.Lines[i], 0, TID); end; |
Сообщ.
#9
,
|
|
|
vasya2019, Увы но так не срабатывает.
|
Сообщ.
#10
,
|
|
|
что именно не срабатывает?
|
Сообщ.
#11
,
|
|
|
vasya2019, Вот тут идут ошибки при компиляции:
EnterCriticalSection(CriticalSection); Form1.sMemo2.Lines.Add(rege.Match[0]); LeaveCriticalSection(CriticalSection); |
Сообщ.
#12
,
|
|
|
ошибки, что CriticalSection не объявлен?
var CriticalSection: TRTLCriticalSection; |
Сообщ.
#13
,
|
|
|
vasya2019, Да, сейчас еще сижу и разбираюсь. После отпишу. Заранее спасибо за помощь.
|
Сообщ.
#14
,
|
|
|
Уже давно все юзают PPL
http://www.proghouse.ru/programming/36-delphi-xe7-ppl |
Сообщ.
#15
,
|
|
|
vasya2019,Cfon, В общем завис я на этом вопросе. Сегодня пол ночи просидел и результат просто НОЛЬ . Кто поможет, в долгу не останусь!
|