ich brauche längerfristig eine Funktion, die Inhalte zwischen einem FTP-Server und der lokalen Festplatte synchronisieren kann. Man übergibt den Pfad zu einem lokalen Verzeichnis und einem Server-Verzeichnis (und das TFTPSend) und dann läuft das für alle Verzeichnisse Rekursiv durch:
- Wenn lokale Datei neuer, als Server-Datei → hochladen
- Wenn Server-Datei existiert, lokale Datei aber nicht → von Server löschen
- Selbiges für Verzeichnisse
- Ich weiß nicht, in wieweit man per FTP Hash-Werte der Dateien bekommt, eventuell wäre es möglich, Umbenennungen/Verschiebungen zu erkennen: Listen der Dateien, die es nur lokal gibt mit Listen der Dateien, die nur auf dem Server liegen vergleichen
Hat jemand schon so was geschrieben?
[Edit:] Meine Lösung:
Code: Alles auswählen
type
SyncDirMessages = set of (overwrite, delete);
SyncDirDirection = (dirUpload, dirDownload);
FileListItem = record
Name : String;
ModifyTime : int64;
Size : QWord;
Directory : Boolean;
end;
procedure synchronizeDir (ftp:TFTPSend; localPath:String; serverPath:String; direction:SyncDirDirection=dirUpload; msg:SyncDirMessages=[delete]; logList:TStrings=nil);
var
dt : int64;
procedure log (str:String);
begin
if (logList = nil) then exit;
logList.add(str);
Application.ProcessMessages;
end;
procedure err (str:String);
begin
log ('Fehler: ' + str + ' Code: ' + intToStr(ftp.ResultCode) + ' - ' + ftp.ResultString);
end;
function winToUnix (t:uint64) : int64;
begin
Result := (t div 10000000) - 11644473600 + 7201;
end;
procedure syncTime;
var
i : integer;
txt : TStringList;
SR : TWIN32FindData;
hF : THandle;
b : Boolean;
begin
txt := TStringList.Create;
txt.Add('Diese Datei dient zur Synchronisierung der Zeit zwischen verschiedenen Dateisystemen.');
txt.SaveToFile(localPath + 'SyncTimeFile.txt');
txt.Free;
dt := 0;
hF := Windows.FindFirstFile(PChar(localPath + '*'), SR);
if (hF <> 0) then try
repeat if (PChar(@SR.cFileName[0]) = 'SyncTimeFile.txt') then begin
dt := WinToUnix(QWord(SR.ftLastWriteTime));
if (abs(dt-DateTimeToUnix(now)) > 2) then log('WARNUNG: Filesystem-Zeitdifferenz entdeckt (' + inttostr(dt-DateTimeToUnix(now)) + ' s)');
break;
end until (not FindNextFile(hF, SR));
finally
Windows.FindClose(hF);
end;
if (dt = 0) then begin log('Unbekannter Fehler!'); exit; end;
ftp.DirectFileName := localPath+'SyncTimeFile.txt';
ftp.DirectFile := true;
ftp.ChangeToRootDir;
if (not ftp.ChangeWorkingDir(serverPath)) then err('Konnte '+serverPath+' nicht öffnen!');
if (not ftp.StoreFile('SyncTimeFile.txt', false)) then begin err('Konnte Datei nicht hochladen!'); exit; end;
if (not ftp.List('', false)) then err('Konnte Ordnerinhalt nicht abfragen!');;
b := false;
for i := 0 to ftp.FtpList.Count-1 do if (ftp.FTPList[i].FileName = 'SyncTimeFile.txt') then begin
dt := dt - DateTimeToUnix(ftp.FTPList[i].FileTime);
b := true;
break;
end;
if (not b) then begin log('Unbekannter Fehler!'); exit; end;
deleteFile(PChar(localPath + 'SyncTimeFile.txt'));
ftp.DeleteFile('SyncTimeFile.txt');
end;
procedure sync (path:String; del:Boolean=false);
var
localList, serverList : Array of FileListItem;
SR : TWIN32FindData;
hF : THandle;
i,j : integer;
b : Boolean;
begin
localList := nil;
serverList := nil;
// Load server file list
ftp.ChangeToRootDir;
if (not ftp.List(serverPath + path, false)) then begin err('Ordner '+serverPath + path+' konnte nicht gelistet werden!'); exit; end;
SetLength(serverList, ftp.FtpList.Count);
for i := 0 to ftp.FtpList.Count-1 do begin
serverList[i].Name := ftp.FtpList[i].FileName;
serverList[i].Directory := ftp.FtpList[i].Directory;
serverList[i].Size := ftp.FtpList[i].FileSize;
serverList[i].ModifyTime := DateTimeToUnix(ftp.FtpList[i].FileTime) + 60 + dt;
end;
// Load local file list
setLength(localList, 0);
if (not del) then begin
hF := Windows.FindFirstFile(PChar(localPath + path + '*'), SR);
if (hF <> 0) then try
repeat if (SR.dwFileAttributes and 16 = 0) and (PChar(@SR.cFileName[0]) <> '') or (PChar(@SR.cFileName[0]) <> '.') and (PChar(@SR.cFileName[0]) <> '..') then begin
i := Length(localList);
SetLength(localList, i+1);
localList[i].Name := PChar(@SR.cFileName[0]);
localList[i].Directory := (SR.dwFileAttributes and 16 = 16);
localList[i].ModifyTime := WinToUnix(QWord(SR.ftLastWriteTime));
PCardinal(@localList[i].Size)^ := SR.nFileSizeLow;
PCardinal(@localList[i].Size+4)^ := SR.nFileSizeHigh;
end until (not FindNextFile(hF, SR));
finally
Windows.FindClose(hF);
end;
// upload missing or modified files
ftp.ChangeToRootDir;
if (not ftp.ChangeWorkingDir(serverPath+path)) then err('Konnte nicht in Verzeichnis '+serverPath+path+' springen!');
for i := 0 to Length(localList)-1 do begin
b := false;
for j := 0 to Length(serverList)-1 do begin
if (localList[i].Directory <> serverList[j].Directory) then continue;
if (localList[i].Name <> serverList[j].Name) then continue;
if (localList[i].Directory) or (localList[i].ModifyTime < serverList[j].ModifyTime) and (localList[i].Size = serverList[j].Size) then b := true
else if (overwrite in msg) and (MessageDlg('Überschreiben', 'Datei '+serverPath+path+serverList[j].Name+' mit der lokalen Version überschreiben?', mtConfirmation, [mbYes, mbNo], 0) = mrNo) then b := true;
end;
if (not b) then begin
if (localList[i].Directory) then begin
if (ftp.CreateDir(localList[i].Name)) then log('Erstellt: '+serverPath+path+localList[i].Name)
else err('Konnte '+serverPath+path+localList[i].Name+' nicht erstellen!');
end else begin
ftp.DirectFileName := localPath+path+localList[i].Name;
ftp.DirectFile := true;
if (ftp.StoreFile(localList[i].Name, false)) then log('Hochgeladen: '+serverPath+path+localList[i].Name)
else err('Konnte '+serverPath+path+localList[i].Name+' nicht hochladen!');
end;
end;
end;
end;
// delete non-existing files
ftp.ChangeToRootDir;
if (not ftp.ChangeWorkingDir(serverPath+path)) then err('Konnte nicht in Verzeichnis '+serverPath+path+' springen!');
for j := 0 to Length(serverList)-1 do begin
b := false;
for i := 0 to Length(localList)-1 do begin
if (localList[i].Directory <> serverList[j].Directory) then continue;
if (localList[i].Name <> serverList[j].Name) then continue;
b := true;
end;
if (not b) then if (del) or (not (delete in msg)) or (MessageDlg('Löschen', serverPath+path+serverList[j].Name+' löschen?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then begin
if (serverList[j].Directory) then begin
sync(path+serverList[j].Name+'/', true);
ftp.ChangeToRootDir;
if (not ftp.ChangeWorkingDir(serverPath+path)) then err('Konnte nicht in Verzeichnis '+serverPath+path+' springen!');
if (ftp.DeleteDir(serverList[j].Name)) then log('Gelöscht: '+serverPath+path+serverList[j].Name)
else err('Konnte '+serverPath+path+serverList[j].Name+' nicht löschen!');
end else begin
if (ftp.DeleteFile(serverList[j].Name)) then log('Gelöscht: '+serverPath+path+serverList[j].Name)
else err('Konnte '+serverPath+path+serverList[j].Name+' nicht löschen!');
end;
end;
end;
// scan subdirectories
if (not del) then for i := 0 to Length(localList)-1 do if (localList[i].Directory) then begin
sync(path + localList[i].Name + '/')
end;
end;
begin
log('Synchronisiere Zeit...');
syncTime;
log('Zeitdifferenz (local - server) ist '+inttostr(dt));
log('Beginne Abgleich...');
sync('');
log('Synchronisiert: '+localPath + ' --> ' + serverPath);
end;
- Aufruf kann z.B. so aussehen:
Code: Alles auswählen
ftp := TFTPSend.Create;
[...]
ftp.Login;
SynchronizeDir(ftp,'D:\Website\media\ ', 'html/media/', dirUpload, [overwrite, delete], MemoLog.Lines);
// Achtung: Pfade müssen mit (Back)slash enden; lokale Pfade haben Backslashs, kommen aber praktischer Weise auch mit normalen Slashs aus; Serverpfade müssen normale Slashs haben.
- Bei Fragen melden!
- Fehler und Verbesserungen posten!
- Im Moment ist noch keine Erkennung von Umbenennungen einprogrammiert.
- Tipp: Dieses Thema abonnieren, um Updates zu erhalten
Verein
Links
