Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Общие вопросы > Threads

Автор: Barovskiy 15.1.2006, 02:43

Всем привет!!!!!!!!!!!! У меня такой вопрос - как можно загнать в отдельный поток определенное действие?? например: мне нужно загнать цикл try begin Yield; application.ProcessMessages; ........... except ............. finally ............... end; в потоки как это сделать и как определить количество потоков???? программа просто очень виснет и очень медлено выполняет действия ((((((((((( а с потоками я не рабтал кто может мне объяснить популярно как загнать все это в поток????? Заранее благодарю!!!!!!!!!

Автор: Poseidon 15.1.2006, 03:45

Вот самый простой пример. Причем без использования класса 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;

Автор: Barovskiy 15.1.2006, 03:57

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

Автор: Poseidon 15.1.2006, 04:10

Экстремал Тут смотря что у тебя в потоках, нужна ли синхролизация... В общем виде можно и так так: Код 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. Там хоть синхролизировать можно потоки. Хотя и этот вариант может прокатить

Автор: FRAGNATIC 15.1.2006, 04:26

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

Автор: Barovskiy 15.1.2006, 13:18

2 Poseydon Хех... я что-то и не подумал так его пустить )))))) Спасибо, сегодня буду тестить!!!!! 2 FRAGNATIC http://forum.vingrad.ru/index.php?showtopic=60076 Отличный материал!!!!! Спасибо!!!!!!!!!!

Автор: Albinos_x 15.1.2006, 13:41

Цитата(Barovskiy) application.ProcessMessages; при выполнении в отдельном потоке на этой строчке могут возникать ошибки....

Автор: Barovskiy 15.1.2006, 14:02

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

Автор: Albinos_x 15.1.2006, 14:57

Цитата(Barovskiy @ 15.1.2006, 14:02 ) 2 Albinos_x А как лучше сделать чтоб прога не тормазила???? так если ты запустишь это в отдельном потоке, то она и так тормозить не будет ... поэтому эта строчка автомарически должна отпасть...

Автор: Barovskiy 15.1.2006, 15:41

у меня не компилируется (((((( Код procedure MyProcedyre; // долгая процедура begin try Yield; ........... except ............. finally ............... end; end; внутри цикла я обращаюсь к компонентам например Код finally label2.caption:= 'Complite'; end; как мне можно работать с компонентами внутри процедуры??? в цикле идет счет выполненых операций.... Код  Label6.Caption:=floattostr(strtofloat(Label6.Caption)+1); вобщем ругается на все компоненты (((((((( как это лечить ??????

Автор: Albinos_x 15.1.2006, 16:53

ты должен указать "чей компанент": Код ... Form1.label2.caption:= 'Complite'; ... но здесь тоже могут возникать глюки... здесь лучше делать: Цитата(Poseidon @ 15.1.2006, 04:10 ) я бы для твоей задачи все же воспользовался бы TThread. Там хоть синхролизировать можно потоки. Хотя и этот вариант может прокатить

Автор: Barovskiy 15.1.2006, 17:41

Цитата(Albinos_x @ 15.1.2006, 16:53 ) ты должен указать "чей компанент": я сделал так Код procedure MyProcedure; var  RxLabel6: TRxLabel; .... begin ...  скопилилось почти нормально за исключением [Warning] Unit1.pas(126): Variable 'Label6' might not have been initialized прога запускается нормально, но как только нажимаю на кнопку для пуска потока - Вылетает ошибка что какой то кусок памяти не может быть рид .... как мне инициализировать - указать чей компонент ????

Автор: Albinos_x 15.1.2006, 18:20

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

Автор: Barovskiy 15.1.2006, 19:00

Цитата(Albinos_x @ 15.1.2006, 18:20 ) А как ты создаёшь этот: var RxLabel6: TRxLabel; ? RxLabel6: TRxLabel; - RX компонент, проще говоря так Код procedure MyProcedure; var  Label6: TLabel; ... begin  ... а как надо указать чей компонент???????

Автор: FRAGNATIC 15.1.2006, 19:15

Цитата(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);

Автор: Barovskiy 15.1.2006, 19:15

Я сдела так Код procedure MyProcedure; var Label2: TLabel2; begin try  ..... except ............. finally Form1.label2.caption:= 'Complite'; end; компилируется но не работает ((((((((((((((((((((((( тоычнее начинает работать ... а потом вылетает ошибка ((((

Автор: FRAGNATIC 15.1.2006, 19:20

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

Автор: Barovskiy 15.1.2006, 19:39

Цитата(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; что типа того?

Автор: FRAGNATIC 15.1.2006, 19:52

Цитата(Barovskiy @ 15.1.2006, 19:39 ) ты имеешь ввиду все что я вписал в раздел var необходимо создать и в разделе begin? если ты не кидал на форму не опендиалога не мемо а тока обхявил в вар то их надо СОЗДАТь перед тем как к ним оброщатся=) если ты кинул их на форму то их и объявлять в вар не надо=) Добавлено @ 19:53 а в finally надо освободить память типа label6.Free

Автор: Barovskiy 15.1.2006, 20:09

Цитата(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 Память в конце обязательно освобождаю, с самого начала ))))

Автор: FRAGNATIC 15.1.2006, 20:16

Цитата(Barovskiy @ 15.1.2006, 20:09 ) у меня все на форме лежит и опендиалог и мемо зачем тогда их в вар объявять? они и так уже объявлены и создаются в том случаии если создана форма =)

Автор: Barovskiy 15.1.2006, 21:10

Цитата(FRAGNATIC @ 15.1.2006, 20:16 ) зачем тогда их в вар объявять? они и так уже объявлены и создаются в том случаии если создана форма =) всеравно не работает ((((( уже пробовал все компилируется а работать не хочет ..... есть ли какойнибудь пример на эту тему, рабочий пример ???... или всетаки попробовать через TThreads сделать?

Автор: Albinos_x 15.1.2006, 22:07

Цитата(Barovskiy @ 15.1.2006, 21:10 ) все компилируется а работать не хочет ..... есть ли какойнибудь пример на эту тему, рабочий пример ???... или всетаки попробовать через TThreads сделать? мы тут не телепаты... код покажи...

Автор: FRAGNATIC 15.1.2006, 22:15

Цитата(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 гы в том коде что я ща процетировал у тя ваще переменых нету выще они были в этойже ф-е)

Автор: Barovskiy 15.1.2006, 23:26

Цитата(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 ) гы в том коде что я ща процетировал у тя ваще переменых нету выще они были в этойже ф-е) Я их убрал из вара

Автор: Albinos_x 15.1.2006, 23:42

Цитата(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; выкинь нафиг эту строку наконец... в потоке будет генерироваться ошибка...

Автор: Barovskiy 16.1.2006, 00:26

Цитата(Albinos_x @ 15.1.2006, 23:42 ) выкинь нафиг эту строку наконец... в потоке будет генерироваться ошибка... эту фигню я уже выкинул .... просто код скопировал со старой версии .. . а в потоке ее нету уже..... Добавлено @ 00:36 Цитата(Albinos_x @ 15.1.2006, 23:42 ) компаненты уже существуют, поэтому генерируется ошибка, код завершается без обработки: я убрал все.............. и при нажатии на кпопку вылетает ошибка после чего прога закрывается.....

Автор: Albinos_x 16.1.2006, 00:43

вот тебе простенький пример(который у меня работает): Код 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; т.к. это пример поэтому расписывать написанные и используемые мной функции не стал

Автор: Barovskiy 16.1.2006, 00:46

Цитата(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); вывалшивает ошибку ((((((( не хочет запускать поток (((((((((

Автор: Albinos_x 16.1.2006, 00:47

Цитата(Barovskiy @ 16.1.2006, 00:26 ) я убрал все.............. и при нажатии на кпопку вылетает ошибка после чего прога закрывается..... что говорит пошаговая отладка? на какой строчке ошибка?

Автор: Barovskiy 16.1.2006, 01:09

Цитата(Albinos_x @ 16.1.2006, 00:47 ) что говорит пошаговая отладка? на какой строчке ошибка? Отладка виснет как только нажимаю на кнопку старт ... дельфи умирает просто ..... (((((( ВОт ошибки The exception unknown software exception (0x0eedfade) occured at location 0x77e738b2 System Error. Code 1400 Invalid window handle наверное я сегодня забыл руки с зада вытащить и поставить их в плечи....

Автор: Albinos_x 16.1.2006, 01:25

Цитата(Barovskiy @ 16.1.2006, 01:09 ) Invalid window handle ищи где даёшь неправильный хандле... Цитата(Barovskiy @ 16.1.2006, 01:09 ) Отладка виснет как только нажимаю на кнопку старт а через F7?

Автор: Barovskiy 16.1.2006, 01:32

Access violation at address 00493E11 in module 'IptoName.exe'. Read of address 00000000 вот еще

Автор: Albinos_x 16.1.2006, 01:36

Цитата 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 ну мне это толком ничего не говорит... я не видел кода... и не знаю на каких строчках вылетает ошибка...

Автор: Barovskiy 16.1.2006, 01:37

Цитата(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 тоже не получается

Автор: Albinos_x 16.1.2006, 02:02

а как тебе писали не пробовал? Код CreateThread(nil,128,@ChekIP,nil,0,h); Добавлено @ 02:12 http://forum.vingrad.ru/index.php?act=Search&CODE=show&searchid=d6c46cd5506de4f28cd1bf7a30c2f37a&search_in=posts&result_type=topics&flag=search&debug=&highlite=threads

Автор: Barovskiy 16.1.2006, 02:15

Цитата(Albinos_x @ 16.1.2006, 02:02 ) а как тебе писали не пробовал? пробовал ... вываливались те ошибки, а потом увеличил потоки ..... скорей всего я чето не так написал, компилится но вызывает ошибки при запуске ....

Автор: Albinos_x 16.1.2006, 02:15

Цитата(Barovskiy @ 16.1.2006, 01:37 ) F7 тоже не получается что не получается? на какой строчке? Добавлено @ 02:17 Цитата(Barovskiy @ 16.1.2006, 02:15 ) компилится но вызывает ошибки при запуске смотри событие OnFormCreate()

Автор: Barovskiy 16.1.2006, 02:28

Цитата(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() у меня там ничего нету пусто ))) ошибка вылетает если я хоть раз нажал на кнопку а если открыть и закрыть то ничего не выскакивает .... это в потоке чтото происходит..... отладчик вообще не хочет работать.... виснет ужасно ...

Автор: Демо 16.1.2006, 04:54

Хм... как всё запущено. Документацию и статьи, видимо, не полностью прочитаны или невнимательно. Пока будешь использовать VCL в доп. потоке без синхронизации, так и будут у тебя ошибки при выполнении. Ни один из приведенных примеров нормально также не избавлен от этих ошибок. Кроме того, нужно использовать не CreateThread, а BeginThread, либо самому добавлять строку IsMultiThread := TRUE;

Автор: Guest 16.1.2006, 12:54

Цитата(Демо @ 16.1.2006, 04:54 ) Хм... как всё запущено. Документацию и статьи, видимо, не полностью прочитаны или невнимательно. Читал я полностью, возможно не внимательно... я все заного перепроверю... Цитата(Демо @ 16.1.2006, 04:54 ) Пока будешь использовать VCL в доп. потоке без синхронизации, так и будут у тебя ошибки при выполнении. Ни один из приведенных примеров нормально также не избавлен от этих ошибок. Каким образом мне сделать синхронизацию VCL ???? Цитата(Демо @ 16.1.2006, 04:54 ) Кроме того, нужно использовать не CreateThread, а BeginThread, либо самому добавлять строку IsMultiThread := TRUE; Поставил CreateThreads - таже ошибка вылетает просле закрытия прогрммы... Где необходимо вписать IsMultiThread := TRUE; ????

Автор: Демо 16.1.2006, 12:59

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

Автор: Alexeis 16.1.2006, 13:07

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

Автор: Barovskiy 16.1.2006, 13:08

Демо Предыдущий пост был моим, не вошел под пользователем.... ((((((( Цитата(Демо @ 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 - это самый простой способ если синхронизация происходит достаточно редко. а пример можно ??? как это правильней сделать???

Автор: Alexeis 16.1.2006, 13:12

Цитата Работает, но после того как прога закрывается то вылетает ошибка Вероятно неверно завершается поток (очень частая ошибка)

Автор: Barovskiy 16.1.2006, 13:25

Цитата(alexeis1 @ 16.1.2006, 13:12 ) ероятно неверно завершается поток smile (очень частая ошибка) Хех, верно.... но как его завершить????

Автор: _hunter 16.1.2006, 13:39

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

Автор: Alexeis 16.1.2006, 13:41

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

Автор: Barovskiy 16.1.2006, 13:57

Цитата(_hunter @ 16.1.2006, 13:39 ) никак. поставь FreeOnTerminate в true и он сам остановится Добавлено @ 13:39 точнее умрет сделал так Код var  ...   FreeOnTerminate: boolean; .... finally   FreeOnTerminate:=true; все равно вылетает Цитата(alexeis1 @ 16.1.2006, 13:41 ) я не очень понял какой вариант использования потоков используется. Если Делфийский то вызов Terminate затем ожидание завершения Waitfor затем освобождение памяти. У меня дельфийский медот Можно какойнить пример??? я не совсем понимаю куда писать

Автор: Guedda 16.1.2006, 14:10

Поставь FreeOnTerminate в начале кода. Т.е.: Код procedure TMyThread.Execute; begin   FreeOnTerminate := true;   //Дальше твой код end; И еще, когда создаешь поток (может это уже было написано, но я повторю), нужно делать вот так: Код MyThread := TMyThread.Create(false); //Именно false, а не true, когда с FreeOnTerminate работаешь.

Автор: _hunter 16.1.2006, 14:11

а это: Цитата(Barovskiy @ 16.1.2006, 12:57 ) var ...   FreeOnTerminate: boolean; зачем? FreeOnTerminate это свойствр класса TThread...

Автор: Alexeis 16.1.2006, 14:12

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

Автор: Barovskiy 16.1.2006, 15:19

Выкладываю код ... у меня едит крыша, я совсем запутался.... ((((((((( Код 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; все работает, но вылетает ошибка когда закрываю прогу.... вот исходник, что я там не так сделал???? у меня уже голова кругом идет (((((

Автор: Демо 16.1.2006, 15:22

Можешь использовать как шаблон для реализации своего потока вот этот код: Код { Модуль 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

Автор: Alexeis 16.1.2006, 15:29

Цитата 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); создает целых два потока различными методами

Автор: Albinos_x 16.1.2006, 15:35

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

Автор: Barovskiy 16.1.2006, 15:47

Цитата(Демо @ 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 из них сразу же обрушатся (это конечно симотря как читаешь)... так и есть .... читаю одну строку ... а остальные просто рушаться... и опять ошибка... может менять порты при создании трейда????

Автор: Демо 16.1.2006, 16:17

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

Автор: Barovskiy 16.1.2006, 16:30

Демо Цитата(Демо @ 16.1.2006, 16:17 ) Выложи код, который используешь для пингования конкретного хоста, попробую помочь... Вот функиции Код function GetLocalIP: String; const WSVer = $101; var   wsaData: TWSAData;   P: PHostEnt;   Buf: array [0..127] of Char; begin   Result := '';   if WSAStartup(WSVer, wsaData) = 0 then begin     if GetHostName(@Buf, 128) = 0 then begin       P := GetHostByName(@Buf);       if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);     end;     WSACleanup;   end; end; function IPAddrToName(IPAddr : string): string; var   SockAddrIn: TSockAddrIn;   HostEnt: PHostEnt;   WSAData: TWSAData; begin   WSAStartup($101, WSAData);   SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));   HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);   if HostEnt <> nil then     result := StrPas(Hostent^.h_name)   else     result:=''; end; а вот что в цикле Код try  Form1.edit5.Text := Copy (Form1.edit3.Text, 1, Pos ('', s[i]) - 1); ...    Memo1.Lines.Add(IPAddrToName( Form1.edit5.Text)); ...

Автор: Albinos_x 16.1.2006, 16:30

Цитата(Barovskiy @ 16.1.2006, 15:47 ) может менять порты при создании трейда???? тогда без Class(TThread) и синхронизации не обойтись

Автор: Barovskiy 16.1.2006, 17:24

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

Автор: Демо 16.1.2006, 17:24

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

Автор: Barovskiy 16.1.2006, 17:35

Цитата(Демо @ 16.1.2006, 17:24 ) Barovskiy Т.е., судя по коду, ты хочешь просто получить имя компьютера из DNS, неважно, включен он или нет? что-то типа того, но включен он илинет этоне важно, ответ просто пустой....

Автор: Alexeis 16.1.2006, 17:40

Код простой пример работы с потоками unit Main; interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls; type   TMainForm = class(TForm)     Button1: TButton;     ListBox1: TListBox;     procedure Button1Click(Sender: TObject);   private     procedure ThreadsDone(Sender: TObject);   end;   TFooThread = class(TThread)   protected     procedure Execute; override;   end; var   MainForm: TMainForm; implementation {$R *.DFM} const   MaxSize = 128; var   NextNumber: Integer = 0;   DoneFlags: Integer = 0;   GlobalArray: array[1..MaxSize] of Integer; function GetNextNumber: Integer; begin   Result := NextNumber; // return global var   Inc(NextNumber); // inc global var end; procedure TFooThread.Execute; //здесь главное действо var   i: Integer; begin   OnTerminate := MainForm.ThreadsDone;   for i := 1 to MaxSize do   begin     GlobalArray[i] := GetNextNumber; // set array element     Sleep(5); // let thread intertwine   end; end; procedure TMainForm.ThreadsDone(Sender: TObject); var   i: Integer; begin   Inc(DoneFlags);   if DoneFlags = 2 then // make sure both threads finished     for i := 1 to MaxSize do       { fill listbox with array contents }       Listbox1.Items.Add(IntToStr(GlobalArray[i])); end; procedure TMainForm.Button1Click(Sender: TObject); begin   TFooThread.Create(False); // create threads   TFooThread.Create(False); end; end.

Автор: Barovskiy 16.1.2006, 17:49

alexeis1 Танкс за пример!!!! Я сейчас заного попробую.... свои действия мне вставлять сюда ??? Код procedure TFooThread.Execute; //здесь главное действо var   i: Integer; begin   OnTerminate := MainForm.ThreadsDone;   for i := 1 to MaxSize do   begin {     ВОТ Здесь????????    }   GlobalArray[i] := GetNextNumber; // set array element     Sleep(5); // let thread intertwine   end; end; а как настчет VCL компонентов??? итли мне сделать принадлежность каждого компонента????

Автор: Albinos_x 16.1.2006, 17:58

Цитата(Barovskiy @ 16.1.2006, 17:49 ) свои действия мне вставлять сюда ??? да... Цитата(Barovskiy @ 16.1.2006, 17:49 ) а как настчет VCL компонентов??? итли мне сделать принадлежность каждого компонента???? через синхронизацию работать с ними...

Автор: Barovskiy 16.1.2006, 18:09

Albinos_x Цитата(Albinos_x @ 16.1.2006, 17:58 ) свои действия мне вставлять сюда ??? да... Поставил... не работает .... запускается, начинается проверка и все.... В лог записано Allready connect буду пробовать .... может получится.... ((((

Автор: Albinos_x 16.1.2006, 18:16

Цитата(Barovskiy @ 16.1.2006, 18:09 ) Поставил... не работает .... запускается, начинается проверка и все....  В лог записано Allready connect буду пробовать .... может получится.... (((( у тебя практически все действия с компанентами... так что надо вызывать твои процедуры через метод Synchronize(...);

Автор: Alexeis 16.1.2006, 18:22

Действия лучше вставлять чуть ниже после первого end; а вот синхронизация Код unit Unit2; interface uses   Classes; type   TMyThread = class(TThread) //Новый класс   private     answer: Integer;   protected     procedure ShowResult;     procedure Execute; override;   end; implementation uses   SysUtils, Unit1; //Процедура для вывода информации из потока procedure TMyThread.ShowResult; begin   Form1.Edit1.Text := IntToStr(answer); end; //Длинная процедура procedure TMyThread.Execute; var   i: Integer; begin   for i := 1 to 10000 do   begin     answer := answer + 1;     Synchronize(ShowResult);   end; end; end.

Автор: Демо 16.1.2006, 21:00

Могу для твоей задачи предложить вот такое решение. Количество потоков не учитывается, но думаю, что сам доделаешь. Модуль с потоком Код unit uThrHostNames; interface uses   Windows, Messages, SysUtils,WinSock; type   PMsgThr=^TMsgThr;   TMsgThr=record     Addr: String;     HostName: String;     Handle: THandle;     ThrHandle: THandle;     MsgThr: Cardinal;   end; procedure AddJob(Addr: String;       Handle: THandle;       MsgThr: Cardinal); implementation function IPAddrToName(IPAddr : string): string; var   SockAddrIn: TSockAddrIn;   HostEnt: PHostEnt;   WSAData: TWSAData; begin   Result:='';   if WSAStartup($101, WSAData)<>0 then Exit;   try     SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));     HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);     if HostEnt <> nil then Result := StrPas(Hostent^.h_name);   finally     WSACleanup;   end; end; procedure ThrProc(P: Pointer); var   Rec: PMsgThr;   Result: Integer; begin   Rec := P;   Result := 0;   try     try       Rec^.HostName := IPAddrToName(Rec^.Addr);     except       Result := -1;     end;     if Rec^.HostName='' then Result := -1;   finally     SendMessage(Rec^.Handle,Rec^.MsgThr,Integer(P),Result);     CloseHandle(Rec^.ThrHandle);     Dispose(Rec);   end; end; procedure AddJob(Addr: String;       Handle: THandle;       MsgThr: Cardinal); var   P: PMsgThr;   ThrId: THandle; begin   New(P);   P^.Addr := Addr;   P^.HostName := '';   P^.Handle := Handle;   P^.MsgThr := MsgThr;   P^.ThrHandle := BeginThread(nil,0,@ThrProc,P,0,ThrId); end; end. Пример использования Код unit ufMain; interface uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,   IdTCPClient, IdHTTP,Winsock; type   TForm1 = class(TForm)     Button1: TButton;     IdHTTP1: TIdHTTP;     Memo1: TMemo;     procedure Button1Click(Sender: TObject);     procedure FormCreate(Sender: TObject);   private     procedure OnMsg(var Msg: TMEssage);   end; var   Form1: TForm1;   MsgThr: Cardinal; implementation uses uThrHostNames; {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var   i: Integer; begin   for i := 1 to 255 do   begin     Addjob('194.87.63.'+IntToStr(i),Handle,MsgThr);   end; end; procedure TForm1.OnMsg(var Msg: TMEssage); var   P: PMsgThr;   s: String; begin   if Msg.Msg = MsgThr then   begin     s := '';     P := Pointer(Msg.WParam);     if Msg.LParam=0       then s := P^.Addr+'-->'+P^.HostName       else s := P^.Addr+' - ошибка';     Memo1.Lines.Add(s);  end  else WndProc(Msg); end; procedure TForm1.FormCreate(Sender: TObject); begin   WindowProc := OnMsg; end; initialization   MsgThr := RegisterWindowMessage(PChar(IntToStr(HInstance))); end.

Автор: Barovskiy 17.1.2006, 01:20

alexeis1 На твоем примере вродебы как получилось - НО он прверяет один и тот же адрес два раза, примеру если у меня в локалке 100 адрессов, то он пишет что их 200 а потом один и тотоже проверяет два раза... а не каждый поток следующий адрес.... Добавлено @ 01:24 и после вырубления проги все равно вылетает ошибка..... Может вовсе не надо делать эти потоки.. у мен якрыша уже едит ... может хотябы сделать так чтоб прога ошибку не выплевывала..... Добавлено @ 01:31 Демо Цитата(Демо @ 16.1.2006, 21:00 ) Могу для твоей задачи предложить вот такое решение. Количество потоков не учитывается, но думаю, что сам доделаешь. Большое спасибо за пример!!!!! а можно ли чтонибудь попробовать именно через мой пример??? Просто твой не много не подходит ... я бы хотел его потом еще приминить в другие примеры чтоб просто поменять внутренности цикла и прога готова для другово :-) что скажешь ??? можешь помочь накидать пример , просто с пустым циклом выполнения... тогда поток будет универсален практически для всего ..... и для использования VCL и для внутреннего создание компонентов.... мне кажется это вариант хороший.... иметь заготовку куда просто можно впихнуть действия

Автор: Barovskiy 17.1.2006, 01:44

не для конкретной проверки IP адресов, а вообще, для всего где может понадобиться потоки ... даже не знаю что можно придумать, - все что угодно, Что скажите, мастера????

Автор: Alexeis 17.1.2006, 10:12

Barovskiy приведи текст ошибки Добавлено @ 10:13 Может ошибка не в потоке

Автор: Guedda 17.1.2006, 10:22

Может ты в потоке вызываешь MessageDlg or ShowMessage? Опиши подробнее ошибку.

Автор: Albinos_x 17.1.2006, 10:27

OnClose или OnDestroy обрабатываешь? Цитата(alexeis1 @ 17.1.2006, 10:12 ) Может ошибка не в потоке у меня такое же ощущение... возможно неправильно где-то ещё выделяет память или освобождает...

Автор: Guedda 17.1.2006, 10:31

В общем, выложи код, которым вызываешь, и код самого потока.

Автор: Barovskiy 17.1.2006, 12:50

Цитата(Albinos_x @ 17.1.2006, 10:27 ) OnClose или OnDestroy обрабатываешь? Здесь у меня ничего не обрабатывается Цитата(Guedda @ 17.1.2006, 10:22 ) Может ты в потоке вызываешь MessageDlg or ShowMessage? Опиши подробнее ошибку. тоже ничего нету Может быть вылетает шибка из-за того что я делаю запись всего лога в текстовый файл????? Хотя не должно быть ... А вот сама ошибка Главное выпригивает послето того как пройдет весь цикл если просто открыть и закрыть прогу то ничего не выпригивает Цитата(Guedda @ 17.1.2006, 10:31 ) В общем, выложи код, которым вызываешь, и код самого потока. Сейчас выложу все

Автор: Alexeis 17.1.2006, 12:54

Почему бы не попробовать найти ошибку трасировкой F7, F8 Добавлено @ 12:58 или накидать брекпоинтов

Автор: Barovskiy 17.1.2006, 13:32

код потока Код procedure ChekIp; var   s: TStrings;   d, i: integer; begin                             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;   // Stop глобальная переменая булева типа если тру то цикл прекращает работу         Form1.edit1.Text := Copy (s[i], 1, Pos ('', s[i]) - 1);  // копирую строку из файла       Form1.Label4.Caption:=floattostr(strtofloat(Form1.Label4.Caption)+1);  // какой по счету       Form1.label9.Caption:='Cheking..';       Form1.memo1.Lines.Add('Chek  '+Form1.Edit1.Text );        try         begin                            //  Yield;        Form1.Edit3.Clear;        Form1.Edit4.Clear;        Form1.Edit5.Clear;             if    form1.edit1.GetTextLen > 7 then         begin          form1.edit2.text:= (IPAddrToName( Form1.edit1.Text));           Memo2.Lines.Add((IPAddrToName( Form1.edit1.Text)+'-' + Form1.edit1.Text ))   // пишем имя и айпи в текстовый файл .. точнее вначале в мемо а потом уже в сам текстовик сохраняем мемо ...            end  ; ...                 form1.label6.Font.Color:= clRed ;                 form1.Edit3.Clear;                end;                end;                end;        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; //  освобождаю файл типа стринг - с него брались IP адреса     Form1.label9.Caption:='Complite';   // развоное оформление       Form1.Label4.Caption:='0';     Form1.Button1.Enabled:=true;     Form1.memo1.Lines.SaveToFile('Log.txt');   // пересохранение лога      end; end; end; Вот сам вызов потока Код procedure TForm1.Button1Click(Sender: TObject); var h:cardinal; begin BeginThread(nil,128,@ChekIp,self,0,h); end; и все.... работает в отдельном потоке, прога не виснет все нормально, но после того как закончилась работа и закрываю саму прогу то вылетает ошибка.... воть ... Добавлено @ 13:34 Цитата(alexeis1 @ 17.1.2006, 12:54 ) Почему бы не попробовать найти ошибку трасировкой F7, F8 Добавлено @ 12:58 или накидать брекпоинтов Я уже пробовал .... меня дельфи зависает намертво как только я запускаю поток и через 20 минут мне приходится уже через диспечера валить и дельфи и прилажение ...

Автор: Guedda 17.1.2006, 13:41

У тебя какие-то проблемы с хендлом какого-то окна. Скорее всего, при работе программы, она теряет свой собственный хэндл. Вопрос: Зачем тебе нужны потоки? Ответь, пожалуйста, по существу.

Автор: Romikgy 17.1.2006, 13:43

А если эту ф-цию запустить без потока, тож ошибка? ЗЫ Мож быть целая пачка ошибок, если из потока без дополнительных движений, обращатся к форме!

Автор: Barovskiy 17.1.2006, 14:10

Цитата(Guedda @ 17.1.2006, 13:41 ) У тебя какие-то проблемы с хендлом какого-то окна. Скорее всего, при работе программы, она теряет свой собственный хэндл. Вопрос: Зачем тебе нужны потоки? Ответь, пожалуйста, по существу. Поток нужен чтоб прога не висла, и я хотел чтоб одну работу прога выполняла несколькими потоками. Я так понял мне несколько потоков не получится сделать, или надо весь код заного переделывать... Ходябы избавиться от этой ошибки хендла .... Цитата(Romikgy @ 17.1.2006, 13:43 ) А если эту ф-цию запустить без потока, тож ошибка? ЗЫ Мож быть целая пачка ошибок, если из потока без дополнительных движений, обращатся к форме! Если весь код поместить на кнопку то никаких ошибок не вылетает, но все виснет, хотя и работает. как только перевожу весь код в отдельную процедуру и кнопкой создаю поток то тоже все арботает и прога не виснет, но после закрытия проги вылетает эта ошибка впринцепи она мне не портит работу, но хочется чтоб было все четко и разобраться почему она вылетает ...

Автор: Демо 17.1.2006, 14:21

Цитата(Barovskiy @ 17.1.2006, 14:32 ) код потока Тебе же сказали, что если будешь обращаться к VCL из потока, от ошибок не избавишься.

Автор: Romikgy 17.1.2006, 14:33

Сделай через Tthread, раздели часть где берутся данные с формы и ставятся, и на часть где идет обработка данных, где идет обращение к форме, засунь в синхронизм, только болько не пользуйся , потому как тогда смысл от отдельного потока никакой

Автор: Guedda 17.1.2006, 14:34

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

Автор: Romikgy 17.1.2006, 14:35

И еще почитай http://forum.vingrad.ru/index.php?showtopic=60076 это очень помогает! Добавлено @ 14:36 Цитата(Guedda @ 17.1.2006, 13:34 ) не следует обращаться к свойствам и методам компонентов VCL... Можно , но для этого надо делать дополнительные телодвижения

Автор: Alexeis 17.1.2006, 14:50

Barovskiy с F7 и у меня были проблемы но при использовании брекпоинтов (ставлю кучу) и F4 для перескока между ними удавалось отладить без зависания ( т.е. первую точку прошел - снимаем, вторую и т.д.)

Автор: Barovskiy 17.1.2006, 14:59

Цитата(Демо @ 17.1.2006, 14:21 ) Тебе же сказали, что если будешь обращаться к VCL из потока, от ошибок не избавишься. А синхронизация у меня не получается :-(

Автор: Guedda 17.1.2006, 15:15

Цитата(Romikgy @ 17.1.2006, 14:35) И еще почитай http://forum.vingrad.ru/index.php?showtopic=60076 это очень помогает! Добавлено @ 14:36 Цитата(Guedda @  17.1.2006,  13:34 ) не следует обращаться к свойствам и методам компонентов VCL... Можно , но для этого надо делать дополнительные телодвижения Это всего лишь цитата из учебника. Я лишь цитирую. Но и придерживаюсь этого мнения. Если треды не сильно нужны, то лучше ProcessMessages использовать.

Автор: Alexeis 17.1.2006, 15:16

Цитата А синхронизация у меня не получается  а по подробней

Автор: Romikgy 17.1.2006, 15:30

Цитата(Guedda @ 17.1.2006, 14:15 ) Я лишь цитирую. Но и придерживаюсь этого мнения. Если треды не сильно нужны, то лучше ProcessMessages использовать. Дело каждого свое

Автор: Демо 17.1.2006, 15:59

Цитата(Barovskiy @ 17.1.2006, 15:59 ) А синхронизация у меня не получается :-( А из API-Thread у тебя и не получится синхронизировать. Только если использовать синхронизацию метоодом посылки сообщений.

Автор: Barovskiy 17.1.2006, 16:44

Цитата(Guedda @ 17.1.2006, 15:15 ) Если треды не сильно нужны, то лучше ProcessMessages использовать. Они нужны так как ProcessMessages совершенно не спасает .... и плюс я бы хотел чтоб за один раз несколько потоков было .... тогда задача еще быстрее будет выполняться Цитата(Guedda @ 17.1.2006, 15:15 ) И еще почитай http://forum.vingrad.ru/index.php?showtopic=60076 это очень помогает! Обязательно почитаю сейчас Цитата(Guedda @ 17.1.2006, 15:15 ) не следует обращаться к свойствам и методам компонентов VCL... А как же тогда быть если не управлять VCL

Автор: Albinos_x 17.1.2006, 18:18

Цитата(Barovskiy @ 17.1.2006, 16:44 ) А как же тогда быть если не управлять VCL или создавать класс Thread или синхрогизировать через посылку сооьщений Цитата Я уже пробовал .... меня дельфи зависает намертво как только я запускаю поток  и через 20 минут мне приходится уже через диспечера валить и дельфи и прилажение . можно в критических местах расставить мессажебоксы и по их появлениям отследить выполнение кода... соответственно если какойто не показался, хотя долже был... значит где-то перед ним возникла ошибка... Добавлено @ 18:21 [яуоте] если просто открыть и закрыть прогу то ничего не выпригивает [/яуоте] а если досрочно прервать выполнение, ошибка вылетает?

Автор: Демо 17.1.2006, 18:39

Цитата(Barovskiy @ 17.1.2006, 02:20 ) Просто твой не много не подходит ... Чем пример не подходит? Цитата(Barovskiy @ 17.1.2006, 02:20 ) я бы хотел его потом еще приминить в другие примеры чтоб просто поменять внутренности цикла и прога готова для другово :-) что скажешь ??? можешь помочь накидать пример , просто с пустым циклом выполнения... Дело в том, что потоки пишутся под задачу, и универсальный шаблон сделать нельзя. Универсальный уже есть - File-->New-->Other-->Thread Object. Но это естественно, только лишь самая примитивная заготовка.

Автор: Barovskiy 17.1.2006, 18:58

Цитата(Albinos_x @ 17.1.2006, 18:18 ) ожно в критических местах расставить мессажебоксы и по их появлениям отследить выполнение кода... соответственно если какойто не показался, хотя долже был... значит где-то перед ним возникла ошибка... Все проходит гладко, в процессе работы, все логи я сохраняю в лог лист alexeis1 Цитата(alexeis1 @ 17.1.2006, 14:50 ) Barovskiy с F7 и у меня были проблемы но при использовании брекпоинтов (ставлю кучу) и F4 для перескока между ними удавалось отладить без зависания ( т.е. первую точку прошел - снимаем, вторую и т.д.) в коде все нормально проходит .... а вот как закрываю прогу .... бац АшыПка ..... Может я чтото упусти л..... Цитата(alexeis1 @ 17.1.2006, 15:16 ) Цитата А синхронизация у меня не получается  smile а по подробней smile Синхронизация не получается потому что не очень разбираюсь в потоках и если я сейчас начну создавать отдельный модуль пас с потоком то потом как мне склеить VCL ? я не смогу разбить VCL Саму связь и управление не смогу сделать - уже пробовал не получилось, поэтому я хотел загнать сам цикл в поток в принцепи получилось, но вот меня напрягает сама ошибка после выхода прграммы, это не граммотрно чтото я сделал ... многопоточность у меня не получится сделать таким образом... ну хотябы одним потоком чтоб прога не висла и без ошибок. Может это у меня ошибка в самом цикле???? чтоя мог такого написать с VCL что вылетает инвалид хэндл при закрытии проги???? может чтото еще надо вписать в раздел Код finally ????? С Вуажением, БагМэйкер ))))))))))))

Автор: Barovskiy 17.1.2006, 19:14

Цитата(Демо @ 17.1.2006, 18:39 ) Чем пример не подходит? Твой пример Супер!!!!!! Просто помимо проверки IP я хочу туда засунуть другие возможности .... Например загнать прогу в трей и чтоб она проверяла все мои почтовые ящики одним заходом, и выводила мне колличество мои писем.... а если я сейчас загоню это, то мне придется для каждого почтового ящика вешать по одному ПОП компоненту, а если у меня ящиков 10 ... это будет конечно труба.... вот я и хотел повесить один компонент поп и через порверять одним заходом все ящики из настроек .... поэтому я хотел сделать общую заготовку чтоб просто поотом менять содержание цикла и все.... Не получилось ... хотя уверен что можно это сделать, но пока у меня не хватает опыта ..... хотябы примитивные задачи ..... Цитата(Albinos_x @ 17.1.2006, 18:18 ) а если досрочно прервать выполнение, ошибка вылетает? Прерываю - все нормально останавливается, а если закрою - то тоже самое вылетает, ошибка вылетает в любом случае после закрытия прграммы если я хоть раз запускал цикл проблема скорей всего с синхронизацией VCL - но как мне ее сделать не понимаю, в примерах теряюсь, так как понятия не имею что куда писать :-(

Автор: Демо 17.1.2006, 19:36

Цитата Просто помимо проверки IP я хочу туда засунуть другие возможности .... Для каждого варианта тебе придется решать свои задачи и проблемы для многопоточного программирования. Общие рецепты слишком общий, чтобы можно было одно решение приспособить для любой задачи. Многопоточное программирование не так уж и сложно, но перед кдированием сложных задач все равно придется разобраться подробно в этой теме. Даже с готовой библиотекой - все равно придется разбираться. Цитата unit Gala; { Библиотека параллельного программирования Gala.   Версия 1.04 (beta)   Свободно распространяется с исходными кодами   www.dps.aeed.tpu.edu.ru/gurin/gala/index.htm   Сергей Гурин.   Томск, Политехнический университет,   кафедра электрических станций.   E-mail:  gurin@dps.aeed.tpu.edu.ru - рабочий             gurin@mail.tomsknet.ru    - домашний   HomePage: www.dps.aeed.tpu.edu.ru/gurin/gsv/index.htm ~ The library of concurrent programming Gala   Version 1.04 (beta)   Freeware   www.dps.aeed.tpu.edu.ru/gurin/gala/index.htm   Sergey Gurin.   Russia, Tomsk, Polytechnic university,   Department of Power Stations   E-mail:  gurin@dps.aeed.tpu.edu.ru - at work             gurin@mail.tomsknet.ru    - at home   HomePage: www.dps.aeed.tpu.edu.ru/gurin/gsv/index.htm } К сожалению, сайт уже не работает. Библиотеку можешь взять вот здесь: ftp://ftp.almar.net.ru/pub/GalaLib.zip

Автор: Barovskiy 17.1.2006, 23:21

Демо Спасибо за пример!!!!!!!!!!!!!!!!!! Супер!!!!!!!!!! буду разбираться с ним, можеь что получится!!!!!!!!!!

Автор: Barovskiy 18.1.2006, 16:36

Кажетсяы вот из-за этого вылетает ошибка при закрытии программы Код except                     on E: Exception do                        begin                         Form1.memo1.Lines.Add(E.Message);                         Form1.Edit3.Text:=(E.Message);                       end;                end;                         if Form1.edit3.Text= // сравнивание ошибки

Автор: Albinos_x 18.1.2006, 17:31

врят ли, если до этого ошибки не возникли...

Автор: Alexeis 18.1.2006, 17:33

except это уже обработка ошибка возникает между try и except

Автор: Barovskiy 18.1.2006, 18:17

Цитата(alexeis1 @ 18.1.2006, 17:33 ) except это уже обработка ошибка возникает между try и except Но там все нормально .... Почему, если поставить все действие просот на кнопку то все нормально, программа закрывается без ошибки ((((( как записываю в поток то после закрытия проги вылетает ошибка The exception unknown software exception (0x0eedfade) occurred in the application at location 0x781eb33 а после нее вылетает та ошибка которую я выкладывал раньше exception - и мне кажется что из-за этого ....

Автор: Alexeis 18.1.2006, 18:47

А если запустить тот же поток но с другим действием скажем for от 1 до 100000000 - ошибка повторится.

Автор: Guedda 18.1.2006, 19:43

Цитата(Barovskiy @ 18.1.2006, 18:17) как записываю в поток то после закрытия проги вылетает ошибка Просто напросто поток не успевает выгрузиться. Попробуй ставить проверку на выгрузку потока.

Автор: Barovskiy 19.1.2006, 00:04

Цитата(alexeis1 @ 18.1.2006, 18:47 ) А если запустить тот же поток но с другим действием скажем for от 1 до 100000000 - ошибка повторится. У меня цикл - если не конец файла.... Цитата(Guedda @ 18.1.2006, 19:43 ) Просто напросто поток не успевает выгрузиться. Попробуй ставить проверку на выгрузку потока. как его выгрузить тогда? И как поставить проверку? поток создаю так на нем остановился, так как не вылетает ошибок кроме последней... Код procedure TForm1.Button1Click(Sender: TObject); var h:cardinal; begin BeginThread(nil,128,@CheckIP,self,0,h); end;

Автор: Barovskiy 19.1.2006, 00:27

Цитата(Barovskiy @ 19.1.2006, 00:04 ) Цитата(alexeis1 @ 18.1.2006, 18:47 ) А если запустить тот же поток но с другим действием скажем for от 1 до 100000000 - ошибка повторится. У меня цикл - если не конец файла.... Здесь вылетает ошибка что кончился стринг файл и нечего проверять ..... Ели успокоил программу.... ))))))))))))))))

Автор: Albinos_x 19.1.2006, 00:45

попробуй в конце потока выйти из него командой: Код ExitThread(0);

Автор: Barovskiy 19.1.2006, 01:30

Код finally     s.Free;     Form1.label9.Caption:='Complite';     Form1.Label4.Caption:='0';     Form1.PDJXPButton1.Enabled:=true;     Form1.memo1.Lines.SaveToFile('Log.txt');      ExitThread(0);      end;      end;      end; Сделал так... всеравно вылетает (((((

Автор: Barovskiy 19.1.2006, 01:50

Albinos_x ОГРОНОЕ СПАСИБО!!!!!!!!!!!!!!!!!!!!!!!!! Код procedure TForm1.FormDestroy(Sender: TObject); begin     ExitThread(0); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin  ExitThread(0); end; end. Сделал вот так и все заработало!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ОГРОНОЕ СПАСИБО ВСЕМ КТО МНЕ ПОМОГАЛ!!!!!!!!!!!!!!!!!! Я ОЧЕНЬ ВСЕМ ВАМ БЛАГОДАРЕН ЗА ВАШУ ПОМОЩЬ!!!!!!!!!!!!!!!! Добавлено @ 02:04 Но тут же возникает другой вопрос :-) Как из этого примера сделать многопоточность? ведь это только работает в один поток и с одноим циклом, а если заставить его делать этот цикл в двух потоках сразу, или еще больше из преложенных мне ВАМИ ссылок я нашел вот этот пример http://forum.vingrad.ru/index.php?showtopic=41821&unread=1&hl=threads :-) или придется делать по другому ?

Автор: Barovskiy 19.1.2006, 02:13

Поправка Прога остается висеть в памяти, не закрывается...... (((((((((((((

Автор: Barovskiy 19.1.2006, 03:01

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

Автор: Albinos_x 19.1.2006, 16:53

странно что у тебя это не работает.. Код   Form1.label9.Caption:='Complite';         Form1.Label4.Caption:='0';         Form1.PDJXPButton1.Enabled:=true;         Form1.memo1.Lines.SaveToFile('Log.txt');          ExitThread(0);          end;          end;          end;

Автор: Barovskiy 20.1.2006, 19:50

Albinos_x Работает только если я ставлю ExitThread(0); когда программа закрывается... онклоус но прога из памяти не выгружается ... продолжает висеть в процессах ...

Автор: Albinos_x 20.1.2006, 21:53

в любом случае вариант Код procedure TForm1.FormDestroy(Sender: TObject);     begin         ExitThread(0);     end;     procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);     begin      ExitThread(0);     end; будет вызывать ошибку, т.к. 2 раза закрыть закрыть одно и тоже нельзя...а в этом варианте темболее закрываешь не из потока... программа просто скрывается и виснет... если хочешь закрывать не из потока, то наверно лучше его убить командой: Код TerminateThread(H,0); где H - HANDLE созданного тобой потока...

Автор: Barovskiy 29.1.2006, 23:25

Цитата(Albinos_x @ 20.1.2006, 21:53 ) если хочешь закрывать не из потока, то наверно лучше его убить командой: код Pascal/Delphi 1:TerminateThread(H,0); где H - HANDLE созданного тобой потока... сделал так TerminateThread(ChekIP,0); не компилирует , выдал вот это [Error] Unit1.pas(370): Incompatible types: 'Cardinal' and 'procedure, untyped pointer or untyped parameter' что вмето 0 поставить?

Автор: Демо 30.1.2006, 00:15

1. Вообще-то, дескриптор(Handle) потока у тебя возвращает функция BeginThread, который ты не запоминаешь нигде. 2. TerminateThread - аварийное завершение потока. А нужно ли? 3. Как выше было написано, проще сделать нормальную синхронизацию, а не заниматься садомазохизмом через одно место. 4. Если можешь выслать мне свою программу, высылай - посмотрю, что можно сделать. Тогда стучи в PM.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)