Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.03.2009, 17:26   #1
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию Некорректная работа потока

Здравствуйте. Такая проблема. Пишу многопоточное приложение, которое состоит из 3-х потоков: 1-й собственное сам процесс (программа), второй - поток операций интерфеса (удаление из списка, очистка списка файлов, обновлени файлов в списке и т.д.), а третий отвечает за выполнение 1-ой из 4-х операций: шифрование, дешифрование файлов, разбиение, сборка файлов.
Собственно проблема в том, что при работе 3-й поток в конце своей работы ведет себя непредсказуемым образом - может корректно завершиться (если число файлов в списке мало), передав управление интерфейсу, может выдать ошибку типа "не могу записать адрес0х00000000. Он не может быть рид" или что хуже всего, вылетает вся программа с ошибкой RunTime Error.
Код потока FDLK.pas:

Код:
unit FDLK;

interface

uses
  Windows, Messages, Classes, Forms, SysUtils, Graphics;

type
  TDLK = class(TThread)
  private
  protected
    text:string;//информационный текст для процедур ConfirmTn и GuiMsg
    collectfilename:string;//имя файла-линковщика для разбиения/сборки
    procedure ThrInfo;//Информация о текущем объекте для отображения в прогрессе
    procedure ThrStatus;//Информация о текущем состоянии для отображения в статусе
    procedure ThrConfirmation;//перегруженная процедура запроса на перезапись для FDLK
    procedure ShellDivide;//оболочка разбиения
    procedure Divide;//разбиение файлов
    procedure ActiveButtons;//для активации кнопок после инициализации
    procedure ThrFinishing;//визуальное завершение
    procedure Execute; override;
  end;

var DLK:TDLK;

implementation

uses Main, Progress;

...

procedure TDLK.ActiveButtons;
begin
  FProgress.btn_pause.Enabled:=true;
  FProgress.btn_continue.Enabled:=false;
  FProgress.btn_break.Enabled:=true;
end;

procedure TDLK.ThrFinishing;
begin
  FProgress.btn_pause.Enabled:=false;
  FProgress.btn_continue.Enabled:=false;
  FProgress.btn_break.Enabled:=false;
  FProgress.statusprogress.SimpleText:='Завершение операции... Ждите';
  FProgress.Close;
end;

procedure TDLK.Execute;
var i,//счетчик цикла
    cl:integer;//число успешно открытых файлов
begin
  Self.FreeOnTerminate:=true;
  sl_log.AddObject(timetostr(time)+': '+FProgress.Caption+' (всего '+inttostr(sl_filelist.Count)+')',bmplog[opmode]);
  cl:=0;
  for i:=0 to sl_filelist.Count-1 do
  begin
    try
    inc(cl);
    SetLength(initfiles,cl);
    initfiles[cl-1]:=TFileStream.Create(sl_filelist[i],fmOpenRead);
    inc(inittotalsize,initfiles[cl-1].Size);
    sl_oplist.Add(sl_filelist[i]);
    except
      begin
        dec(cl);
        SetLength(initfiles,cl);
        case opmode of
          1:text:=': Не удалось заблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
          2:text:=': Не удалось разблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
          3:text:=': Не удалось разбить объект "'+ExtractFileName(sl_filelist[i])+'"';
          4:text:=': Не удалось собрать объект "'+ExtractFileName(sl_filelist[i])+'"';
        end;
        sl_log.AddObject(timetostr(time)+text,bmplog[7]);
        Continue;
      end;
    end;
    if qseparateparams=true then Break;
  end;
  initcount:=sl_oplist.Count;
  if (initcount>0) then
  begin
    FProgress.timerprogress.Enabled:=true;
    Synchronize(ActiveButtons);
    case opmode of
      1:ShellBlock;
      2:ShellUnblock;
      3:ShellDivide;
      4:ShellCollect;
    end;
  end;
  sl_log.AddObject(timetostr(time)+': Операция завершена',bmplog[opmode]);
  FProgress.timerprogress.Enabled:=false;
  CloseProgress:=true;
  Synchronize(ThrFinishing);
  for i:=low(initfiles) to high(initfiles) do initfiles[i].Free;
  SetLength(initfiles,0);end;

end.
По моим наблюдениям некорректно высвобождается память (см выделенную строку).
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 05.03.2009, 19:08   #2
Jeni
Форумчанин
 
Регистрация: 31.05.2007
Сообщений: 486
По умолчанию

При возникновении исключения выполняется код
Код:
dec(cl);
SetLength(initfiles,cl);
но при этом не производится уничтожение объектов.

