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

Вниз

Увеличится ли скорость в моём случае если я сделаю 2 потока?   Найти похожие ветки 

 
rolex   (2005-03-12 20:15) [40]

Осуществил второй вариант (Сканирование в одном потоке, а обработка и интерфейс проги в другом потоке). В результате чего время сканирования увеличилось с 5мин. до 7мин. !!! =0


 
Денч ©   (2005-03-12 21:07) [41]


> В результате чего время сканирования увеличилось с 5мин.
> до 7мин. !!! =0

Вот так да!!! Есть такая прога, sequoiaview называется (http://www.win.tue.nl/sequoiaview/), так у меня на сканирование диска объемом 13 Гб затратила около 20 секунд.
Может, попробовать asm поюзать?


 
rolex   (2005-03-13 10:47) [42]

Хм... на самом деле быстро!


 
Anatoly Podgoretsky ©   (2005-03-13 11:20) [43]

Есть такая хорошая программа Проводник называется.
157 гб просканировала за 3 минуты, 282000 файлов. Повторный запуск 7 секунд.
Это тем кто не верит, что два потока сильно затормозят сканирование, наглядно видно, что почти все время приходится на перемещение головок, при втором запуске головки уже не двигаются.


 
Дмитрий Мыльников   (2005-03-13 14:39) [44]

Да при чём тут вообще многопоточность, если базовый алгоритм написан криво, с постоянным обращением к визуальной части, которые вызывают весьма длительную перерисовку компонетов?
Тут хоть один поток, хоть два, хоть сто, толку всё равно не будет. И даже если делать повторный поиск, то сокращения времени с 3 мин до 7 сек как у проводника тоже не будет, поскольку основное время тратится вовсе не на поиск или даже перемещение головок, а на постоянную перерисовку визуальной части.

И вообще, у меня после прочтения нескольких тем, в которых так или иначе обсуждается многопоточность, сложилось впечатление, что создание множества потоков стало эдакой модной фишкой, да ещё и обросшей массой мифов. Типа, вот сделаю приложение многопоточным, и сразу будет мне счастье. А о том, что на большинстве компьютеров стоит ТОЛЬКО ОДИН ПРОЦЕССОР, почему-то никто не вспоминает. Ведь в случае с одним процессором, ЛЮБАЯ МНОГОПОТОЧНОСТЬ ЛИШЬ ИЛЛЮЗИЯ. И все приемущества, которые она даёт, сводятся к тому, что при грамотном использовании потоков прорамму можно сделать более простой и понятной, переложив решение части проблем на менеджер процессов ОС. Для срверных приложений, да ещё запускаемых на многопроцессорных системах, там да, разница будет существенной. Но и в этом случае нужно весьма немало времени потратить на проектирование программы.


 
Anatoly Podgoretsky ©   (2005-03-13 14:48) [45]

То что криво, так сразу сказали не в потоках счастье.


 
Palladin ©   (2005-03-13 15:02) [46]


> [44] Дмитрий Мыльников

Программа должна читать данные из COM порта и обрабатывать файлы. В COM порте данных нет. Программа ждет данные, но файлы не обрабатывает. Потому что поток один. Процессор один. Тут какой то дебил решил погнаться за "модной фишкой". Решил сделать два потока. Один будет заниматся чтением данных из COM порта, другой обрабатывать файлы. Блин, как хорошо получилось то. И файлы обрабатываются и программа не висит при отсутствии данных в COM. И тут он прочитал твой пост и прозрел. В срочном порядке вернул один поток. Ведь, как сказал Дмитрий Мыльников, все что он увидел при двух потоках оказалось иллюзией и неправдой...


 
Anatoly Podgoretsky ©   (2005-03-13 15:27) [47]

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


 
Palladin ©   (2005-03-13 15:49) [48]


> [47] Anatoly Podgoretsky ©

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


 
Anatoly Podgoretsky ©   (2005-03-13 16:01) [49]

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


 
Palladin ©   (2005-03-13 16:18) [50]

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


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

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


 
Erik1 ©   (2005-03-14 11:17) [52]

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


 
Anatoly Podgoretsky ©   (2005-03-14 11:20) [53]

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

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


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

rolex   (13.03.05 17:14) [51]

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


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


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

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


 
Digitman ©   (2005-03-14 13:40) [56]


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


нет, не так.

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


 
rolex   (2005-03-14 14:56) [57]


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

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


 
Defunct ©   (2005-03-14 15:25) [58]

rolex   (14.03.05 14:56) [57]

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

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


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


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

Ну спасибо!


 
Defunct ©   (2005-03-14 17:06) [60]

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

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);                // <- добавлено для примера
                               TryToUploadTheList(False);  // <- добавлено для примера
                            end
            until  FindNext(SR)  <>  0
        finally
            FindClose(SR)
        end
  end;

begin
  try
     List := TStringList.Create;
     ScanDir( fDir );
     TryToUploadTheList( True );
  except
     ShowMessage("Alles at Execute");
  end;
end;

function TSearchThread.GetDailyData;
begin
 Result := fDailyList;
 fDailyList := nil;
end;

procedure TSearchThread.TryToUploadTheList;
begin
 if Forced then
    begin
       if Assigned( fDailyList ) then
          fDailyList.Free;
       fDailyList := List;
       PostMessage( fOwnerHandle, WM_UPDATELIST, 0,0);
       Exit
    end;

 if fWhenToSendList > 0 then
    try
       if GetTime >= 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.


 
Defunct ©   (2005-03-14 17:07) [61]

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:13) [62]

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


 
begin...end ©   (2005-03-14 17:25) [63]

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

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

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

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


 
Alexander Panov ©   (2005-03-14 17:26) [64]

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


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


 
begin...end ©   (2005-03-14 17:28) [65]

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

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


 
Alexander Panov ©   (2005-03-14 17:32) [66]

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


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


 
Alexander Panov ©   (2005-03-14 17:33) [67]

И еще, как насчет изменения логики TThread в следующих версиях?


 
begin...end ©   (2005-03-14 17:34) [68]

Ну вопрос-то был про Delphi 7.


 
Defunct ©   (2005-03-14 17:35) [69]

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

TForm2.UpdateList


 
GuAV ©   (2005-03-14 17:36) [70]


> Alexander Panov ©


Так что, если заменить на inherited Create(False); ,  универсальности не будет ?


 
Alexander Panov ©   (2005-03-14 17:44) [71]

GuAV ©   (14.03.05 17:36) [70]
Так что, если заменить на inherited Create(False); ,  универсальности не будет ?


Не будет.

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


 
Defunct ©   (2005-03-14 17:47) [72]

GuAV ©   (14.03.05 17:36) [70]

constructor TThread.Create(CreateSuspended: Boolean);
var
 Flags: DWORD;
begin
 inherited Create;
 AddThread;
 FSuspended := CreateSuspended;
 Flags := 0;
 if CreateSuspended then Flags := CREATE_SUSPENDED;
 FHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), Flags, FThreadID);
end;


 
begin...end ©   (2005-03-14 17:50) [73]

> Defunct ©   (14.03.05 17:47) [72]

Delphi 5?


 
Defunct ©   (2005-03-14 17:51) [74]

[73]

угу


 
GuAV ©   (2005-03-14 18:04) [75]


> так как, начиная с D6 изменилась реализация TObject -
> появился метод AfterConstruction


Аж только в D6 ? не знал...


 
Alexander Panov ©   (2005-03-14 18:09) [76]

GuAV ©   (14.03.05 18:04) [75]

Насчет реализации AfterConstruction в D6 может быть заблуждаюсь, так как обратил внимание на него только лишь в связи с изменением реализации TThread в D6.


 
begin...end ©   (2005-03-14 18:11) [77]

> GuAV ©   (14.03.05 18:04) [75]
> Alexander Panov ©   (14.03.05 18:09) [76]

AfterConstruction в Delphi 4 появился.


 
Alexander Panov ©   (2005-03-14 18:26) [78]

begin...end ©   (14.03.05 18:11) [77]

Ок, спасибо, буду знать.

К сожалению, только реализация TThread отстала по времени.


 
rolex   (2005-03-14 18:32) [79]

Всё ништяк прога! Всю ночь буду в код въезжать, чтобы сибе также сделать!!! Скорость рулевая!!!
Тока вот тут ошибочка:
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;

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

А dpr файл такой должен получиться, да?:
program Project1;

uses
 Forms,
 Unit1 in "Unit1.pas" {Form1};

{$R *.res}

begin
 Application.Initialize;
 Application.CreateForm(TForm2, Form2);
 Application.Run;
end.


 
rolex   (2005-03-14 21:57) [80]

To Defunct:
Ууу... я страшный баг нашёл.
Когда запустите прогу, посмотрите в Диспетчере Задач скока она места в ОЗУ съедает. Ок запомнили. Потом каждый раз при нажатии кнопки "Скан", размер проги в ОЗУ всё больше и больше растёт!!!



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

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

Наверх





Память: 0.65 MB
Время: 0.037 c
1-1110791122
qwe
2005-03-14 12:05
2005.03.27
FindFirst


3-1109367926
kserg
2005-02-26 00:45
2005.03.27
есть поле со значениями -1,0,1,2,3.....и т.д.


3-1109605455
Вольный Стрелок
2005-02-28 18:44
2005.03.27
чтение BLOB SUB_TYPE TEXT в переменную VARCHAR в ХП


3-1109682373
Mishenka
2005-03-01 16:06
2005.03.27
Как узнать индекс выделенной строки в DBGrid?


4-1108073150
GanibalLector
2005-02-11 01:05
2005.03.27
WM_KILLFOCUS





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский