uses windows, messages, sysutils, classes, SyncObjs, Contnrs,
     idComponent, idFTP, IdFTPList, IdFTPCommon, xProcs, ExtCtrls;

const

  WM_START_FTPDOWN = WM_USER + 401;
  WM_FINISH_FTPDOWN = WM_USER + 402;
  WM_FTP_MESSAGE = WM_USER + 403;
  WM_FTP_STATUSMSG = WM_USER + 404;

type
  PTransfer = ^TTransfer;
  TTransfer = record
    Percent: Integer;
    Aktuell,
    Overall,
    Total: Int64;
  end;

  TFTPDown = class(TThread)
  private
    FTransferInfo: TTransfer;
    FInfoTimer: TTimer;
    FLastWorkCount: Int64;
    FGesamt: Int64;
    Fmsg: PChar;
    FMainWndHandle: HWND;
    FLocalPath,
    FToLoad: String;
    FFTPClient: TidFTP;
    procedure OnStartThread();
    procedure OnPreTerminate();
    procedure OnMessage();
  protected
    procedure DownloadFolder(AFTP: TIdFtp; ARemotePath, ALocalPath:string; bOverwrite:Boolean);
    function FindFile( AFTP: TIdFtp ): Boolean;
    function GetFolderSize( ARemotePath: String ): Int64;
    procedure DoTimer( Sender: TObject );

    procedure FTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure FTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure FTPWorkEnd( Sender: TObject; AWorkMode: TWorkMode);
  public
    class function DoDownLoad( mainwnd: HWND; const dlItem: String ): boolean;
    class procedure ClearDownloads;
    class function HasActiveDownloads: Boolean;

    constructor create( mainthr: HWND; const _Item: String );
    destructor Destroy(); override;
    procedure Execute; override;
    property DownFilename: string read FToLoad;
    property Size: Int64 read FGesamt;
  end;


implementation

var
  FDownList: TObjectList;


class function TFTPDown.DoDownLoad( mainwnd: HWND; const dlItem: String ): boolean;
begin
  FDownList.Add( Create( mainwnd, dlItem ) );
end;
class function TFTPDown.HasActiveDownloads: Boolean;
begin
  result := (FDownList.Count > 0);
end;
class procedure TFTPDown.ClearDownloads;
var
  i: integer;
begin
  for i := Pred(FDownList.Count) downto 0 do begin
    if Assigned((FDownList.Items[i] as TFTPDown)) then begin
      (FDownList.Items[i] as TFTPDown).Terminate;
    end;
  end;
end;

constructor TFTPDown.create( mainthr: HWND; const _Item: String );
begin
  FMainWndHandle := mainthr; {Hauptanwendung bekommt Messages}
  FToLoad := _Item; {Datei- oder Verzeichnisname des DL}
  FLocalPath := strAddSlash(regReadDefValue( HKEY_CURRENT_USER, 'software\FloSoft\DVBase\TSRSS\btFTPDLDir', dtString, ExtractFilePath(ParamStr(0))) );

  FFTPClient := TidFTP.Create(nil);
  FFTPClient.Username := regReadValue( HKEY_CURRENT_USER, 'software\FloSoft\DVBase\TSRSS\btUser', dtString);
  FFTPClient.Password := regReadValue( HKEY_CURRENT_USER, 'software\FloSoft\DVBase\TSRSS\btPass', dtString);
  FFTPClient.Host := regReadValue( HKEY_CURRENT_USER, 'software\FloSoft\DVBase\TSRSS\btHost', dtString);
  FFTPClient.Port := 21;
  FFTPClient.Passive := True;
  FFTPClient.TransferType := ftBinary;
  FFTPClient.OnWork := FTPWork;
  FFTPClient.OnWorkBegin := FTPWorkBegin;
  FFTPClient.OnWorkEnd := FTPWorkEnd;


  FInfoTimer := TTimer.Create( nil );
  FInfoTimer.Enabled := False;
  FInfoTimer.Interval := 1000;
  FInfoTimer.OnTimer := DoTimer;

  inherited Create( false );
  FreeOnTerminate := True;
end;

destructor TFTPDown.Destroy();
begin
  FreeAndNil( FInfoTimer );
  FreeAndNil( FFTPClient );
  FDownList.Remove(self);
  inherited Destroy;
end;


procedure TFTPDown.Execute;
var
  cRemotePath: String;
  lSingleFile: Boolean;
