Delphi TTask - one procedure not executed

Question

I try to use TTask to make application responsive when it starts and makes some DB updates. When application starts DB update form starts and performs several procedures in sequence and also show update progress (ProgrssBar1). All procedures are placed in dedicated Unit. Code example:

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;

All procedures are executed successfully except one. If I execute this procedure directly it works perfectly. Maybe there are some limitations running procedures as TTask? Problem procedure code:

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;

Do not suppress all exceptions. Let them flow up and you will get some more details about whats going wrong — Sir Rufo, Aug 03 '16 at 13:58
BTW you must not use the db connection from the main thread inside any other thread — Sir Rufo, Aug 03 '16 at 14:00
yes, TADOConnection is not thread safe. you must pass entiry connection string into new thread — Zam, Aug 03 '16 at 15:36
I don't get the relationship between both code blocks. Where is `procedure Update_Currency_Rate` being (not) executed in the first one? — René Hoffmann, Aug 03 '16 at 16:00
Yes, because it just waits the last task to be completed and closes the form. — Mindaugas, Aug 04 '16 at 05:33
I see that procedure stops executing at this command: XMLDoc1.LoadFromStream(aStream); But don't understand, why? — Mindaugas, Aug 04 '16 at 06:25
There should be an exception ... tell us which one and the message — Sir Rufo, Aug 04 '16 at 07:21
You did many things that are evil while in multithreading. Do not use global var FormatSettings to keep your personal/local settings. It can be changed at any time by the OS. And there are some more ... — Sir Rufo, Aug 04 '16 at 07:28
You still need to synchronize access to the VCL in Task5, because it's still in a separate thread from the main thread. It doesn't matter that it's just waiting for Task4; it still needs to be synchronized with the main thread to access the UI. — Ken White, Aug 04 '16 at 18:16

score 0 · Answer 1 · edited May 23 '17 at 10:28

0

I get an exception after slightly modify TTask code:

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

Error message: MSXML Not Installed And there is a solution: XML: MSXML Not Installed

edited May 23 '17 at 10:28

Community

1
1

answered Aug 04 '16 at 18:12

Mindaugas

115
2
11

Delphi TTask - one procedure not executed

1 Answers1