Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Увеличится ли скорость в моём случае если я сделаю 2 потока? [D7, WinXP]


Страницы:   1 2 3 4 5

rolex ©   (2005-03-08 18:45:00) 

Моя прога предположим ищет файлы на винте. Увеличится ли скорость общего поиска, если я его разобью на 2 потока?


Alexander Panov   (2005-03-14 17:32:00) [21]

begin...end ©   (14.03.05 17:28) [65]
А для чего это нужно?


Для установки переменных, конечно.
Причем, если исходить из конкретной платформы(D7), то это(в принципе) не обязательно.
Но исходя из общей логики, и учитывая, что код будет работать в D5(например), то этот дополнительный код необходим для универсальности.


begin...end   (2005-03-14 17:28:00) [22]

> Alexander Panov ©   (14.03.05 17:26) [64]

А для чего это нужно?


Alexander Panov   (2005-03-14 17:26:00) [23]

begin...end ©   (14.03.05 17:25) [63]
Это можно выкинуть.


С какой стати?


begin...end   (2005-03-14 17:25:00) [24]

> Defunct ©   (14.03.05 17:06) [60]

> inherited Create(True);
> ...
> Resume;

Это можно выкинуть.

P.S. А почему List нигде не освобождается? Или я что-то не заметил?


Defunct   (2005-03-14 17:13:00) [25]

[60]
50 тыс файлов за 1.7 секунды (повторный поиск), почти как в проводнике ;>


Defunct   (2005-03-14 17:07:00) [26]

Unit1.DFM

object Form2: TForm2
 Left = 332
 Top = 265
 Width = 504
 Height = 393
 Caption = 'Form2'
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -11
 Font.Name = 'MS Sans Serif'
 Font.Style = []
 OldCreateOrder = False
 PixelsPerInch = 96
 TextHeight = 13
 object Button1: TButton
   Left = 408
   Top = 8
   Width = 75
   Height = 25
   Caption = 'Run'
   TabOrder = 0
   OnClick = Button1Click
 end
 object StatusBar1: TStatusBar
   Left = 0
   Top = 347
   Width = 496
   Height = 19
   Panels = <
     item
       Width = 50
     end>
 end
 object ScrollBar1: TScrollBar
   Left = 344
   Top = 0
   Width = 16
   Height = 345
   Kind = sbVertical
   PageSize = 0
   TabOrder = 2
   OnChange = ScrollBar1Change
 end
 object StringGrid1: TStringGrid
   Left = 0
   Top = 0
   Width = 345
   Height = 347
   Align = alLeft
   ColCount = 1
   DefaultColWidth = 340
   DefaultRowHeight = 18
   FixedCols = 0
   RowCount = 18
   FixedRows = 0
   Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRowSelect]
   ScrollBars = ssNone
   TabOrder = 3
 end
end


Defunct   (2005-03-14 17:06:00) [27]

Обещанный пример.

unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, Masks, ComCtrls, Grids;

const
  WM_UPDATELIST   =   WM_USER + 90;

type
  TSearchThread = class(TThread)
  private
     List            : TStrings;
     fDailyList      : TStrings;
     fOwnerHandle    : HWND;
     fDir            : String;
     Mask            : String;
     fCount          : Integer;
     fWhenToSendList : TDateTime;

     function  GetDailyData:TStrings;
     procedure TryToUploadTheList(Forced: boolean);
  protected
     procedure Execute;override;
  public
     property ExportList: TStrings read GetDailyData;
     property Count:Integer read fCount;

     constructor Create(AOwner: Hwnd;  Dir,  AMask:  string);
  end;

 TForm2 = class(TForm)
   Button1: TButton;
   StatusBar1: TStatusBar;
   ScrollBar1: TScrollBar;
   StringGrid1: TStringGrid;
   procedure Button1Click(Sender: TObject);
   procedure ScrollBar1Change(Sender: TObject);
 private
   fTime    : TDateTime;
 public
   ST       : TSearchThread;
   Strings  : TStrings;

   procedure UpdateList(var Msg:TMessage);message WM_UPDATELIST;
   procedure UpdateControls;
   procedure RedrawGrid;
   procedure RegisterFinishOfSearching( Sender : TObject );
 end;

