Pascal (Lazarus/Delphi)

Async Task Chain (another example)

See more Async Examples

Demonstrates using a task chain to run a sequence of FTP tasks asynchronously. Pascal (Lazarus/Delphi)

program ChilkatDemo;

// Demonstrates using the Chilkat Pascal wrapper via the C bridge DLL.
// Builds as a console application under Lazarus (FPC) or Delphi.

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  SysUtils,
  CkDllLoader,
  Chilkat.Task,
  Chilkat.Ftp2,
  Chilkat.TaskChain;

// ---------------------------------------------------------------------------

procedure RunDemo;
var
  success: Boolean;
  ftp: TFtp2;
  taskChain: TTaskChain;
  task: TTask;
  localFilename: string;
  remoteFilename: string;
  numTasks: Integer;
  taskIdx: Integer;

begin
  success := False;

  //  This example assumes the Chilkat API to have been previously unlocked.
  //  See Global Unlock Sample for sample code.

  success := False;

  ftp := TFtp2.Create;

  ftp.Hostname := 'ftp.example.com';
  ftp.Username := 'login';
  ftp.Password := 'password';

  //  Connect and login to the FTP server.
  success := ftp.Connect();
  if (success <> True) then
    begin
      WriteLn(ftp.LastErrorText);
      Exit;
    end;

  taskChain := TTaskChain.Create;

  //  Create a task to change to the remote directory where the file will be uploaded.
  task := ftp.ChangeRemoteDirAsync('junk');
  if (ftp.LastMethodSuccess = False) then
    begin
      WriteLn(ftp.LastErrorText);
      Exit;
    end;
  //  Add this task to the task chain.
  success := taskChain.Append(task);
  task.Free;

  //  Create a task to upload a file.
  localFilename := 'c:/temp/hamlet.xml';
  remoteFilename := 'hamlet.xml';

  task := ftp.PutFileAsync(localFilename,remoteFilename);
  if (ftp.LastMethodSuccess = False) then
    begin
      WriteLn(ftp.LastErrorText);
      Exit;
    end;

  //  Add this task to the task chain.
  success := taskChain.Append(task);
  task.Free;

  //  Start the task chain running in a background thread.
  //  Each task is run one after the other (on the same background thread) until all tasks have completed.
  //  The task chain will stop at the first task that fails.
  taskChain.StopOnFailedTask := True;
  success := taskChain.Run();
  if (not success) then
    begin
      WriteLn(taskChain.LastErrorText);
      Exit;
    end;

  //  The application is now free to do anything else
  //  while the FTP commands are being run...

  //  For this example, we'll simply sleep and periodically
  //  check to see if the taskchain if finished. 
  while taskChain.Finished <> True do
    begin

      //  Sleep 100 ms.
      taskChain.SleepMs(100);

    end;

  //  A finished task chain could be one that was canceled, aborted, or truly finished.  

  //  If the task chain "completed", then it ran to completion.  A "completed" task will
  //  have a StatusInt equal to 7.   If the task finished, but was not completed, then it must've
  //  been aborted or canceled:
  if (taskChain.StatusInt <> 7) then
    begin
      WriteLn('Task did not complete.');
      WriteLn('task chain status: ' + taskChain.Status);
      Exit;
    end;

  //  If we got to this point, the ChangeRemoteDir and PutFile were successful.
  //  We can visually verify by examining the LastErrorText that was recorded for each
  //  of these method calls..
  numTasks := taskChain.NumTasks;
  taskIdx := 0;

  while (taskIdx < numTasks) do
    begin

      task := taskChain.GetTask(taskIdx);

      //  Examine the status of this task, and the ResultErrorText
      //  (the ResultErrorText is the ftp.LastErrorText captured for FTP method called by the task).
      //  Everything should indicate success.
      WriteLn('task status: ' + task.Status);
      WriteLn('task log: ' + task.ResultErrorText);

      task.Free;

      taskIdx := taskIdx + 1;
    end;

  success := ftp.Disconnect();


  ftp.Free;
  taskChain.Free;

end;

// ---------------------------------------------------------------------------

begin

  try
    RunDemo;
  except
    on E: Exception do
      WriteLn('Unhandled exception: ', E.ClassName, ': ', E.Message);
  end;

  WriteLn;
  {$IFDEF MSWINDOWS}
  WriteLn('Press Enter to exit...');
  ReadLn;
  {$ENDIF}
end.