Всем привет!!!!!!!!!!!!
У меня такой вопрос - как можно загнать в отдельный поток определенное действие??
например:
мне нужно загнать цикл

try
begin
Yield;
application.ProcessMessages;
...........

except
.............

finally
...............

end;

в потоки
как это сделать и как определить количество потоков????
программа просто очень виснет и очень медлено выполняет действия (((((((((((
а с потоками я не рабтал

кто может мне объяснить популярно как загнать все это в поток?????

Заранее благодарю!!!!!!!!!

Вот самый простой пример. Причем без использования класса TTread.

Код

procedure MyProcedyre; // долгая процедура begin try Yield; application.ProcessMessages; ........... except ............. finally ............... end; end; procedure TForm1.Button1Click(Sender: TObject);  // запускаем поток var   h:cardinal;   begin   CreateThread(nil,128,@MyProcedyre,self,0,h);  end;

Это сообщение отредактировал(а) Poseidon - 15.1.2006, 03:46

2 Poseidon ,
спасибо, за ответ!!!!!!!!

а как определить кол-во потоков???? к пример усделать 100 потоков чтоб за один раз 100 циклов прошло?????

Экстремал Тут смотря что у тебя в потоках, нужна ли синхролизация... В общем виде можно и так так:

Код

procedure TForm1.Button1Click(Sender: TObject);  // запускаем поток var   h:cardinal;   i: integer; begin   for i:= 1 to 100 do CreateThread(nil,128,@MyProcedyre,self,0,h);  end;

но вариант не идеален. И более того, я бы для твоей задачи все же воспользовался бы TThread. Там хоть синхролизировать можно потоки. Хотя и этот вариант может прокатить

http://forum.vingrad.ru/index.php?showtopic=60076

2 Poseydon Хех... я что-то и не подумал так его пустить )))))) Спасибо, сегодня буду тестить!!!!!

2 FRAGNATIC
http://forum.vingrad.ru/index.php?showtopic=60076

Отличный материал!!!!! Спасибо!!!!!!!!!!

Цитата(Barovskiy)

application.ProcessMessages;

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

2 Albinos_x

А как лучше сделать чтоб прога не тормазила????

Цитата(Barovskiy @ 15.1.2006, 14:02 )

2 Albinos_x А как лучше сделать чтоб прога не тормазила????

так если ты запустишь это в отдельном потоке, то она и так тормозить не будет ... поэтому эта строчка автомарически должна отпасть...

у меня не компилируется ((((((

Код

procedure MyProcedyre; // долгая процедура begin try Yield; ........... except ............. finally ............... end; end;

внутри цикла я обращаюсь к компонентам например

Код

finally label2.caption:= 'Complite'; end;

как мне можно работать с компонентами внутри процедуры???
в цикле идет счет выполненых операций....

Код

Label6.Caption:=floattostr(strtofloat(Label6.Caption)+1);

вобщем ругается на все компоненты (((((((( как это лечить ??????

ты должен указать "чей компанент":

Код

... Form1.label2.caption:= 'Complite'; ...

но здесь тоже могут возникать глюки... здесь лучше делать:

Цитата(Poseidon @ 15.1.2006, 04:10 )

я бы для твоей задачи все же воспользовался бы TThread. Там хоть синхролизировать можно потоки. Хотя и этот вариант может прокатить

Цитата(Albinos_x @ 15.1.2006, 16:53 )

ты должен указать "чей компанент":

я сделал так

Код

procedure MyProcedure; var  RxLabel6: TRxLabel; .... begin ...

скопилилось почти нормально за исключением

[Warning] Unit1.pas(126): Variable 'Label6' might not have been initialized

прога запускается нормально, но как только нажимаю на кнопку для пуска потока - Вылетает ошибка

что какой то кусок памяти не может быть рид ....

как мне инициализировать - указать чей компонент ????

А как ты создаёшь этот:
var
RxLabel6: TRxLabel;
?

Цитата(Albinos_x @ 15.1.2006, 18:20 )

А как ты создаёшь этот: var RxLabel6: TRxLabel; ?

RxLabel6: TRxLabel; - RX компонент, проще говоря так

Код

procedure MyProcedure; var  Label6: TLabel; ... begin  ...

а как надо указать чей компонент???????

Цитата(Barovskiy @ 15.1.2006, 19:00 )

RxLabel6: TRxLabel; - RX компонент, проще говоря так код Pascal/Delphi procedure MyProcedure; var  Label6: TLabel; ... begin  ... а как надо указать чей компонент???????

nil
те надо
var
Label6: TLabel;
...
begin
label6:=TLabel.Create(nil);

Это сообщение отредактировал(а) FRAGNATIC - 15.1.2006, 19:16

Я сдела так

Код

procedure MyProcedure; var Label2: TLabel2; begin try  ..... except ............. finally Form1.label2.caption:= 'Complite'; end;

компилируется но не работает (((((((((((((((((((((((
тоычнее начинает работать ... а потом вылетает ошибка ((((

мой пост предыдущий читай=)

Цитата(FRAGNATIC @ 15.1.2006, 19:20 )

мой пост предыдущий читай=)

Цитата(FRAGNATIC @ 15.1.2006, 19:15 )

nil те надо var Label6: TLabel; ... begin label6:=TLabel.Create(nil);

ты имеешь ввиду все что я вписал в раздел var необходимо создать и в разделе begin?

Код

procedure MyProcedure; begin label6:=TLabel.Create(nil);  opendialog1:=TOpenDialog.Create(nil); Memo1:=TMemo.Create(nil);     try  ..... except ............. finally Form1.label2.caption:= 'Complite'; end;

что типа того?

Цитата(Barovskiy @ 15.1.2006, 19:39 )

ты имеешь ввиду все что я вписал в раздел var необходимо создать и в разделе begin?

если ты не кидал на форму не опендиалога не мемо а тока обхявил в вар
то их надо СОЗДАТь перед тем как к ним оброщатся=)
если ты кинул их на форму то их и объявлять в вар не надо=)
Добавлено @ 19:53
а в finally
надо освободить память типа
label6.Free

Цитата(FRAGNATIC @ 15.1.2006, 19:52 )

если ты не кидал на форму не опендиалога не мемо а тока обхявил в вар то их надо СОЗДАТь перед тем как к ним оброщатся=) если ты кинул их на форму то их и объявлять в вар не надо=) Добавлено @ 19:53

у меня все на форме лежит и опендиалог и мемо .... делаю так - компилирует, но когда нажимаю на кнопку запуска потока, то он вообще не реагирует, как будто у меня в кнопке ничего не прописано (((((
сама процедура выглядит типа так

Код

procedure MyProcedure; begin label6:=TLabel.Create(nil);  opendialog1:=TOpenDialog.Create(nil); Memo1:=TMemo.Create(nil);     Button1.enabled:=false;     try  ..... except ............. finally Form1.label2.caption:= 'Complite'; Button1.enabled:=true end;

а код вызов процедуры так

Код

var   h:cardinal;   begin CreateThread(nil,128,@MyProcedure,self,0,h);

никакой реакции
у меня даже кнопока остается активной, хотя в процедуре прописано Button1.enabled:=false;
(((((
Добавлено @ 20:15

Цитата(FRAGNATIC @ 15.1.2006, 19:52 )

Добавлено @ 19:53 а в finally надо освободить память типа label6.Free

Память в конце обязательно освобождаю, с самого начала ))))

Цитата(Barovskiy @ 15.1.2006, 20:09 )

у меня все на форме лежит и опендиалог и мемо

зачем тогда их в вар объявять? они и так уже объявлены и создаются в том случаии если создана форма =)

Цитата(FRAGNATIC @ 15.1.2006, 20:16 )

зачем тогда их в вар объявять? они и так уже объявлены и создаются в том случаии если создана форма =)

всеравно не работает ((((( уже пробовал

все компилируется а работать не хочет .....
есть ли какойнибудь пример на эту тему, рабочий пример ???...
или всетаки попробовать через TThreads сделать?

Цитата(Barovskiy @ 15.1.2006, 21:10 )

все компилируется а работать не хочет ..... есть ли какойнибудь пример на эту тему, рабочий пример ???... или всетаки попробовать через TThreads сделать?

мы тут не телепаты... код покажи...

Цитата(Barovskiy @ 15.1.2006, 20:09 )

Память в конце обязательно освобождаю, с самого начала ))))

какого начала?
финали это уже конец =)
не нравится так освобожда в другом месте тока ОДНО НО
любые переменые объявленые в ВАР любой из функций, процедуры
являются локальными и
уничтожаются в конце выполнения этой процедуры
тоесть

Цитата(Barovskiy @ 15.1.2006, 20:09 )

procedure MyProcedure; begin label6:=TLabel.Create(nil);  opendialog1:=TOpenDialog.Create(nil); Memo1:=TMemo.Create(nil);     Button1.enabled:=false;     try  ..... except ............. finally Form1.label2.caption:= 'Complite'; Button1.enabled:=true end;

после твоего end; Memo1 и так уже существовать не будет=)
так что если хош с ними работать и дальше где-то то надо их сделать глобальными перемеными а не локальными чисто для данной процедуры
Добавлено @ 22:17
гы в том коде что я ща процетировал у тя ваще переменых нету
выще они были в этойже ф-е)

Цитата(FRAGNATIC @ 15.1.2006, 22:15 )

какого начала? финали это уже конец =)

Я имел ввиду ссамого начала создания самого проекта , гы .... ))))))))

Цитата(Albinos_x @ 15.1.2006, 22:07 )

мы тут не телепаты... код покажи...

Щас попробую обяснить что я хочу сделать и че получается:-))))

У меня была фрома, на ней компонены, мемо , опендиалог, лейблы ... логмемо, кнопки старт стоп в общем все компоненты которые нужны

я выбираю в опен диалог текстовый файл в котором у меня ip адреса и мне надо получить их имена, у нас в сетке больше 120 компов, и мне нада составить список какой ip кому принадлежит ....

при нажатии на кнопку у меня запускается цикл ... и пока не конец файла он проверяет все ip, т.е. читает строку в файле пингует его возвращает ответ в log
так вся эта бадяга виснет ... и очень долго идет проверка, поэтому я хочу вогнать этот кусок проверки в поток .....

вот кусок того что было

Код

var   s: TStrings;   d, i: integer; //  stop: boolean; // объявлена глобальной вверху поэтому отсюда убрал ее begin if filepath.Text<>'' then begin  // filepath - это обычный эдит   s := TStringList.Create;   Label1.Caption:='0'; Label4.Caption:='0'; Label6.Caption:='0'; Label8.Caption:='0'; Label11.Caption:='0'; Button1.Enabled:=false;  stop:= false;     try     s.LoadFromFile (OpenDialog1.FileName);       for d := 0 to s.Count -1 do begin       label1.Caption:= floattostr(strtofloat(label1.Caption)+1); // пересчитываю сколько всего есть ip адресов       end;    for i := 0 to s.Count - 1 do begin  //  проверка для того чтоб запустить цикл    if Stop=true then Break;    application.ProcessMessages;   edit1.Text := Copy (s[i],1, pos( '', s[i]) -1 );          Label4.Caption:=floattostr(strtofloat(Label4.Caption)+1);       application.ProcessMessages;       label9.Caption:='Идет проверка IP'+edit1.Text ;       memo1.Lines.Add('Проверка  '+Edit1.Tex);        try   // запускаю сам цикл         begin   ..........  // тут проверяю ip и записываю имя ip   except         memo1.Lines.Add('Воткни кабель в сетевуху ...');  //  АшЫпКа .......... finally     s.Free;     label9.Caption:='Complite';     Label4.Caption:='0';     Button1.Enabled:=true;     memo1.Lines.SaveToFile('Log.txt');   end;

потом как мне отпостили выше я переделал в такой вариант

Код

procedure ChecIP; var   s: TStrings;   d, i: integer; begin // тут пошел список создания ... хотя все это есть на морде ...  form1.filepath:= TPDJXPEdit.Create(nil);     form1.SpeedButton1:= TSpeedButton.Create(nil);     form1.RxLabel1:= TRxLabel.Create(nil);     form1.Edit1:= TEdit.Create(nil);     form1.Edit2:= TEdit.Create(nil);     form1.Edit3:= TEdit.Create(nil);   // кароче все что можно было я сюда впихнул  // НИЖЕ ВСЕ что было  if filepath.Text<>'' then begin  // filepath - это обычный эдит   s := TStringList.Create;   Label1.Caption:='0'; Label4.Caption:='0'; Label6.Caption:='0'; Label8.Caption:='0'; Label11.Caption:='0'; Button1.Enabled:=false;  stop:= false;     try     s.LoadFromFile (OpenDialog1.FileName);       for d := 0 to s.Count -1 do begin       label1.Caption:= floattostr(strtofloat(label1.Caption)+1); // пересчитываю сколько всего есть ip //адресов       end;    for i := 0 to s.Count - 1 do begin  //  проверка для того чтоб запустить цикл    if Stop=true then Break; //     application.ProcessMessages;   edit1.Text := Copy (s[i],1, pos( '', s[i]) -1 );          Label4.Caption:=floattostr(strtofloat(Label4.Caption)+1);       application.ProcessMessages;       label9.Caption:='Идет проверка IP'+edit1.Text ;       memo1.Lines.Add('Проверка  '+Edit1.Tex);        try   // запускаю сам цикл         begin   ..........  // тут проверяю ip и записываю имя ip   except         memo1.Lines.Add('Воткни кабель в сетевуху ...');  //  АшЫпКа .......... finally     s.Free;     label9.Caption:='Complite';     Label4.Caption:='0';     Button1.Enabled:=true;     memo1.Lines.SaveToFile('Log.txt');   end;

ну самf кнопка, которая вызывает поток

Код

procedure TForm1.Button1Click(Sender: TObject); var   h:cardinal;   begin CreateThread(nil,128,@ChekIP,self,0,h); end;

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

Код

Button1.Enabled:=false;  stop:= false;

кнопка так и остается доступной....
а если вырубить прогу... то такое начинается...
Добавлено @ 23:33

Цитата(FRAGNATIC @ 15.1.2006, 22:15 )

гы в том коде что я ща процетировал у тя ваще переменых нету выще они были в этойже ф-е)

Я их убрал из вара

Цитата(Barovskiy @ 15.1.2006, 23:26 )

кнопка так и остается доступной.... а если вырубить прогу... то такое начинается..

это скорее всего из-за:

Цитата(Barovskiy @ 15.1.2006, 23:26 )

// тут пошел список создания ... хотя все это есть на морде ...  form1.filepath:= TPDJXPEdit.Create(nil);     form1.SpeedButton1:= TSpeedButton.Create(nil);     form1.RxLabel1:= TRxLabel.Create(nil);     form1.Edit1:= TEdit.Create(nil);     form1.Edit2:= TEdit.Create(nil);     form1.Edit3:= TEdit.Create(nil);

компаненты уже существуют, поэтому генерируется ошибка, код завершается без обработки:

Цитата

finally     s.Free;     label9.Caption:='Complite';     Label4.Caption:='0';     Button1.Enabled:=true;     memo1.Lines.SaveToFile('Log.txt');   end;

т.к. блок try идёт после...

Цитата

application.ProcessMessages;

выкинь нафиг эту строку наконец... в потоке будет генерироваться ошибка...

Цитата(Albinos_x @ 15.1.2006, 23:42 )

выкинь нафиг эту строку наконец... в потоке будет генерироваться ошибка...

эту фигню я уже выкинул ....

просто код скопировал со старой версии .. .
а в потоке ее нету уже.....
Добавлено @ 00:36

Цитата(Albinos_x @ 15.1.2006, 23:42 )

компаненты уже существуют, поэтому генерируется ошибка, код завершается без обработки:

я убрал все.............. и при нажатии на кпопку вылетает ошибка после чего прога закрывается.....

вот тебе простенький пример(который у меня работает):

Код

Procedure Pack; var i,j:word; begin form1.ListBox1.Clear; form1.SpeedButton1.Enabled:=true; SetLength(TypFile,0); // поиск файлов в папке и запись адресов в массив типа запись // функция моя так что её не ищи в делфи RecTabAddFull(form1.DirectoryListBox1.Directory,TypFile); i:=Length(TypFile); for j:=0 to i-1 do    begin    form1.ListBox1.Items.Add(TypFile[j].rtFileName)    end; form1.edit1.text:=''; // запись файлов в другую папку // тоже функция моя if not RecordFileC(form1.DirectoryListBox2.Directory+'\Test.chid', TypFile) then    begin    form1.ListBox2.Items.Add('Error/');    MessageBox(0, 'произошла ошибка. Файл не создан.', 'Test', MB_OK or MB_ICONERROR)    end    else    begin    form1.ListBox2.Items.Add('Complit/');    MessageBox(0, 'Файл создан.', 'Test', MB_OK or MB_ICONINFORMATION);   end; end;

запуск:

Код

procedure TForm1.SpeedButton1Click(Sender: TObject); var  hh:Dword; begin CreateThread(nil,0,@Pack,nil,0,hh); end;

т.к. это пример поэтому расписывать написанные и используемые мной функции не стал

Это сообщение отредактировал(а) Albinos_x - 16.1.2006, 00:45

Цитата(Albinos_x @ 15.1.2006, 23:42 )

это скорее всего из-за:

вот так везде поставил

Код

....  try      s.LoadFromFile (Form1.OpenDialog1.FileName);       for d := 0 to s.Count -1 do begin       Form1.label1.Caption:= floattostr(strtofloat(Form1.label1.Caption)+1);       end;    for i := 0 to s.Count - 1 do begin    if Stop=true then Break; .....

указал пренадлежность каждого компонента....
убрал из вара и все вот это

Цитата(Albinos_x @ 15.1.2006, 23:42 )

Цитата(Barovskiy @ 15.1.2006, 23:26 ) // тут пошел список создания ... хотя все это есть на морде ...  form1.filepath:= TPDJXPEdit.Create(nil);     form1.SpeedButton1:= TSpeedButton.Create(nil);     form1.RxLabel1:= TRxLabel.Create(nil);     form1.Edit1:= TEdit.Create(nil);     form1.Edit2:= TEdit.Create(nil);     form1.Edit3:= TEdit.Create(nil);

вывалшивает ошибку ((((((( не хочет запускать поток (((((((((

Цитата(Barovskiy @ 16.1.2006, 00:26 )

я убрал все.............. и при нажатии на кпопку вылетает ошибка после чего прога закрывается.....

что говорит пошаговая отладка? на какой строчке ошибка?

Цитата(Albinos_x @ 16.1.2006, 00:47 )

что говорит пошаговая отладка? на какой строчке ошибка?

Отладка виснет как только нажимаю на кнопку старт ... дельфи умирает просто ..... ((((((
ВОт ошибки

The exception unknown software exception (0x0eedfade) occured at location 0x77e738b2

System Error. Code 1400
Invalid window handle


наверное я сегодня забыл руки с зада вытащить и поставить их в плечи....

Цитата(Barovskiy @ 16.1.2006, 01:09 )

Invalid window handle

ищи где даёшь неправильный хандле...

Цитата(Barovskiy @ 16.1.2006, 01:09 )

Отладка виснет как только нажимаю на кнопку старт

а через F7?

Access violation at address 00493E11 in module 'IptoName.exe'. Read of address 00000000

вот еще

Цитата

The exception unknown software exception (0x0eedfade) occured at location 0x77e738b2 System Error. Code 1400 Invalid window handle

Цитата

Access violation at address 00493E11 in module 'IptoName.exe'. Read of address 00000000

ну мне это толком ничего не говорит... я не видел кода... и не знаю на каких строчках вылетает ошибка...

Цитата(Albinos_x @ 16.1.2006, 01:25 )

ищи где даёшь неправильный хандле...

даже и не знаю где это может быть (((((((((((( все правильно вродебы.....
Добавлено @ 01:46
Сделал так на кнопке

Код

for i:= 1 to 10 do CreateThread(nil,128,@ChekIP,self,0,h);

выволилось вот это

Connection close gracesfull


F7 тоже не получается

Это сообщение отредактировал(а) Barovskiy - 16.1.2006, 01:48

а как тебе писали не пробовал?

Код

CreateThread(nil,128,@ChekIP,nil,0,h);

Добавлено @ 02:12
посмотри ещё здесь

Цитата(Albinos_x @ 16.1.2006, 02:02 )

а как тебе писали не пробовал?

пробовал ... вываливались те ошибки, а потом увеличил потоки .....


скорей всего я чето не так написал, компилится но вызывает ошибки при запуске ....

Цитата(Barovskiy @ 16.1.2006, 01:37 )

F7 тоже не получается

что не получается?
на какой строчке?
Добавлено @ 02:17

Цитата(Barovskiy @ 16.1.2006, 02:15 )

компилится но вызывает ошибки при запуске

смотри событие OnFormCreate()

Цитата(Albinos_x @ 16.1.2006, 02:02 )

посмотри ещё здесь

Спасибо!!! буду смотреть !


кажись разобрался....
точнее не разобрался пока еще, я переписал все заного и у меня заработало!!!!! в чем я допустил ошибку пока не знаю ... но факт что работает!!!!
прога не виснет все делает нормально!!!!!!!!!
НО
после того как все сделано и я закрываю прогу опять выпригивает ошибка

The exception unknown software exception (0x0eedfade) occured at location 0x77e738b2

System Error. Code 1400
Invalid window handle

По крайней мере уже легче!!!!!!!!!!!!!!
Добавлено @ 02:34

Цитата(Albinos_x @ 16.1.2006, 02:15 )

смотри событие OnFormCreate()

у меня там ничего нету
пусто )))
ошибка вылетает если я хоть раз нажал на кнопку
а если открыть и закрыть то ничего не выскакивает ....
это в потоке чтото происходит.....
отладчик вообще не хочет работать.... виснет ужасно ...

Хм... как всё запущено.
Документацию и статьи, видимо, не полностью прочитаны или невнимательно.

Пока будешь использовать VCL в доп. потоке без синхронизации, так и будут у тебя ошибки при выполнении.
Ни один из приведенных примеров нормально также не избавлен от этих ошибок.

Кроме того, нужно использовать не CreateThread, а BeginThread, либо самому добавлять строку IsMultiThread := TRUE;

Цитата(Демо @ 16.1.2006, 04:54 )

Хм... как всё запущено. Документацию и статьи, видимо, не полностью прочитаны или невнимательно.

Читал я полностью, возможно не внимательно... я все заного перепроверю...

Цитата(Демо @ 16.1.2006, 04:54 )

Пока будешь использовать VCL в доп. потоке без синхронизации, так и будут у тебя ошибки при выполнении. Ни один из приведенных примеров нормально также не избавлен от этих ошибок.

Каким образом мне сделать синхронизацию VCL ????

Цитата(Демо @ 16.1.2006, 04:54 )

Кроме того, нужно использовать не CreateThread, а BeginThread, либо самому добавлять строку IsMultiThread := TRUE;

Поставил CreateThreads - таже ошибка вылетает просле закрытия прогрммы...
Где необходимо вписать IsMultiThread := TRUE;
????

Guest

Сформулируй, пожалуйста, требования к программе по порядку. Не надо с конкретным кодом. ПРосто словами - что она должна делать, как отображать данные.
В таком длинном топике уже все разнесено по всему треду, и не найдешь, что же конкретно нужно сделать.

Для синхронизации с VCL надежно работает метод Synchronize
Класса Thread - это самый простой способ если синхронизация происходит достаточно редко.

Демо
Предыдущий пост был моим, не вошел под пользователем.... (((((((

Цитата(Демо @ 16.1.2006, 12:59 )

Сформулируй, пожалуйста, требования к программе по порядку. Не надо с конкретным кодом. ПРосто словами - что она должна делать, как отображать данные. В таком длинном топике уже все разнесено по всему треду, и не найдешь, что же конкретно нужно сделать.

Дело вот в чем - открываю программу, в опендиалог выбираю текстовый файл в котором прописаны IP адреса моей локалки, загружаю в прогу, и пока не конец файла
прога читает строчку в файле, пингует IP адрес, возвращает ответ с именем компа записывает в текствоый файл, плюс весь лог подключений(всех действий) записывается в log.txt

Работало все нормально, только жутко все висло, сделал поток и всё событие кнопки старт перенес в поток, а в кнопке страт указал создание потока.

Работает, но после того как прога закрывается то вылетает ошибка.
Отладчик не пашет вообще, виснет по страшному, кода я нажимаю старт (((( и не возможно посмотреть на какой строчке

И еще вопрос - как сделать не один поток а несколько??? к примеру 10
чтоб за один раз создавало 10 отдельных потоков?
for i:=0 to 10 do ... не работает ...
вылетает тоже ошибка.
Добавлено @ 13:10

Цитата(alexeis1 @ 16.1.2006, 13:07 )

Для синхронизации с VCL надежно работает метод Synchronize Класса Thread - это самый простой способ если синхронизация происходит достаточно редко.

а пример можно ??? как это правильней сделать???

Цитата

Работает, но после того как прога закрывается то вылетает ошибка

Вероятно неверно завершается поток (очень частая ошибка)

Цитата(alexeis1 @ 16.1.2006, 13:12 )

ероятно неверно завершается поток smile (очень частая ошибка)

Хех, верно.... но как его завершить????

никак. поставь FreeOnTerminate в true и он сам остановится
Добавлено @ 13:39
точнее умрет

я не очень понял какой вариант использования потоков используется.
Если Делфийский то вызов Terminate затем ожидание завершения
Waitfor затем освобождение памяти.

Цитата(_hunter @ 16.1.2006, 13:39 )

никак. поставь FreeOnTerminate в true и он сам остановится Добавлено @ 13:39 точнее умрет

сделал так

Код

var  ...   FreeOnTerminate: boolean; .... finally   FreeOnTerminate:=true;

все равно вылетает

Цитата(alexeis1 @ 16.1.2006, 13:41 )

я не очень понял какой вариант использования потоков используется. Если Делфийский то вызов Terminate затем ожидание завершения Waitfor затем освобождение памяти.

У меня дельфийский медот
Можно какойнить пример??? я не совсем понимаю куда писать

Поставь FreeOnTerminate в начале кода.
Т.е.:

Код

procedure TMyThread.Execute; begin   FreeOnTerminate := true;   //Дальше твой код end;

И еще, когда создаешь поток (может это уже было написано, но я повторю), нужно делать вот так:

Код

MyThread := TMyThread.Create(false); //Именно false, а не true, когда с FreeOnTerminate работаешь.

а это:

Цитата(Barovskiy @ 16.1.2006, 12:57 )

var ...   FreeOnTerminate: boolean;

зачем?
FreeOnTerminate это свойствр класса TThread...

Код

tr.Terminate;         tr.WaitFor;         tr.Free;         tr := nil;

Добавлено @ 14:15
Кроме того в потоке нужно перодически проверять
свойстро terminated если оно true то закончить работу потоковой процедуры.(выйти)

Выкладываю код ... у меня едит крыша, я совсем запутался.... (((((((((

Код

procedure ChekIp; var   s: TStrings;   d, i: integer;   FreeOnTerminate: boolean; begin FreeOnTerminate := true;                              if Form1.filepath.Text<>'' then begin   s := TStringList.Create;   Form1.Label1.Caption:='0'; Form1.Label4.Caption:='0'; Form1.Label6.Caption:='0'; Form1.Label8.Caption:='0'; Form1.Label11.Caption:='0'; Form1.Button1.Enabled:=false;  Form1.label9.Caption:='Begin';  stop:= false;  Form1.label6.Font.Color:= clBlack ;   try      s.LoadFromFile (Form1.OpenDialog1.FileName);       for d := 0 to s.Count -1 do begin       Form1.label1.Caption:= floattostr(strtofloat(Form1.label1.Caption)+1);       end;    for i := 0 to s.Count - 1 do begin    if Stop=true then Break;   Form1.edit1.Text := Copy (s[i], 1, Pos ('', s[i]) - 1);     Form1.Label4.Caption:=floattostr(strtofloat(Form1.Label4.Caption)+1);       Form1.label9.Caption:='Checking...';               try         begin                            //  Yield;      .....        except         on E: Exception do         begin         Form1.memo1.Lines.Add(E.Message);         Form1.Edit3.Text:=(E.Message);         end;        end;     if Form1.edit3.Text='Socket Error # 11001'+#13#10+'Host not found.' then     begin    Form1.label9.Caption:='Host not found...';    Form1.memo1.Lines.add(Form1.edit3.Text);    Form1.memo1.Lines.SaveToFile('Log.txt');     break;     end else     ...........   finally     s.Free;     Form1.label9.Caption:='Complite';     Form1.Label4.Caption:='0';     Form1.Button1.Enabled:=true;     Form1.memo1.Lines.SaveToFile('Log.txt');     FreeOnTerminate:= true;   end; ChekIp.Terminate;          end; end;

а вот сама кнопка

Код

procedure TForm1.Button1Click(Sender: TObject); var h:cardinal; ChekIp :TThread; begin BeginThread(nil,128,@ChekIp,self,0,h); ChekIp := TThread.Create(false); end;

все работает, но вылетает ошибка когда закрываю прогу....
вот исходник, что я там не так сделал????
у меня уже голова кругом идет (((((

Можешь использовать как шаблон для реализации своего потока вот этот код:

Код

{ Модуль uGetHTTPThread Выполнение запроса HTTP GET в отдельном потоке с возможностью повторного использования. Ведется учет количества потоков Требования - установленный Indy10  (c) Демо Специально для Sources.ru (2005) Пример использования: procedure TForm1.Button1ClickSender: TObject); var   s: String; begin   with TGetHTTP.Create do   begin     OnComplete := Complete;     Get('http://www.sources.ru');   end;   with TGetHTTP.Create do   begin     OnComplete := Complete;     Get('http://localhost');   end; procedure TForm1.Complete(Sender: TGetHTTP; var Action: TActionHTTPThread); begin   Memo1.Lines.Add('Complete');   Memo1.Lines.Add(Sender.Result.RecvStr);   Action := ahFree; end; } unit uGetHttpThread; interface uses   windows,classes, SysUtils, idHTTP, idLogDebug, idComponent, idGlobal,IdIOHandler,   IdIOHandlerSocket, IdIOHandlerStack,  IdIntercept,idException; var   ThrList: TThreadList; type //Состояние потока   TStateHTTPThread=(shNone,shReady,shComplete,shWork); //Действие при обработке OnComplete   TActionHTTPThread=(ahNone,ahFree);   TGetHTTP=class;   TCompleteQuery=procedure(Sender: TGetHTTP; var Action:TActionHTTPThread) of Object;   TProgressQuery=procedure(Sender: TGetHTTP; aReadCount,aSendCount: Integer) of Object; //Структура, заполняемая в потоке.   THTTPRec=record     Query: String;              //Запрос в виде http://url     ErrorMsg: String;           //Результатт в текстовом виде     ErrorCode: Integer;         //Результат в числовом виде     RecvStr: String;            //Принятая строка(полностью с заголовком)     SendStr: String;            //Отосланная строка     CountSend: Integer;         //Количество отосланных байт     CountRcv: Integer;          //Количество принятых байт     Page: String;               //Возвращенная страница(без заголовка)   end; //Собственно, сам поток   TGetHTTP=class(TThread)   private     FCS: RTL_CRITICAL_SECTION;     FH: TidHTTP;     FL: TidLogDebug;     FS: TIdIOHandlerStack;     FTimeOut: Integer;     FQuery: String;     FResult: THTTPRec;     FState: TStateHTTPThread;     FOnComplete: TCompleteQuery;     FOnProgress: TProgressQuery;     procedure FComplete;     procedure FProgress;     procedure FHWork(ASender: TObject; AWorkMode: TWorkMode;       AWorkCount: Integer);     procedure FLReceive(ASender: TIdConnectionIntercept;       var ABuffer: TBytes);     procedure FLSend(ASender: TIdConnectionIntercept;       var ABuffer: TBytes);     function GetTimeOut: Integer;     procedure SetTimeOut(const Value: Integer);     procedure Lock;     procedure Unlock;     function GetFResult: THTTPRec;   protected     procedure Execute; override;   public     constructor Create;     destructor Destroy; override;     procedure Free;     procedure Release;     procedure Get(const Query: String);     property OnComplete: TCompleteQuery read FOnComplete write FOnComplete;     property OnProgress: TProgressQuery read FOnProgress write FOnProgress;     property Result: THTTPRec read GetFResult;     property State: TStateHTTPThread read FState;     property TimeOut: Integer read GetTimeOut write SetTimeOut;   end; //Получение максимального количества потоков function GetMaxThreads: Integer; //Установка максимального количества потоков procedure SetMaxThreads(aMaxThreads: Integer=10); //завершение всех потоков и очистка списка procedure TerminateAllThreads; //Завершение конкретного потока procedure ReleaseThread(Thread:TGetHTTP); //Получение количества потоков в списке function CheckCountThreads: Integer; implementation var //Максимальное количество потоков - недоступно из других модулей напрямую   MaxThreads: Integer; { TGetHTTP } constructor TGetHTTP.Create; begin   if CheckCountThreads=GetMaxThreads then raise Exception.Create('Can''t create thread. MaxThreads='+IntToStr(MaxThreads));   inherited Create(True);   FreeOnTerminate := False;   FState := shNone;             //Поток еще не готов принять запрос   with ThrList.LockList do      //Добавляем поток в список   try     Add(Self);   finally     ThrList.UnlockList;   end;   TimeOut := 30000;   InitializeCriticalSection(FCS);   Resume; end; destructor TGetHTTP.Destroy; begin   FH.Free;   FS.Free;   FL.Free;   DeleteCriticalSection(FCS); end; procedure TGetHTTP.Execute; begin   FH := TidHTTP.Create(nil);   FL := TidLogDebug.Create(nil);   FS := TIdIOHandlerStack.Create(nil);   FS.Intercept := FL;   FH.IOHandler := FS;   FL.Active := True;   FH.OnWork := FHWork;   FL.OnReceive := FLReceive;   FL.OnSend := FLSend;   FState := shReady;   if FQuery='' then Suspend;    //Запрос пустой - засыпаем   try     while not Terminated do     begin       FState := shWork;           //Поток занят       FResult.Query := FQuery;       FResult.ErrorMsg := '';       FResult.ErrorCode := 0;       FResult.RecvStr := '';       FResult.SendStr := '';       FResult.CountSend := 0;       FResult.CountRcv := 0;       FResult.Page := '';       FQuery := '';       try         FH.ReadTimeout := TimeOut;       //Таймаут         FResult.Page := FH.Get(FResult.Query);         FResult.ErrorMsg := FH.ResponseText;         FResult.ErrorCode := FH.ResponseCode;       except         on e: Exception do         begin           FResult.ErrorMsg := e.Message;           FResult.ErrorCode := -1;         end;       end;       FState := shComplete;       //Поток закончил выполнение запроса       Synchronize(FComplete);     //Сообщаем пользователю       if not Terminated then Suspend;     end;   finally     ReleaseThread(Self);   end; end; procedure TGetHTTP.FComplete; var   Action: TActionHTTPThread; begin   Action := ahNone;   if Assigned(FOnComplete) then FOnComplete(Self,Action);   if Action = ahFree     then  Terminate;//ReleaseThread(Self)    //Завершаем поток //    else Suspend;               //Засыпаем снова - до следующего запроса end; procedure TGetHTTP.FHWork(ASender: TObject; AWorkMode: TWorkMode;   AWorkCount: Integer); begin //Увеличиваем соответствующий счетчик   Lock;   try     case AWorkMode of       wmRead: FResult.CountRcv := FResult.CountRcv + AWorkCount;       wmWrite: FResult.CountSend := FResult.CountSend + AWorkCount;     end;   finally     Unlock;   end;   Synchronize(FProgress); end; procedure TGetHTTP.FLReceive(ASender: TIdConnectionIntercept;   var ABuffer: TBytes); var   s: String; begin //  Добавляем в буфер полученную информацию   SetLength(s,Length(ABuffer));   Move(ABuffer[0],s[1],Length(ABuffer));   FResult.RecvStr := FResult.RecvStr + s; end; procedure TGetHTTP.FLSend(ASender: TIdConnectionIntercept;   var ABuffer: TBytes); var   s: String; begin //  Добавляем в буфер отправленную информацию   SetLength(s,Length(ABuffer));   Move(ABuffer[1],s[1],Length(ABuffer));   FResult.SendStr := FResult.SendStr + s; end; procedure TGetHTTP.Free; begin //заменяем процедуру Free на нашу   Release; end; procedure TGetHTTP.Get(const Query: String); var   i: Integer; begin //Проверяем, закончена ли предыдущая обработка.   if (FState=shComplete) or (FState=shWork)     then raise Exception.Create('Error state thread'); //Если поток еще только стартует - ожидаем.   i := 100;   while FState<>shReady do   begin     Sleep(10);     //Слишком долго поток не переходит в статус shReady     if i<0 then raise Exception.Create('Unknown error');     Dec(i,10);   end;   FQuery := Query; //Будим поток для выполнения запроса   Resume; end; function TGetHTTP.GetTimeOut: Integer; begin   Result := InterlockedExchange(FTimeOut,FTimeOut); end; procedure TGetHTTP.SetTimeOut(const Value: Integer); begin   InterlockedExchange(FTimeOut,Value); end; procedure TGetHTTP.Release; begin   FreeOnTerminate := True;      //Переводим в состояние автоуничтожения   Terminate;                    //Взводим флаг Terminated   Resume;                       //Будим поток для завершения end; procedure TerminateAllThreads; var   i: Integer; begin   with ThrList.LockList do   try     for i := 0 to Count-1 do     begin       try         TGetHTTP(Items[i]).Release;       except       end;     end;   finally     ThrList.UnlockList;   end; end; //Получить максимальное количество потоков. function GetMaxThreads: Integer; begin   Result := InterlockedExchange(MaxThreads,MaxThreads); end; //Установить максимальное количество потоков. procedure SetMaxThreads(aMaxThreads: Integer=10); var   CurrValue: Integer; begin   CurrValue := InterlockedExchange(MaxThreads,MaxThreads);   if CurrValue>aMaxThreads then   InterlockedExchange(MaxThreads,aMaxThreads); end; //Получить теккущее количество потоков function CheckCountThreads: Integer; begin   with ThrList.LockList do   try     Result := Count;   finally     ThrList.UnlockList;   end; end; //Завершить поток procedure ReleaseThread(Thread:TGetHTTP); var   i:Integer; begin   with ThrList.LockList do   try     for i := 0 to Count-1 do     begin       try         if TGetHTTP(Items[i])=Thread then         begin           TGetHTTP(Items[i]).Free;           Delete(i);           break;         end;       except       end;     end;   finally     ThrList.UnlockList;   end; end; procedure TGetHTTP.Lock; begin   EnterCriticalSection(FCS); end; procedure TGetHTTP.Unlock; begin   LeaveCriticalSection(FCS); end; procedure TGetHTTP.FProgress; var   r,s: Integer; begin   if Assigned(FOnProgress) then   begin     Lock;     try       r := FResult.CountRcv;       s := FResult.CountSend;     finally       Unlock;     end;     FOnProgress(Self,r,s);   end; end; function TGetHTTP.GetFResult: THTTPRec; begin   Lock;   try     Result := FResult;   finally     Unlock;   end; end; initialization   MaxThreads := 10;   ThrList := TThreadList.Create; finalization   TerminateAllThreads;   ThrList.Free; end.

Пример использования:

Код

unit ufMain; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,   IdTCPClient, IdHTTP, IdIntercept, IdLogBase, IdLogDebug, idGlobal,   IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, uGetHttpThread,   IdTelnet, IdMessageCoder, IdMessageCoderMIME; type   TForm1 = class(TForm)     Button1: TButton;     IH: TIdHTTP;     IL: TIdLogDebug;     Memo1: TMemo;     IdIOHandlerStack1: TIdIOHandlerStack;     Button2: TButton;     procedure Button1Click(Sender: TObject);     procedure ILReceive(ASender: TIdConnectionIntercept;       var ABuffer: TBytes);     procedure Button2Click(Sender: TObject);   private     { Private declarations }   public     procedure Complete(Sender: TGetHTTP; var Action:TActionHTTPThread);     procedure Progress(Sender: TGetHTTP; aReadCount,aSendCount: Integer);     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); begin   with TGetHTTP.Create do   begin     OnComplete := Complete;     OnProgress := Progress;     Get('http://www.rambler.ru');   end; end; procedure TForm1.Complete(Sender: TGetHTTP; var Action: TActionHTTPThread); begin   Memo1.Lines.Add('Complete'); //  Memo1.Lines.Add(Sender.Result.RecvStr);   Memo1.Lines.Add('Всего принято: '+IntToStr(Sender.Result.CountRcv));   Memo1.Lines.Add('Всего отправлено: '+IntToStr(Sender.Result.CountSend));   Action := ahFree; end; procedure TForm1.ILReceive(ASender: TIdConnectionIntercept;   var ABuffer: TBytes); var   s: String; begin   SetLength(s,Length(ABuffer));   Move(ABuffer[1],s[1],Length(ABuffer));   Memo1.Lines.Add(s); end; procedure TForm1.Button2Click(Sender: TObject); begin   Memo1.Lines.Add(IntToStr(CheckCountThreads)); end; procedure TForm1.Progress(Sender: TGetHTTP; aReadCount,   aSendCount: Integer); begin   Memo1.Lines.Add('Принято: '+IntToStr(aReadCount)+' / Отправлено: '+IntToStr(aSendCount)); end; end.

Заодно можешь вот этот топик почитать:

http://forum.sources.ru/index.php?showtopic=120033

Цитата

ChekIp := TThread.Create(false);

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

Код

TWorkThread = Class(TThread)                  public                    Procedure test;                  protected                    procedure Execute; override;   end;

код ChekIp поместить в Execute
а вот это

Цитата

BeginThread(nil,128,@ChekIp,self,0,h); ChekIp := TThread.Create(false);

создает целых два потока различными методами


Это сообщение отредактировал(а) alexeis1 - 16.1.2006, 15:32

Цитата(Barovskiy @ 16.1.2006, 13:08 )

И еще вопрос - как сделать не один поток а несколько??? к примеру 10 чтоб за один раз создавало 10 отдельных потоков?

я не знаю как ты там пинингуешь, но не думал о том что на один порт хочешь послать инфу с 10 потоков?...
И читать из одного файла 10 потоками... 9 из них сразу же обрушатся (это конечно симотря как читаешь)...

Цитата(Демо @ 16.1.2006, 15:22 )

Можешь использовать как шаблон для реализации своего потока вот этот код:

Спасибо, буду разбираться

Цитата(alexeis1 @ 16.1.2006, 15:29 )

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

у меня в примере нету этого .... все равно вылетает ...


Как вот мне мой код оптимизировать чтоб нормально было ... и потоков много было ....
мне мой код ктонибуль может показать что исправить по конкретнее....
Добавлено @ 15:51

Цитата(Albinos_x @ 16.1.2006, 15:35 )

я не знаю как ты там пинингуешь, но не думал о том что на один порт хочешь послать инфу с 10 потоков?... И читать из одного файла 10 потоками... 9 из них сразу же обрушатся (это конечно симотря как читаешь)...

так и есть .... читаю одну строку ... а остальные просто рушаться... и опять ошибка...

может менять порты при создании трейда????

Barovskiy

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

Демо

Вот функиции


а вот что в цикле

тогда без Class(TThread) и синхронизации не обойтись

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

В аналогичных примерах я поглядел, но так и не понял как все этоприменить к моему примеру

Barovskiy

Т.е., судя по коду, ты хочешь просто получить имя компьютера из DNS, неважно, включен он или нет?

что-то типа того, но включен он илинет этоне важно, ответ просто пустой....