По-моему, можно и не заморачиваться с постоянным пересозданием массива initfiles, а просто заранее создать его с размером sl_filelist.Count и освободить объекты уже после цикла.
Jeni вне форума Ответить с цитированием
Старый 06.03.2009, 06:33   #3
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Jeni, дело в том, что при возникновении исключения объект уничтожать не надо, т.к. он (файловый поток) не может быть открыт для чтения, в чем собсно и проявляется исключение. А проявиться оно может в выделенной строчке:
Код:
...
try
    inc(cl);
    SetLength(initfiles,cl);
    initfiles[cl-1]:=TFileStream.Create(sl_filelist[i],fmOpenRead);
    inc(inittotalsize,initfiles[cl-1].Size);
    sl_oplist.Add(sl_filelist[i]);
    except
      begin
        dec(cl);
        SetLength(initfiles,cl);
        case opmode of
          1:text:=': Не удалось заблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
          2:text:=': Не удалось разблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
          3:text:=': Не удалось разбить объект "'+ExtractFileName(sl_filelist[i])+'"';
          4:text:=': Не удалось собрать объект "'+ExtractFileName(sl_filelist[i])+'"';
        end;
        sl_log.AddObject(timetostr(time)+text,bmplog[7]);
        Continue;
      end;
...
Или я не прав?

ЗЫ. А может быть сначала проверять на занятость каждый файл в списке sl_filelist, и если не занят, то добавлять его в список sl_oplist. А затем в цикле создать динамический массив и заполнить его файловыми потоками?
"ковыряю изнутри" (с)

Последний раз редактировалось 3D Hunter; 06.03.2009 в 06:44.
3D Hunter вне форума Ответить с цитированием
Старый 06.03.2009, 07:24   #4
Jeni
Форумчанин
 
Регистрация: 31.05.2007
Сообщений: 486
По умолчанию

Цитата:
Сообщение от 3D Hunter Посмотреть сообщение
что при возникновении исключения объект уничтожать не надо, т.к. он (файловый поток) не может быть открыт для чтения
По-моему, это разные вещи. Объект создан, сумел он что-нибудь открыть или нет - это уже другое дело. В любом случае лишним его уничтожение не будет. Собственно метод Free и предназначен для безопасного разрушения объектов.

Цитата:
Сообщение от 3D Hunter Посмотреть сообщение
А может быть сначала проверять на занятость каждый файл...
Это не помешает делать в любом случае. Ведь исключения - не панацея. Если есть возможность выполнить проверку и предотвратить возникновение ошибки - значит, так и надо делать, а не доводить "до греха".
Jeni вне форума Ответить с цитированием
Старый 06.03.2009, 09:20   #5
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Не помогло. Правда теперь поток не вылетает. Он зависает на высвобождении файлов.
Тут пределанный вариант метода Execute:
Код:
procedure TDLK.Execute;
var i,//счетчик цикла
    cl:integer;//число успешно открытых файлов
begin
  Self.FreeOnTerminate:=true;
  sl_log.AddObject(timetostr(time)+': '+FProgress.Caption+' (всего '+inttostr(sl_filelist.Count)+')',bmplog[opmode]);
  cl:=0;
  for i:=0 to sl_filelist.Count-1 do
  begin
    inc(cl);
    SetLength(initfiles,cl);
    try
    initfiles[cl-1]:=TFileStream.Create(sl_filelist[i],fmOpenRead);
    except
      initfiles[cl-1].Free;
      dec(cl);
      SetLength(initfiles,cl);
      case opmode of
        1:text:=': Не удалось заблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
        2:text:=': Не удалось разблокировать объект "'+ExtractFileName(sl_filelist[i])+'"';
        3:text:=': Не удалось разбить объект "'+ExtractFileName(sl_filelist[i])+'"';
        4:text:=': Не удалось собрать объект "'+ExtractFileName(sl_filelist[i])+'"';
      end;
      sl_log.AddObject(timetostr(time)+text,bmplog[7]);
      Continue;
    end;
    inc(inittotalsize,initfiles[cl-1].Size);
    sl_oplist.Add(sl_filelist[i]);
    if qseparateparams=true then Break;
  end;
  initcount:=sl_oplist.Count;
  if (initcount>0) then
  begin
    FProgress.timerprogress.Enabled:=true;
    Synchronize(ActiveButtons);
    ShellDivide;
  end;
  sl_log.AddObject(timetostr(time)+': Операция завершена',bmplog[opmode]);
  FProgress.timerprogress.Enabled:=false;
  CloseProgress:=true;
  Synchronize(ThrFinishing);
end;
А вот потоковые процедуры для деления файлов:
Код:
procedure TDLK.ShellDivide;
var i:integer;//счетчик цикла
    flex:boolean;//существует ли файл
