Delphi TTask - не выполнена одна процедура

Я пытаюсь использовать TTask, чтобы заставить приложение реагировать при запуске и делать некоторые обновления БД. При запуске приложения запускается форма обновления БД, которая последовательно выполняет несколько процедур, а также показывает ход обновления (ProgrssBar1). Все процедуры размещены в специальном блоке. Пример кода:

procedure TfrmUpdate.FormActivate(Sender: TObject);
var
  TasksUpdate: array [0..5] of ITask;
begin
    TasksUpdate[0]:= TTask.Create(procedure
        begin
            // Unit1.procedure1
            TThread.Synchronize(nil, procedure
                  begin
                    ProgressBar1.StepBy(20);
                  end);
        end);
    TasksUpdate[0].Start;

    TasksUpdate[1]:= TTask.Create(procedure
        begin
            TTask.WaitForAny(TasksUpdate[0]);
            // Unit1.procedure2
            TThread.Synchronize(nil, procedure
                  begin
                    ProgressBar1.StepBy(20);
                  end);

        end);
    TasksUpdate[1].Start;

    TasksUpdate[2]:= TTask.Create(procedure
        begin
            TTask.WaitForAny(TasksUpdate[1]);
            // Unit1.procedure3
            TThread.Synchronize(nil,procedure
                  begin
                    ProgressBar1.StepBy(20);
                  end);

        end);
    TasksUpdate[2].Start;

    TasksUpdate[3]:= TTask.Create(procedure
        begin
            TTask.WaitForAny(TasksUpdate[2]);
            // Unit1.procedure4
            TThread.Synchronize(nil,procedure
                  begin
                    ProgressBar1.StepBy(20);
                  end);
        end);
    TasksUpdate[3].Start;

    TasksUpdate[4]:= TTask.Create(procedure
        begin
           TTask.WaitForAny(TasksUpdate[3]);
           // Unit1.procedure5
           TThread.Synchronize(nil,procedure
                  begin
                    ProgressBar1.StepBy(20);
                  end);
        end);
    TasksUpdate[4].Start;

    TasksUpdate[5]:= TTask.Create(procedure
        begin
          TTask.WaitForAny(TasksUpdate[4]);
          ProgressBar1.StepBy(100);
          Sleep(1000);
          frmUpdate.Close;
        end);
        TasksUpdate[5].Start;
end;

Все процедуры выполняются успешно, кроме одной. Если я выполняю эту процедуру напрямую, она работает отлично. Может быть, есть какие-то ограничения на запуск процедур как TTask? Код процедуры проблемы:

procedure Update_Currency_Rate;
var
  aStream: TMemoryStream;
  Params: TStringStream;
  uzklausa1, uzklausa2: string;
  RateList: IXMLFxRatesType;
  ResK, i, y, Day: integer;
  k_data: TDate;
  DS6: TZQuery;
