unit Shared_FtpUpload;
(* *************************************************************************
    Software für den Schwimmsport
    - FTP-Upload mit Indy als Thread -
    (c) 2006 B.Stickan, [url]www.easywk.de[/url]
    Stand: 08.06.2006

    Beschreibung: der Thread führt einen FTP-Upload durch. Dabei können
    mehrere Dateien upgeloadet werden. Mit "AddToFileList" werden Dateien
    zur Uploadliste hinzugefügt. Die Dateien müssen alle im selben
    Quellverzeichnis liegen. Das Quellverzeichnis wird mit "SetSourceDir"
    gesetzt. Die FTP-Konfiguration wird aus mit "LoadConfig" aus
    einer INI-Datei geladen.

    Der Thread selber schläft die meiste Zeit. Er wird mit "StartUpload"
    geweckt und beginnt dann mit dem Transfer. Ist der Transfer erfolgreich
    abgeschlossen, wird die interne Dateiliste gelöscht, der Status
    steht auf ftpREADY und der Thread schläft wieder. Wenn der Thread
    schläft (Suspended=True) und der Status nicht auf ftpREADY steht,
    zeigt der Status an, bei welcher FTP-Aktion ein Fehler aufgetreten ist.
    Während ein Upload läuft, wird ein weiterer StartUpload verworfen.

    History
   ************************************************************************* *)
interface

uses
  Classes, SyncObjs, IdIntercept, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdFTP, IdFTPCommon, IdAntiFreeze,
  IdAntiFreezeBase;

type
  TFtpConfig =
    record
      Hostname : String; // Name des Hosts
      Username : String; // Username zum Einloggen
      Password : String; // Passwort zum Einloggen
      Passive : Boolean; // Passiver Transfer?
      TargetPath: String; // Zielverzeichnis auf dem Host
    end;

  TFtpAction = // Statusmeldung
    ( ftpCONNECTING, ftpCHANGEDIR, ftpUPLOADING, ftpREADY );

  TFtpUpload = class(TThread)
    private
      Semaphore : TCriticalSection;
      Ftp : TIdFtp;
      Config : TFtpConfig;
      HasJob : Boolean;
      FileList : TStrings;
      IState : TFtpAction;
      IFileCnt : Integer;
      SourceDir : String;
    public
      // was macht der FTP gerade bzw. was hat er zuletzt gemacht?
      property State:TFtpAction read IState;
      // Nummer der Datei, die gerade upgeloaded wir - 1-Basis
      property ActiveFile:Integer read IFileCnt;
      // erzeugen
      constructor Create(CreateSuspended:Boolean);
      // freigeben
      destructor Free;
      // die eigentliche Ausführungsroutine
      procedure Execute; override;
      // Konfiguration aus Ini-Datei laden
      procedure LoadConfig(ConfigFilename:String);
      // Dateien zur Uploadliste hinzufügen
      procedure AddFileToListe(Filename:String);
      // Quellverzeichnis setzen
      procedure SetSourceDir(Dirname:String);
      // Upload starten
      function StartUpload:Boolean;
    end;

implementation

uses
  IniFiles, SysUtils;

(* *************************************************************************
    Ausführen
   ************************************************************************* *)
procedure TFtpUpload.AddFileToListe(Filename: String);
begin
  // Sicherstellen, dass die Fileliste nicht anderweitig verwendet wird
  Semaphore.Acquire;
  FileList.Add(ExtractFilename(Filename));
  Semaphore.Release;
end;

(* *************************************************************************
    Erzeugen
   ************************************************************************* *)
constructor TFtpUpload.Create(CreateSuspended: Boolean);
begin
  // bei erzeugen CreateSuspended ignorieren!
  // immer Suspended anfangen
  inherited Create(TRUE);
  // Objekte anlegen
  Semaphore:=TCriticalSection.Create;
  Ftp:=TIdFtp.Create(NIL);
  FileList:=TStringList.Create;
  // Initialisierungen
  Priority:=tpNORMAL;
  FreeOnTerminate:=FALSE;
  IState:=ftpREADY;
  IFileCnt:=0;
  SourceDir:='';
  // noch haben wir keinen Auftrag
  HasJob:=FALSE;
end;

(* *************************************************************************
    Ausführen
   ************************************************************************* *)
procedure TFtpUpload.Execute;
var cnt:Integer;
begin
  // solange kein Endsignal laufen wir im Kreis
  while (not Self.Terminated) do
    begin
      // wenn wir einen Auftrag haben, führen wir den Upload durch
      // ansonsten legen wir uns schlafen
      if not HasJob then
        Self.Suspend
      else
        begin
          // Config eintragen
          Ftp.Host:=Config.Hostname;
          Ftp.Username:=Config.Username;
          Ftp.Password:=Config.Password;
          Ftp.Passive:=Config.Passive;
          Ftp.TransferType:=ftBINARY;
          try
            // Verbindung aufbauen
            IState:=ftpCONNECTING;
            IFileCnt:=0;
            Ftp.Connect(TRUE,5000);
            // ins Zielverzeichnis wechseln
            if Trim(Config.TargetPath)<>'' then
              begin
                IState:=ftpCHANGEDIR;
                Ftp.ChangeDir(Trim(Config.TargetPath));
              end;
            // in der Zeit des Sendes ist kein Zugriff auf die
            // Fileliste möglich!!!
            Semaphore.Acquire;
            // Alle Dateien aus der Dateiliste senden
            // jedes Mal Terminate abfragen, damit Abbruch möglich ist
            for cnt:=0 to FileList.Count-1 do
              if (not Self.Terminated) and
                 FileExists(SourceDir+FileList[cnt]) then
                begin
                  Inc(IFileCnt);
                  IState:=ftpUPLOADING;
                  Ftp.Put(SourceDir+FileList[cnt],FileList[cnt]);
                end;
            // wenn wir hier ankommen, war der gesamte Upload ok
            // die Fileliste wird gelöscht
            IState:=ftpREADY;
            FileList.Clear;
          finally
            Ftp.Disconnect;
            Semaphore.Release;
            Self.HasJob:=FALSE;
            Self.Suspend;
          end;
        end;
    end;