begin
	for i:=0 to (sl_oplist.Count-1) do
	begin
	  oplistindex:=i;
	  if (initfiles[oplistindex].Size<2) then
	  begin
	    sl_log.AddObject(timetostr(time)+': Невозможно разбить объект "'+ExtractFileName(sl_oplist[oplistindex])+'"',bmplog[7]);
      initfiles[oplistindex].Free;
	    Continue;
      if qseparateparams=true then Break;
	  end
	  else
	  begin
	    if outputdir='' then collectfilename:=sl_oplist[oplistindex]+'.dlc'
      else collectfilename:=outputdir+ExtractFileName(sl_oplist[oplistindex])+'.dlc';
      flex:=FileExists(collectfilename);
	    if flex=true then
      if ConfirmToAll=false then
      begin
        text:='Объект '+ExtractFileName(collectfilename)+' уже сущесвует. Выберите действие для этого объекта и его частей.';
        Synchronize(ThrConfirmation);
      end;
      case opselect of
        0,1,3:Divide;
        2:
        begin
          initfiles[oplistindex].Free;
          sl_log.AddObject(timetostr(time)+': Объект "'+ExtractFileName(sl_oplist[oplistindex])+'" пропущен пользователем',bmplog[13]);
        end;
        4:
        if flex=true then
        begin
          initfiles[oplistindex].Free;
          sl_log.AddObject(timetostr(time)+': Объект "'+ExtractFileName(sl_oplist[oplistindex])+'" пропущен пользователем',bmplog[13]);
        end
        else Divide;
      end;
    end;
    if qseparateparams=true then Break;
  end;
end;

procedure TDLK.Divide;
var i:integer;//счетчик цикла
    mc:TMemoryStream;//кэш операций
    partsize,lastsize:int64;//размеры всех частей и остатка
    copysize:int64;//выбираемый размер части взависимости от i
    delindex:integer;//индекс объекта для удаления его из списка sl_filelist
    resultfilename:string;//имя текущего результирующего файла операций
begin
  initsize:=initfiles[oplistindex].Size;
  Synchronize(ThrInfo);
  text:='Выполнение...';
  Synchronize(ThrStatus);
  partsize:=initsize div partcount;
  if partsize=0 then
  begin
    sl_log.AddObject(timetostr(time)+': Невозможно разбить объект "'+ExtractFileName(sl_oplist[oplistindex])+'" (Число частей превышает его размер)',bmplog[7]);
    initfiles[oplistindex].Free;
    Exit;
  end;
  lastsize:=initsize mod partcount;
  AssignFile(cfv,collectfilename);
  Rewrite(cfv);
  Writeln(cfv,inttostr(initfiles[oplistindex].Size));
      for i:=1 to partcount do
      begin
        resultfilename:=ChangeFileExt(collectfilename,'.dlp['+IntToStr(i)+']');
        resultfile:=TFileStream.Create(resultfilename,fmCreate);
        if i>lastsize then copysize:=partsize else copysize:=partsize+1;
        resultfile.CopyFrom(initfiles[oplistindex],copysize);
        Writeln(cfv,resultfilename);
        resultfile.Free;
      end;
  initfiles[oplistindex].Free;
  delindex:=sl_oplist.IndexOf(sl_oplist[oplistindex]);
  if delindex<>-1 then sl_filelist.Delete(delindex);
  if cfg.param_division_delnormalfls=true then DeleteFile(sl_oplist[oplistindex]);
  sl_log.AddObject(timetostr(time)+': Объект "'+ExtractFileName(sl_oplist[oplistindex])+'" успешно разбит',bmplog[6]);
  CloseFile(cfv);
  inc(resulttotalsize,initsize);
end;
Помогите! Чую, что проблема в динамическом массиве, но ГДЕ?
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 09.03.2009, 08:25   #6
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Народ, а че так хило? Никто не ответит? Слишком сложный вопрос?
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Старый 09.03.2009, 09:21   #7
BOBAH13
Android Developer
Старожил Подтвердите свой е-майл
 
Аватар для BOBAH13
 
Регистрация: 19.02.2007
Сообщений: 3,708
По умолчанию

Цитата:
Сообщение от 3D Hunter Посмотреть сообщение
Народ, а че так хило? Никто не ответит? Слишком сложный вопрос?
Куча кода, не ясно толком в чем проблема, я лично еще из первого поста догадываюсь, но разгребать код - тут уж извените.

p.s. Если есть общие объекты, используемые как в потоке так и в главном потоке (а не в процессе), то надо или их синхронизировать через метод TThread или создать критическую цекцию, и при использовании общих объектов заходить в критическую секцию, потом разумеется когда поработали с ними, выходить.
BOBAH13 вне форума Ответить с цитированием
Старый 09.03.2009, 10:51   #8
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Ладно. Код я перепишу полностью. Надо будет продумать архитектуру синхронизации с интерфейсом. Скажите, когда вызывается метод Synchronize, то поток передает управление главному процессу на выполнение и ждет его завершения или продолжает выполняться параллельно?
ВОВАН13, скажите, о чем вы догадываетесь из 1-го поста? Поделитесь мыслями, может мне поможет?
"ковыряю изнутри" (с)
3D Hunter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Уничтожение потока SNUPY Общие вопросы Delphi 2 11.02.2009 22:47
Некорректная печать Natalie Microsoft Office Word 5 29.08.2008 11:08
BDE и DataBase Desktop - некорректная работа в Vista Dux БД в Delphi 9 03.04.2008 23:18