На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Много-поточность
Сделал Proxy Парсер по ссылкам и что бы форма не зависала переместил в отдельный поток.

Мужики, знатоки в потоках помогите решить задачу: Как сделать что бы программа работала в 50 потоков.

И предполагаю что это что то типа (В моем случае):

ExpandedWrap disabled
    for i:=0 to 50 do
     begin
        TPotok.Create(true);
     end;


Вот готовый одно-поточный вариант (Очень надеюсь на вашу помощь, Уважаемые программисты!):
ExpandedWrap disabled
    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.
Цитата Kirilis2018 @
for i := 0 to Form1.sMemo1.Lines.Count - 1 do

А как ты хочешь это расспаралелить?
"Воля - это то, что заставляет тебя побеждать, когда твой рассудок говорит тебе, что ты повержен" Карлос Кастанеда
^D^ima,я тут даже не знаю как правильней это сделать ? Я так понял тут нужно что бы они синхронно работали ?
Я в потоках не силен, но ты уверен что это даст сильный прирост скорости?
"Воля - это то, что заставляет тебя побеждать, когда твой рассудок говорит тебе, что ты повержен" Карлос Кастанеда
^D^ima, А такой вариант реален: один тред = одному URL ?

Добавлено
^D^ima, В любом случае сбор адресов будет быстрее. Я видел как у других разработчиков в раз 10 быстрее работает в 5 потоков нежели в один.
как в первом посте написали код через цикл так и запускайте, только в каждый поток передавайте юрл ссылку из списка, ну и синхронизация через критические секции.
vasya2019, Помогите сделать в потоках я не силен!
код не заработает, так как надо дочесать, просто скопипастил с вашего, но думаю смысл понятен
ExpandedWrap disabled
    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;
vasya2019, Увы но так не срабатывает.
что именно не срабатывает?
vasya2019, Вот тут идут ошибки при компиляции:
ExpandedWrap disabled
    EnterCriticalSection(CriticalSection);
    Form1.sMemo2.Lines.Add(rege.Match[0]);
    LeaveCriticalSection(CriticalSection);
ошибки, что CriticalSection не объявлен?
ExpandedWrap disabled
    var
    CriticalSection: TRTLCriticalSection;
vasya2019, Да, сейчас еще сижу и разбираюсь. После отпишу. Заранее спасибо за помощь.
Уже давно все юзают PPL :D
http://www.proghouse.ru/programming/36-delphi-xe7-ppl
Rabbit don't come easy: https://github.com/Cfon/ :D
vasya2019,Cfon, В общем завис я на этом вопросе. Сегодня пол ночи просидел и результат просто НОЛЬ :crazy: . Кто поможет, в долгу не останусь!
1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
0 пользователей:


Рейтинг@Mail.ru
[ Script Execution time: 0,1348 ]   [ 20 queries used ]   [ Generated: 25.03.19, 18:45 GMT ]