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.