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

Вниз

Как ограничить одновременное количество потоков десятью?   Найти похожие ветки 

 
Борис К.   (2006-07-22 20:58) [0]

Запускаю по 10 штук (всего - 100). Как сделать чтобы одновременно работали только 10? Как только один завершится (FreeOnTerminate = true) запускался другой, но одновременно выполнялись только 10?


 
Palladin ©   (2006-07-22 21:25) [1]

заведи переменную счетчик


 
Kolan ©   (2006-07-22 21:28) [2]


> Борис К.   (22.07.06 20:58)

Менеджер(Pool потоков) нужен, который и будет следить за этим делом....


 
Palladin ©   (2006-07-22 21:45) [3]

пул потоков создается в основном с целью кеширования экземпляров потоков, а не ограничения их количества...

для ограничения достаточно



Var
theThrCounterSync:TMultiReadExclusiveWriteSynchronizer;
nThrCounter:Integer;

Type
TMyThread=Class(TThread)
 Protected
  Procedure Execute; Override;
  Destructor Destroy; Override;
End;

...

Procedure TMyThread.Execute;
Begin
...
End;

Destructor TMyThread.Destroy;
Begin
Inherited;
theThrCounterSync.BeginWrite;
Dec(nThrCounter);
theThrCounterSync.EndWrite;
End;

...
// Управление запуском потоков
Var
i:Integer;
Begin
nThrCounter:=0;
For i:=1 to 100 Do
 Begin
  theThrCounterSync.BeginRead;
  While nThrCounter>=10 Do
   Begin
    theThrCounterSync.EndRead;
    Sleep(100);
    theThrCounterSync.BeginRead;
   End;
  theThrCounterSync.EndRead;
  theThrCounterSync.BeginWrite;
  Inc(nThrCounter);
  TMyThread.Create(False);
  theThrCounterSync.EndWrite;
 End;
End;



 
Zeqfreed ©   (2006-07-22 22:02) [4]

Ладно, не зря же я старался, приведу и свой код.

unit main;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Math, StdCtrls;

type
 TThreadManager = class;

 TManagedThread = class(TThread)
 private
  FManager : TThreadManager;
 protected
  procedure Terminate(Sender : TObject);
 public
  constructor Create(ThreadManager : TThreadManager; const CreateSuspended : boolean = false);
 end;

 TManagedThreadClass = class of TManagedThread;

 TThreadManager = class
 private
  FThreadsToRun : Cardinal;
  FAvailThreads : Cardinal;
  FThreadClass : TManagedThreadClass;
 protected
  procedure StartThread();
  procedure ThreadTerminated();
 public
  constructor Create(const MaxThreadCount : Cardinal; ThreadClass : TManagedThreadClass);
  destructor Destroy(); override;
  procedure RunThreads(const Count : Cardinal);
 end;

 TForm1 = class(TForm)
   ListBox1: TListBox;
   Button1: TButton;
   Button2: TButton;
   procedure Button1Click(Sender: TObject);
   procedure Button2Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

 TTestThread = class(TManagedThread)
 private
  procedure DoWork();
 public
  procedure Execute; override;
 end;

var
 Form1: TForm1;
 Man : TThreadManager;

implementation

{$R *.dfm}

{ TThreadManager }

constructor TThreadManager.Create(const MaxThreadCount: Cardinal; ThreadClass: TManagedThreadClass);
begin
 inherited Create();
 FAvailThreads := Max(MaxThreadCount, 1);
 FThreadClass := ThreadClass;
end;

destructor TThreadManager.Destroy;
begin
 ShowMessage("Destroyed");
 inherited;
end;

procedure TThreadManager.RunThreads(const Count: Cardinal);
var
 i : Cardinal;
begin
 if (Count <= 0) then Exit;

 FThreadsToRun := Count;
 while (FAvailThreads > 0) and (FThreadsToRun > 0) do StartThread;
end;

