Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Здравствуйте!

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

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

Подскажите, что я не так понимаю.
Вот код завершения процесса:
Import_DBF.FreeOnTerminate:=true;
Import_DBF.Terminate;
Import_DBF.Free;

Вопрос задал: Squil (статус: Посетитель) Вопрос отправлен: 25 ноября 2008, 10:17 Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Nasgool

Здравствуйте, Squil!
Нужно в теле потока (процедура Execute) гденибудь в основном цикле прописать:
if Terminated then exit;

B процедуре "аварийного убиения" потока убрать:
Import_DBF.Free;

Ответ отправил: Nasgool (статус: 2-ой класс) Время отправки: 25 ноября 2008, 12:03

Мини-форум вопроса

min@y™ (статус: Доктор наук), 25 ноября 2008, 11:04 [#1]: Подразумевается, что Import_DBF - это наследник TThread? Не совсем понятно: Import_DBF.FreeOnTerminate:=true; Import_DBF.Terminate; Import_DBF.Free; // <-- А это зачем? Выложи весь код, касающийся этого класса, плиз. Посмотрим, где там косяки. Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Вадим К (статус: Академик), 25 ноября 2008, 11:33 [#2]: Код потока должен проверять время от времени переменную Terminated. Как только она стала True - это означает, что главный поток просит закругляться. А если прибивать "внаглую поток", то никто не гарантирует корректную работу вообще. И причина тут не в Делфи. а в самой организации Windows Галочка "подтверждения прочтения" - вселенское зло.

Squil (статус: Посетитель), 26 ноября 2008, 05:21 [#3]: Результат был неизменным. Вот исходник... дополнения как предложил Nasgool внес в основной цикл процесса. Не судите строго, солдатами не рождаются...))) TImport_FizpersDBF = class(TThread) private lblHeader, lblMessage: string; lbl1_1, lbl2_1: string; pbPosition, Min, Max: Integer; tblMain, tblChild, tblFind_DOG, tblImport: TTable; protected procedure Sets; procedure Step; procedure ShowResult; procedure Execute; override; procedure BeforeDestruction; override; end; // TImport_FizpersDBF ---------------------------------------------------------- procedure TImport_FizpersDBF.Execute; var tmpFAM, tmpIM, tmpOT, tmpS_POL, tmpNDOG: String; tmpDR, tmpDS: TDateTime; tmpN_POL: integer; countNEW_MAIN, countREFRESH_MAIN, countRECORD: Integer; countNEW_CHILD, countREFRESH_CHILD, countNULL_DOG: Integer; pFirst, pCurrent: PMyRecord; begin Priority:=tpIdle; FreeOnTerminate:=false; tblMain := TTable.create(nil) и т.д.; tblChild := TTable.create(nil) и т.д.; tblFind_DOG := TTable.create(nil) и т.д.; tblImport := TTable.create(nil) и т.д.; tblMain.Open; tblChild.Open; tblFind_DOG.Open; tblImport.Open; countRECORD:=tblImport.RecordCount; Min:=0; Max:=countRECORD; Synchronize(Sets); tblImport.First; while not tblImport.eof do //основной цикл процесса begin if Terminated then begin // FreeOnTerminate:=true; // добавленная проверка на терминирование exit; // end; <присвоение значений переменным tmpFAM, tmpIM, tmpOT, tmpDR...> pbPosition:=tblImport.RecNo; lbl1_1:=tmpFAM+' '+tmpIM+' '+tmpOT; lbl2_1:=tmpS_POL+'/' + IntToStr(tmpN_POL)+ ', договор №'+tmpNDOG; Synchronize(Step); if tblMain.FindKey([tmpFAM, tmpIM, tmpOT, tmpDR]) then begin if tblMain.FieldByName('SYSDATE').AsDateTime < tblImport.FieldByName('SYSDATE').AsDateTime then tblMain.Edit end else tblMain.Append; if tblMain.State in dsEditModes then <обновление данных таблиц> if tblChild.FindKey([tmpS_POL, tmpN_POL]) then if tblChild.FieldByName('SYSDATE').AsDateTime < tblImport.FieldByName('SYSDATE').AsDateTime then tblChild.Edit else if tblFind_DOG.FindKey([tmpNDOG]) then tblChild.Insert else Inc(countNULL_DOG); if tblChild.State in dsEditModes then <обновление данных таблиц> tblImport.Next; end; FreeOnTerminate:=true; end; procedure TImport_FizpersDBF.Sets; begin frmImport_1.pbProgress.Min:=Min; frmImport_1.pbProgress.Max:=Max; frmImport_1.btnReport.Enabled:=FreeOnTerminate; frmImport_1.btnRetry.Enabled:=FreeOnTerminate; frmImport_1.btnCancel.Enabled:=not FreeOnTerminate; end; procedure TImport_FizpersDBF.Step; begin frmImport_1.pbProgress.Position := pbPosition; frmImport_1.lbl1_1.Caption:=lbl1_1; frmImport_1.lbl2_1.Caption:=lbl2_1; end; procedure TImport_FizpersDBF.ShowResult; begin if FreeOnTerminate then frmImport_1.lblpathFile.Caption:='завершена!' else frmImport_1.lblpathFile.Caption:='прервана!'; frmImport_1.lbl1.Visible:=false; frmImport_1.lbl1_1.Visible:=false; frmImport_1.lbl2.Visible:=false; frmImport_1.lbl2_1.Visible:=false; if FreeOnTerminate then frmImport_1.btnReport.SetFocus; end; procedure TImport_FizpersDBF.BeforeDestruction; begin if tblMain.State in dsEditModes then tblMain.Cancel; //изменяемая таблица if tblChild.State in dsEditModes then tblChild.Cancel; //изменяемая таблица if tblFind_DOG.Active then tblFind_DOG.Close; if tblChild.Active then tblChild.Close; if tblMain.Active then tblMain.Close; if tblImport.Active then tblImport.Close; tblFind_DOG.Destroy; tblChild.Destroy; tblMain.Destroy; tblImport.Destroy; frmImport_1.btnReport.Enabled:=FreeOnTerminate; frmImport_1.btnRetry.Enabled:=FreeOnTerminate; frmImport_1.btnCancel.Enabled:=not FreeOnTerminate; Synchronize(ShowResult); end; end. строка создающая процесс: Import_FizpersDBF:=TImport_FizpersDBF.Create(False); аварийное прерываение процесса: Import_DBF.FreeOnTerminate:=true; Import_DBF.Terminate;

min@y™ (статус: Доктор наук), 26 ноября 2008, 08:50 [#4]: Трудно читать твой код, когда он не форматирован. Однако, какое странное применение свойства TThread.FreeOnTerminate: frmImport_1.btnReport.Enabled:=FreeOnTerminate; frmImport_1.btnRetry.Enabled:=FreeOnTerminate; frmImport_1.btnCancel.Enabled:=not FreeOnTerminate; Первый раз такое вижу. Зачем? Видать, из-за манипулирования этим свойством (то оно False, то True) какие-то экземпляры могут не освобождаться по выходу, а это не есть гут. Убери везде FreeOnTerminate:= True|False, и вставь FreeOnTerminate:= True в первую строку метода Execute(). Также режет глаза явный вызов деструкторов: tblFind_DOG.Destroy; tblChild.Destroy; tblMain.Destroy; tblImport.Destroy; Это плохая идея. Ещё неплохо было бы поставить брейк в код TImport_FizpersDBF.BeforeDestruction() и посмотреть, доходит туда выполнение или нет. А ещё лучше - заменить этот метод на переопределённый деструктор. Больше ничего я тут не увидел. Может плохо смотрел.(?) Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Вадим К (статус: Академик), 26 ноября 2008, 11:06 [#5]: Могу сразу указать на большой тормоз. Если кол-во записей больше тысячи, то обновление прогресбара будет занимать порядка 90% времени и больше. Надо обновлять редше. Если он длинной 100 пикселей, а записей например 1000, то 560 и 562 шаг будут незаметны. Галочка "подтверждения прочтения" - вселенское зло.

Squil (статус: Посетитель), 27 ноября 2008, 03:23 [#6]: Убрал строки tblFind_DOG.Destroy; tblChild.Destroy; tblMain.Destroy; tblImport.Destroy; процесс отключается "без вопросов и претензий на восстановление"!!! Спасибо min@y™ за наводку. Вадим К Спасибо за практичный отзыв. конечно не 90% времени занимает обновление прогрессбара, но фак что при его длинне принципиально меньшей количеству шагов которые делает цикл получается "шаг на месте", да при том порой более 1000 раз! Углублятся в понятия процессов не стану, на данном этапе (даже при возможной потере памяти) результат удовлетворительный. Спасибо за ответы!!!

Squil (статус: Посетитель), 27 ноября 2008, 03:26 [#7]: Nasgool Спасибо за совет! Все мы начинаем с малого! +

min@y™ (статус: Доктор наук), 27 ноября 2008, 08:19 [#8]: Убрал строки tblFind_DOG.Destroy; tblChild.Destroy; tblMain.Destroy; tblImport.Destroy; Их надо было не убрать, а заменить Destroy на Free. Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Вадим К (статус: Академик), 27 ноября 2008, 09:43 [#9]: Вызывать Destroy напрямую - это конщунство. Нельзя так делать. Галочка "подтверждения прочтения" - вселенское зло.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.