begin

  FLastWorkCount := 0;
  FTransferInfo.Percent := 0;
  FTransferInfo.Aktuell := 0;
  FTransferInfo.Overall := 0;
  FTransferInfo.Total := 0;

  Synchronize( OnStartThread );
  FInfoTimer.Enabled := True;

  try
    FFTPClient.Connect;
  except
    on E:Exception do begin
      FMsg := PChar('Fehler bei der Verbindungsaufnahme ('+e.Message+')');
      Synchronize( OnMessage );
      FFTPClient.Disconnect;
      FFTPClient.Quit;
      exit;
    end;
  end;

  // Prüfen - Datei oder Ordner?
  try
      lSingleFile := False;
      cRemotePath := 'files/'+FToLoad;
      FFTPClient.ChangeDir(cRemotePath);
  except
      // Only Dateidownload
      lSingleFile := True;
      cRemotePath := 'files/';
      FFTPClient.ChangeDir(cRemotePath);
  end;

  // Transfer einleiten
  if not Terminated then begin
    FMsg := 'Download startet';
    Synchronize( OnMessage );

    if lSingleFile then begin
      if FindFile( FFTPClient ) then begin
        FTransferInfo.Total := FGesamt;
        if Fileexists(FLocalPath+FToLoad) then DeleteFile(FLocalPath+FToLoad);
        FFTPClient.Get(FToLoad, FLocalPath+FToLoad);
      end;
    end else begin
      FGesamt := GetFolderSize( cRemotePath );
      FTransferInfo.Total := FGesamt;
      ForceDirectories(FLocalPath+FToLoad);
      DownloadFolder(FFTPClient, cRemotePath, FLocalPath+FToLoad, true);
    end;
  end;

  // = Disconnect and Free FTP-Instance
  FFTPClient.Disconnect;
  FFTPClient.Quit;

  FInfoTimer.Enabled := False;

  if not Terminated then
    Synchronize( OnPreTerminate );

end;

procedure TFTPDown.FTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
  // Abbruch des Get wird hier ermöglicht.
  // Das geschieht in Indy via Exception. Und das muss passieren, wenn der Thread
  // gekillt werden soll (z.B. Programmende)
  if Terminated then Abort;

  Inc( FTransferInfo.Overall, AWorkCount-FLastWorkCount );
  FLastWorkCount := AWorkCount;
  if FTransferInfo.Total > 0 then
    FTransferInfo.Percent := round((100 / FTransferInfo.Total) * FTransferInfo.Overall);
end;
procedure TFTPDown.FTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
end;
procedure TFTPDown.FTPWorkEnd( Sender: TObject; AWorkMode: TWorkMode);
begin
  FLastWorkCount := 0;
end;


procedure TFTPDown.OnStartThread();
begin
  if FMainWndHandle <> 0 then
    PostMessage( FMainWndHandle, WM_START_FTPDOWN, Integer(self), 0 );
end;
procedure TFTPDown.OnPreTerminate();
begin
  if FMainWndHandle <> 0 then
    PostMessage( FMainWndHandle, WM_FINISH_FTPDOWN, Integer(self), 0 );
end;
procedure TFTPDown.OnMessage();
begin
  if FMainWndHandle <> 0 then
    PostMessage( FMainWndHandle, WM_FTP_MESSAGE, Integer(Fmsg), 0 );
end;
procedure TFTPDown.DoTimer( Sender: TObject );
begin
  if FMainWndHandle <> 0 then
    PostMessage( FMainWndHandle, WM_FTP_STATUSMSG, 0, LPARAM(@FTransferInfo) );
end;



initialization
  FDownList := TObjectList.Create( false ); // OwnObjects=False, damit Freigabe gesteuert werden kann
finalization
  FreeAndNil( FDownList );

procedure TfrmMain.dxFTPDownClick(Sender: TObject);
var
  cOrdner: String;
begin

  RSSView.DataController.DataSource.DataSet.Bookmark := RSSView.DataController.GetSelectedBookmark(RSSView.Controller.SelectedRecordCount-1);
  cOrdner := RSSDB.ap.GetTrimString('FTPNAME');

  if cOrdner = '' then begin
    AddLog( 'FTP: Verzeichnis od. Dateiname nicht hinterlegt!' );
    exit;
  end;

  // DownloadThread starten und in interne ObjectList setzen
  TFTPDown.DoDownload( self.Handle, cOrdner );

end;

procedure TfrmMain.OnStartFTPDownloadThread( var Msg: TMessage );
begin
  AddLog( 'FTP: Transfer Thread gestartet - ' + TFTPDown(msg.wparam).DownFilename );
end;
procedure TfrmMain.OnFinishFTPDownloadThread( var Msg: TMessage );
begin
  AddLog( 'FTP: FTPTransfer abgschlossen - ' + TFTPDown(msg.wparam).DownFilename );
  jvStatusbar1.Panels[1].Text := '';
end;
procedure TfrmMain.OnFTPThreadMessage( var Msg: TMessage );
begin
  AddLog( 'FTP: ' + PChar(msg.wparam) );
end;
procedure TfrmMain.OnFTPStatusMessage( var Msg: TMessage );
var
  cLog: String;
begin
  cLog := Format('FTP: %s / %s geladen ( %d%% )',
                  [FileSizeToStr(PTransfer(msg.lparam)^.Overall),
                   FileSizeToStr(PTransfer(msg.lparam)^.Total),
                   PTransfer(msg.lparam)^.Percent ]);
  AddLog( cLog );
  jvStatusbar1.Panels[1].Text := cLog;
end;