procedure TThreadManager.StartThread;
begin
 FThreadClass.Create(Self, false);
 Dec(FAvailThreads);
 Dec(FThreadsToRun);
end;

procedure TThreadManager.ThreadTerminated;
begin
 Inc(FAvailThreads);
 if (FThreadsToRun > 0) then StartThread();
end;

{ TManagedThread }

constructor TManagedThread.Create(ThreadManager: TThreadManager; const CreateSuspended: boolean);
begin
 if not Assigned(ThreadManager) then raise Exception.Create("ManagedThread must have a thread manager");

 inherited Create(CreateSuspended);
 FManager := ThreadManager;
 OnTerminate := Terminate;
end;

procedure TManagedThread.Terminate(Sender : TObject);
begin
 Synchronize(FManager.ThreadTerminated);
end;

{ TTestThread }

procedure TTestThread.DoWork;
begin
 Form1.ListBox1.Items.Add(IntToStr(Random(High(Integer))));
end;

procedure TTestThread.Execute;
begin
 Synchronize(DoWork);
 sleep(1000);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Man := TThreadManager.Create(2, TTestThread);
 Man.RunThreads(10);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Man.Free;
end;

end.


 
Kolan ©   (2006-07-22 22:04) [5]


> theThrCounterSync.BeginWrite;

Ни какой нибудь там aThrCounterSync, а именно theThrCounterSync  - лол


 
Palladin ©   (2006-07-22 22:26) [6]


> Kolan ©   (22.07.06 22:04) [5]


Во первых не "ни", а "не". LOL (c)

Во вторых я начал использовать свое соглашение о наименованиях идентификаторов лет в 15-16 в школе, когда изучал немецкий, особенно в английском не разбираясь, и размышлял просто, a артикль неопределенный, а объект - сущность вполне определенная в RT. Да и a у меня уже была закрепленна под массивы. Менять свою привычку о наименованиях не собираюсь и по сей день.

В третьих если ты не можешь придраться по существу, то заводи ветку в "Прочее" и обсуждай мои скудные и не правильные понятия об наименовании идентификаторов там, а не здесь.


 
Kolan ©   (2006-07-22 22:31) [7]


> Во первых не "ни", а "не". LOL (c)
>

Кжется все же ни..


> объект - сущность вполне определенная

Спору нет..


> придраться

Собсно и не собирался...


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

В суботу вечером так нервничать.... не стОит :)


 
Борис К.   (2006-07-22 23:04) [8]


> ...// Управление запуском потоков
>Var i:Integer;
>Begin
> nThrCounter: =0;
> For i:=1 to 100 Do
>  Begin
>    theThrCounterSync.BeginRead;
>    While nThrCounter>=10 Do
>    Begin
>       theThrCounterSync.EndRead;
>       Sleep(100);
>       theThrCounterSync.BeginRead;
>     End;

Спасибо за идеи всем, но я почему-то думал проще через семафоры сделать... Я был не прав?


 
Palladin ©   (2006-07-22 23:12) [9]


> Борис К.   (22.07.06 23:04) [8]

Кстати, да. Они в общем то для подобных задач и существуют. Правда мороки с ними в контексте Delphi будет побольше. И кода тоже.


> Kolan ©   (22.07.06 22:31) [7]

:) Не переживай, я больше не на твой пост нервничаю, а на Call of Duty... просто в очередной раз в сердцах вышел и наткнулся на твой пост... хотя конечно по сути гнев был праведным.


 
Германн ©   (2006-07-22 23:45) [10]


> Kolan ©   (22.07.06 22:31) [7]
> > Во первых не "ни", а "не". LOL (c)
> Кжется все же ни..
>

Это только, если Кжется, а по русски как раз не. :-)


 
Пусик ©   (2006-07-23 02:19) [11]

>Palladin ©   (22.07.06 23:12) [9]

>  Правда мороки с ними в контексте Delphi будет побольше.
>  И кода тоже.


Да не особо больше мороки и кода;-)

unit Unit1;

interface

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

type
 TSemaphore=class
 private
   FSemaphore: THandle;
 public
   constructor Create(MaxThreads: Integer);
   destructor Destroy; override;
   procedure Wait;
   procedure Release;
 end;

 TThr=class(TThread)
   FSemaphore: TSemaphore;
   constructor Create(Semaphore: TSemaphore);
   procedure Execute; override;
 end;

 TForm1 = class(TForm)
   Button1: TButton;
   Label1: TLabel;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;
 Guard: TSemaphore;

implementation

{$R *.dfm}

{ TThr }

constructor TThr.Create(Semaphore: TSemaphore);
begin
 inherited Create(True);
 FSemaphore := Semaphore;
 FreeOnTerminate := True;
 FSemaphore.Wait;
 Resume;
end;

procedure TThr.Execute;
begin
 try
   Sleep(1000);
 finally
   FSemaphore.Release;
 end;
end;

{ TSemaphore }

constructor TSemaphore.Create(MaxThreads: Integer);
begin
 FSemaphore := CreateSemaphore(nil,MaxThreads,MaxThreads,nil);
end;

destructor TSemaphore.Destroy;
begin
 CloseHandle(FSemaphore);
end;

procedure TSemaphore.Release;
begin
 ReleaseSemaphore(FSemaphore,1,nil);
end;

procedure TSemaphore.Wait;
begin
 WaitForSingleObject(FSemaphore,INFINITE);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 i: Integer;
begin
 for i := 0 to 100 do
 begin
   TThr.Create(Guard);
 end;
end;

initialization
 Guard := TSemaphore.Create(10);
finalization
 Guard.Free;
end.


 
Борис К.   (2006-07-24 13:19) [12]

Чегой-то тяму не хватает тут разобраться... Первый раз с семафорами сталкиваюсь... простите уж великодушно! :-) У меня сам поток вынесен в отдельный модуль (туда ему и параметры передаются из основного потока, при создании), который по завершении не синхронизируется, а отсылает PostMessage основному потоку. Пусик, солнышко, помоги правильно акценты расставить!


 
Пусик ©   (2006-07-24 15:41) [13]


> Пусик, солнышко, помоги правильно акценты расставить!


А что не получается?
В каком месте кода пояснения нужны?


 
Борис К.   (2006-07-25 06:02) [14]

Спасибо! :-)
Где правильно определить "type TSemaphore=class, FSemaphore: THandle;, FSemaphore: TSemaphore;" ? Как я уже говорил у меня в основном потоке создаются дополнительные:

procedure RunThread(ByteVerify:Byte);
var Thr: TReadAll;
begin
 Thr := TReadAll.Create(true);
 with Thr do
 begin
   FreeOnTerminate := True;
   Priority := tpLower;
   ReadByte := ByteVerify;
   TimeOut := ReadTimeout.Value; // Spinedit
   OnTerminate := AnalyzeReads; // AnalyzeReads -> Dec(CountThreads)
   Inc(CountThreads);
   Resume;
 end;
end;

CountThreads использую в AnalyzeReads для контроля за тем все-ли потоки отработали. Как теперь правильно запустить создание потоков с семафорами, если у меня создание идет так:

var StartByte,EndByte: DWORD;
...
repeat
 RunThread(StartByte);
 Inc(PByte(DWORD(@StartByte) + 1)^);
until StartByte = EndByte;



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

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

Наверх





Память: 0.5 MB
Время: 0.112 c
2-1153731983
ps2006
2006-07-24 13:06
2006.08.13
Непростой вопрос по string


4-1145440102
GanibalLector
2006-04-19 13:48
2006.08.13
DLL в DLL(в качестве ресурса)


2-1153853273
Damager
2006-07-25 22:47
2006.08.13
Scroll + Panel


2-1153839112
WolfRamm
2006-07-25 18:51
2006.08.13
Zeos


15-1152965102
Андрей Пазик
2006-07-15 16:05
2006.08.13
Вот ТАК! нужно бороться с коррупцией





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