var
 Form2: TForm2;

implementation

{$R *.dfm}

{***********************************}
{*********** ïîòîê ïîèñêà **********}
{***********************************}
constructor TSearchThread.Create;
begin
  inherited Create(True);

  if Dir '' then
     fDir := Dir
  else
     fDir := 'c:\';

  if AMask '' then
     Mask := AMask
  else
     Mask := '*.*';

  fDailyList := nil;
  fOwnerHandle := AOwner;
  fCount := 0;
  fWhenToSendList := 0;
  Priority := tpIdle;
  FreeOnTerminate := True;
  Resume;
end;

procedure TSearchThread.Execute;

{ немного приспособленная для нашего примера
 процедура ScanDir (C) Юрий Зотов }
    procedure  ScanDir(Dir:  string);
    var
        SR:  TSearchRec;
    begin
        Dir  :=  IncludeTrailingBackSlash(Dir);
        if  FindFirst(Dir  +  '*.*',  faAnyFile  -  faVolumeID,  SR)  =  0  then
        try
            repeat
                if  (SR.Name    '.')  and  (SR.Name    '..')  then
                    if  SR.Attr  and  faDirectory    0  then
                        ScanDir(Dir  +  SR.Name)
                    else
                        if  MatchesMask(SR.Name,  Mask)  then
                            begin
                               List.Add(Dir  +  SR.Name);
                               inc(fCount);                // = fWhenToSendList then
          if fOwnerHandle 0  then
          begin
             if Assigned( fDailyList ) then
                fDailyList.Free;
             fDailyList := List;
             List := TStringList.Create;
             fWhenToSendList := GetTime + (0.2 / (3600*24) );
             PostMessage( fOwnerHandle, WM_UPDATELIST, 0,0)
          end
    except
       on E:Exception do ShowMessage('Alles at TryToUpload')
    end
 else // инициализация таймера
    fWhenToSendList := GetTime + (0.2 / (3600*24) );
end;

{***********************************}