begin
  FormatSettings.DateSeparator:= '-';
  DS6:= TZQuery.Create(nil);
  DS6.Connection:= frmConnection.ZConnection1;
  with DS6 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('query');
    Open;
  end;
  if DS6.FieldValues['data'] = 'yes' then
  begin
    with DS6 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('some query');
      Open;
    end;

    k_data:= DS6.FieldByName('buh_data').AsDateTime;
    if DayOfWeek(Date).ToString = '7' then
      k_data:= k_data + 1;
    if DayOfWeek(Date).ToString = '1' then
      k_data:= k_data + 2;
    ResK:= CompareDate(k_data, Date);
    if (ResK < 0) then
    begin
      Day:= 0;
      ResK:= CompareTime(StrToTime('15:15:00'), Now);
      if (ResK <= 0) then
        Day:= -1;
      if DayOfWeek(Date).ToString = '7' then
        Day:= Day -1;
      if DayOfWeek(Date).ToString = '1' then
        Day:= Day -2;

      iHTTP:= TIdHTTP.Create(nil);
      XMLDoc1:= TXMLDocument.Create(nil);

      aStream := TMemoryStream.create;
      Params := TStringStream.create('');
      try
        with iHTTP do
        begin
          Params.WriteString(URLEncode(...));
          Request.ContentType := 'application/x-www-form-urlencoded';
          Request.CharSet := 'utf-8';
          try
            Response.KeepAlive := False;
            Post('http://...', Params, aStream);
          except
            on E: Exception do
            begin
              Exit;
            end;
          end;
        end;
        aStream.WriteBuffer(#0' ', 1);
      except
        aStream.Free;
        Params.Free;
        Exit;
      end;

      frmConnection.ZConnection1.StartTransaction;
      try
        with DS6 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('DROP TABLE IF EXISTS ...');
          ExecSQL;
        end;
        with DS6 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('CREATE TEMPORARY TABLE ...)');
          ExecSQL;
        end;

        with DS6 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('some query');
          Open;
        end;
        if DS6.FieldValues['p_data'] = NULL then
          y:= 0
        else
          y:= 1;
        RemoveNullFromMemoryStream(aStream);
        XMLDoc1.LoadFromStream(aStream);
        RateList:= GetFxRates(XMLDoc1);
        for i:= 0 to RateList.Count - 1 do
        begin
          with DS6 do
          begin
            Close;
            SQL.Clear;
            SQL.Add('some query');
            ExecSQL;

            uzklausa1:= 'insert_query';
            uzklausa2:= 'update_query';
            SQL.Clear;
            if y = 0 then
              SQL.Add(q1)
            else
              SQL.Add(q2);
            ExecSQL;
          end;
        end;

        Day:= 0;
        if (ResK <= 0) and ((DayOfWeek(Date).toString <> '1') or (DayOfWeek(Date).toString <> '7')) then
          Day:= 0;
        if (DayOfWeek(Date).toString = '1') then
          Day:= Day - 2;
        if (DayOfWeek(Date).toString = '7') then
          Day:= Day - 1;


        with DS6 do
        begin
          Close;
          SQL.Clear;
          SQL.Add('some query');
          ExecSQL;
        end;
        frmConnection.ZConnection1.Commit;
      except
        on E: Exception do
        begin
          frmConnection.ZConnection1.Rollback;
        end;
      end;
    end;
  end;
end;

person Mindaugas    schedule 03.08.2016    source источник
comment
Не подавляйте все исключения. Позвольте им течь вверх, и вы получите более подробную информацию о том, что происходит не так.   -  person Sir Rufo    schedule 03.08.2016
comment
Кстати, вы не должны использовать соединение db из основного потока внутри любого другого потока.   -  person Sir Rufo    schedule 03.08.2016
comment
да, TADOConnection не является потокобезопасным. вы должны передать всю строку подключения в новый поток   -  person Zam    schedule 03.08.2016
comment
Я не понимаю отношения между обоими блоками кода. Где procedure Update_Currency_Rate выполняется (не) в первом?   -  person René Hoffmann    schedule 03.08.2016
comment
Задача 5 не синхронизирует свой доступ к VCL.   -  person Rob Kennedy    schedule 03.08.2016
comment
Да, потому что он просто ждет завершения последней задачи и закрывает форму.   -  person Mindaugas    schedule 04.08.2016
comment
Я вижу, что процедура перестает выполняться на этой команде: XMLDoc1.LoadFromStream(aStream); Но не понимаю, почему?   -  person Mindaugas    schedule 04.08.2016
comment
Должно быть исключение... скажите какое и сообщение   -  person Sir Rufo    schedule 04.08.2016
comment
Вы сделали много злых вещей в многопоточности. Не используйте глобальную переменную FormatSettings, чтобы сохранить свои личные/локальные настройки. Он может быть изменен в любое время операционной системой. И есть еще некоторые...   -  person Sir Rufo    schedule 04.08.2016
comment
Вам по-прежнему необходимо синхронизировать доступ к VCL в Task5, потому что он все еще находится в отдельном потоке от основного потока. Неважно, что он просто ждет Task4; его по-прежнему необходимо синхронизировать с основным потоком для доступа к пользовательскому интерфейсу.   -  person Ken White    schedule 04.08.2016


Ответы (1)


Я получаю исключение после небольшого изменения кода TTask:

try 
  Unit1.Procedure1; 
except 
  on E: Exception do 
  begin 
    MessageDlg('Error: ' + E.Message, mtError, [mbOK], 0); 
  end; 
end; 

Сообщение об ошибке: MSXML не установлен. Есть решение: XML: MSXML не установлен

person Mindaugas    schedule 04.08.2016