end;

(* *************************************************************************
    Freigeben
   ************************************************************************* *)
destructor TFtpUpload.Free;
begin
  FileList.Free;
  Ftp.Free;
  Semaphore.Free;
  inherited Destroy;
end;

(* *************************************************************************
    Konfiguration aus Ini-Datei laden
   ************************************************************************* *)
procedure TFtpUpload.LoadConfig(ConfigFilename: String);
var Ini:TIniFile;
begin
  Ini:=TIniFile.Create(ConfigFilename);
  Config.Hostname:=Ini.ReadString('FTP','Hostname','');
  Config.Username:=Ini.ReadString('FTP','Username','');
  Config.Password:=Ini.ReadString('FTP','Password','');
  Config.Passive:=Ini.ReadBool('FTP','Passive',FALSE);
  Config.TargetPath:=Ini.ReadString('FTP','TargetPath','');
  Ini.Free;
end;

(* *************************************************************************
    Quellverzeichnis setzen
   ************************************************************************* *)
procedure TFtpUpload.SetSourceDir(Dirname: String);
begin
  // Sicherstellen, dass nicht anderweitig verwendet wird
  Semaphore.Acquire;
  Self.SourceDir:=IncludeTrailingPathDelimiter(Dirname);
  Semaphore.Release;
end;

(* *************************************************************************
    Upload starten
   ************************************************************************* *)
function TFtpUpload.StartUpload:Boolean;
begin
  // wenn der Thread nicht Suspended ist, läuft noch ein Upload
  // --> kein erneuter Start!
  if Self.Suspended then
    begin
      Self.HasJob:=TRUE;
      Self.Resume;
      Result:=TRUE;
    end
  else Result:=FALSE;
end;

end.

// FtpUpload des Html-Projekts
procedure HtmlProjekt_FtpUpload(SourcePath:String);
var Ini:TIniFile; FtpExec:TFtpUpload; DirInfo:TSearchRec; FileCnt:Integer;
begin
  SourcePath:=IncludeTrailingPathDelimiter(SourcePath);
  // TBD FTP-Konfiguration eingebbar machen
  Ini:=TIniFile.Create(StartPath+CProgCfgFilename);
  Ini.WriteString('FTP','Hostname','www.domain.de');
  Ini.WriteString('FTP','Username','username');
  Ini.WriteString('FTP','Password','password');
  Ini.WriteBool('FTP','Passive',TRUE);
  Ini.WriteString('FTP','TargetPath','/files/public/');
  Ini.UpdateFile;
  Ini.Free;

  // Thread erzeugen
  FtpExec:=TFtpUpload.Create(TRUE);
  // Konfig laden
  FtpExec.LoadConfig(StartPath+CProgCfgFilename);
  // Quellverzeichnis setzen
  FtpExec.SetSourceDir(SourcePath);
  // Alle Dateien aus dem Quellverzeichnis für Übertragung vormerken
  FileCnt:=0;
  if FindFirst(SourcePath+'*.*',faAnyFile,DirInfo)=0 then
    repeat
      Inc(FileCnt);
      FtpExec.AddFileToListe(DirInfo.Name);
    until FindNext(DirInfo)<>0;
  // wenn überhaupt eine Datei gefunden, dann Transfer anstarten
  if FileCnt>0 then
    begin
      // Fortschrittsanzeige initialisieren
      Application.CreateForm(TFormFortschrittAbbrechen,FormFortschrittAbbrechen);
      FormFortschrittAbbrechen.Start('FTP-Upload',FileCnt);
      // FileCnt benutzen, um sich zu merken, bei welcher Datei der
      // Thread bei der letzten Abfrage war
      FileCnt:=0;
      // Thread anstarten
      FtpExec.StartUpload;
      // Warten, bis der Thread suspended und damit fertig ist
      while (not FtpExec.Suspended) do
        begin
          // Fortschrittanzeige führen
          if FileCnt<FtpExec.ActiveFile then
            begin
              FormFortschrittAbbrechen.StepBy(FtpExec.ActiveFile-FileCnt);
              FileCnt:=FtpExec.ActiveFile;
            end;
          // wenn in der Fortschrittsanzeige abgebrochen wird, dann
          // dies dem Thread mitteilen
          if FormFortschrittAbbrechen.Terminated then
            begin
              FtpExec.Terminate;
              FtpExec.WaitFor;
            end;
          // Rechenzeit freigeben
          Application.ProcessMessages;
        end;
      // Fortschrittsanzeige ausblenden / freigeben
      FormFortschrittAbbrechen.Stop;
      // Fehler auswerten
      case FtpExec.State of
          ftpCONNECTING :
            ErrorMsg('Fehler beim Verbinden',0);
          ftpCHANGEDIR :
            ErrorMsg('Fehler beim Wechsel ins Zielverzeichnis',0);
          ftpUPLOADING :
            ErrorMsg('Fehler beim Dateiupload',0);
          ftpREADY :
            begin { alles ok - just do nothing } end;
        end;
    end;
  // Thread löschen
  FtpExec.Free;
end;