procedure TForm2.Button1Click(Sender: TObject);
begin
  fTime := Now;
  Strings := TStringList.Create;
  if not Assigned(ST) then
     ST := TSearchThread.Create( Handle, 'c:\', '*.*');
  ST.OnTerminate := RegisterFinishOfSearching;
end;

procedure TForm2.RegisterFinishOfSearching;
begin
 fTime := Now - fTime;
 ShowMessage('Total time: '+FormatDateTime('hh:nn:ss:zzz', fTime));
 ST := nil
end;

procedure TForm2.RedrawGrid;
var
  i        : integer;
  EndPos   : integer;
begin
  EndPos := ScrollBar1.Position + StringGrid1.RowCount;

  if EndPos >= Strings.Count then
     EndPos := Strings.Count - 1;

  for i := ScrollBar1.Position to EndPos do
      StringGrid1.Cells[0, i - ScrollBar1.Position] := Strings[i];
end;

procedure TForm2.UpdateControls;
begin
  ScrollBar1.Min := 0;
  ScrollBar1.Max := ST.Count - StringGrid1.RowCount;
  StatusBar1.Panels[0].Text := 'Files found: '+IntToStr( ST.Count );

  RedrawGrid;
end;

procedure TForm2.UpdateList;
var
 AList : TStrings;
begin
  try
     AList := ST.ExportList;
     Strings.AddStrings( AList );
     AList.Free;
     UpdateControls;
  except
     on E:Exception do ShowMessage(E.ClassName+' ' +E.Message)
  end
  inherited;
end;

procedure TForm2.ScrollBar1Change(Sender: TObject);
begin
  RedrawGrid;
end;

end.


rolex   (2005-03-14 16:08:00) [28]


> Defunct ©   (14.03.05 15:25) [58]
> rolex   (14.03.05 14:56) [57]
>
> Определенно. Ускорит работу программы причем на много (в
> разы).
> Поток поиска пусть занимается только поиском, никаких сообщений
> главной форме, никаких synchronize, и никаких обращений
> к VCL, кроме сигнализации о завершении поиска.
>
> Напишу небольшой пример позже.
> Выложу здесь.

Ну спасибо!


Defunct   (2005-03-14 15:25:00) [29]

rolex   (14.03.05 14:56) [57]

Определенно. Ускорит работу программы причем на много (в разы).
Поток поиска пусть занимается толькопоиском, никаких сообщений главной форме, никаких synchronize, и никаких обращений к VCL, кроме сигнализации о завершении поиска.

Напишу небольшой пример позже.
Выложу здесь.


rolex   (2005-03-14 14:56:00) [30]


> Defunct ©   (14.03.05 11:33) [54]
> rolex   (13.03.05 17:14) [51]
>
> Запустите на форме таймер, который раз в секунду будет обновлять
> информацию на Label'е и на всем остальном.

Так поможет этот способ тогда или нет?


Digitman   (2005-03-14 13:40:00) [31]


> P.S. А таймер это впринципе он своим отдельным потоком и
> работает, так?


нет, не так.

за обработку его событий таймера отвечает поток, который создал этот таймер


rolex   (2005-03-14 13:23:00) [32]


> Defunct ©   (14.03.05 11:33) [54]
> rolex   (13.03.05 17:14) [51]
>
> Запустите на форме таймер, который раз в секунду будет обновлять
> информацию на Label'е и на всем остальном.

Точно! Так и сделаю!
P.S. А таймер это впринципе он своим отдельным потоком и работает, так?


Defunct   (2005-03-14 11:33:00) [33]

rolex   (13.03.05 17:14) [51]

Запустите на форме таймер, который раз в секунду будет обновлять информацию на Label'е и на всем остальном.


Anatoly Podgoretsky   (2005-03-14 11:20:00) [34]

Palladin ©   (13.03.05 16:18) [50]
Крестись, здесь простая вера в чудо. До чего только не дойдет русский программист, чтобы только не писать нормальную программу.

rolex   (13.03.05 17:14) [51]
Не надо пример с 282000 файлов, каждый проанализированный файл отражается в счетчике, время как я указал всего 7 секунд, из них на индикацию тратится малая доля.


Erik1   (2005-03-14 11:17:00) [35]

Очень просто, надо один раз из 10-20 посылать PostMessage главной форме в параметрах(LParam) указать schectchik.


rolex   (2005-03-13 17:14:00) [36]

То есть мне первым делом следует переделать прямое обращение к компонентам во время сканирования?
Хорошо, но я не знаю как это сделать!
Ну к примеру: как можно заменить обращение к label'у который показывает число проанализированных файлов?
К примеру, в коде он выглядит так: Label1.caption:=IntToStr(schectchik);, где schetchik - integer, и есть то самое число проанализированных файлов.


Palladin   (2005-03-13 16:18:00) [37]

А мне показалось, он вообще идею нескольких потоков в программе попытался раскритиковать.


Anatoly Podgoretsky   (2005-03-13 16:01:00) [38]

Но у него как раз первый случай.


Palladin   (2005-03-13 15:49:00) [39]


> [47] Anatoly Podgoretsky ©

Я не затрагиваю тему нескольких потоков читающих с диска. В приведенном примере два потока занимаются разными задачами. И объединение этих задач в одном потоке, работа достаточно сложная. Проще реализовать потоки. Учитывая, что могут появится и третья и четвертая задачи... Специально для Дмитрия Мыльникова.


Anatoly Podgoretsky   (2005-03-13 15:27:00) [40]

Palladin ©   (13.03.05 15:02) [46]
Так ты же не пытаешь читать один байт в одном потоке, а другой в другом. А остальное об вредности этого написали.
Механика однако. А у некоторых вера в чудо, вместо того, чтобы отшлифиовать алгоритм, верят в великую, тайную силу потоков.


Страницы:   1 2 3 4 5

Наверх

Титульная страница Поиск, карта сайта Написать письмо