Question

我尝试使用TTask在应用程序启动时进行响应，并进行一些数据库更新。当应用程序启动时，DB更新表单开始并按顺序执行多个过程并显示更新进度（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;

Answer 1

稍微修改TTask代码后出现异常：

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

错误消息：未安装MSXML 还有一个解决方案：XML: MSXML Not Installed

Delphi TTask - 一个未执行的过程

1 个答案: