freepascal.ru

Возникла необходимость в написании ftp-клиента для автоматической синхронизации ftp сервера и локальной папки. Основные данные выкладываются на ftp сервер. В качестве компонента используется TFtpSend из пакета Synapse. Проблема возникла при организации рекурсивного прохода по папкам на ftp сервере. Есть у кого-нибудь мысли на этот счет?

Варианты решения есть, но понимаю, что они не самые оптимальные.
1. создание структуры папок при первом проходе и вторым проходом осуществлять синхронизацию
2. делать синхронизацию сначала корневой папки, а потом на основе полученной структуры продолжить синхронизацию вложенных папок

Padre_Mortius писал(а):1. создание структуры папок при первом проходе и вторым проходом осуществлять синхронизацию

DrWeb так же работает. Сначала каталоги сканирует, составляет список, а потом по этому списку файлы проверяет.

Вообщем представляю на суд результат моих творений по второму решению. Использовался компонент TFTPSend из пакета Synapse

Код: Выделить всё

procedure WriteToLog (Msg: AnsiString);
Var
  LogStream: TFileStream;
  LogFileName: AnsiString;
Begin
  LogFileName := ExtractFilePath(Application.ExeName) + 'message.log';
  Try
    If Not FileExists(LogFileName) Then
      LogStream := TFileStream.Create(UTF8ToSys(LogFileName), fmCreate)
    Else LogStream := TFileStream.Create(UTF8ToSys(LogFileName), fmOpenWrite);
    LogStream.Seek(0, sofromEnd);
    Msg := FormatDateTime('DD-MM-YYYY HH:mm:SS', Now) + '   ' + Msg + #13#10;
    LogStream.Write (PChar(Msg)[0], Length(Msg));
  Finally
    LogStream.Free;
  End;
End;

procedure TMainForm.FindAllDirectories(ftp: TftpSend; srvPath, locPath: AnsiString);
var
   SearchRec: TSearchRec;
   i:integer;
   Attr:Integer;
begin
   Attr := faAnyFile;
   locPath := AppendPathDelim(locPath) + '*';
   i := FindFirstUTF8(locPath, Attr, SearchRec);
   while i = 0 do
      begin
         locPath := AnsiToUTF8(ExtractFilePath(UTF8ToAnsi(locPath))) + SearchRec.Name;
         srvPath := ServerPathEdit.Text + '/' + CreateRelativePath(locPath, LocalPathEdit.Text);
        // ServerPathEdit.Text корневая папка на ftp-сервере
         if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
         if (SearchRec.Attr and faDirectory)>0 then
            begin
              Synchronization(ftp, srvPath, locPath);
              FindAllDirectories(ftp, srvPath, locPath);
            end;
         i:=FindNextUTF8(SearchRec);
      end;
end;

procedure Synchronization(ftp: TFtpSend; ServerPath, LocalPath: AnsiString);
var
  i: integer;
  aName: AnsiString;
begin
  WriteToLog('Смена рабочей папки на сервере. Текущая папка ' + ServerPath);
  ftp.ChangeWorkingDir(ServerPath);
  WriteToLog(ftp.ResultString);
  ftp.List('', false);
  WriteToLog(ftp.ResultString);
  for i:=0 to ftp.FtpList.Count - 1 do
  begin
    Application.ProcessMessages;
    aName := ftp.FtpList.Items[i].FileName;
    if ftp.FtpList.Items[i].Directory then
    begin
      if not DirectoryExistsUTF8(AppendPathDelim(LocalPath) + aName) then
        CreateDirUTF8(AppendPathDelim(LocalPath) + aName);
    end else
      begin
        if (not FileExistsUTF8(AppendPathDelim(LocalPath) + aName)) then
        // файл не найден в локальной папке
        begin
          WriteToLog('Закачка отсутствующего файла ' + aName);
          ftp.DirectFile := true;
          ftp.DirectFileName := AppendPathDelim(LocalPath) + aName;
          if ftp.RetrieveFile(UTF8ToSys(aName), false) then WriteToLog('Файл ' + aName + ' успешно закачан.')
            else WriteToLog('Ошибка при загрузке файла. Код ошибки ' + ftp.ResultString);
          FileSetDateUTF8(ftp.DirectFileName, DateTimeToFileDate(ftp.FtpList.Items[i].FileTime));
        end else
          begin
            if (FileAgeUTF8(AppendPathDelim(LocalPath) + aName) <> DateTimeToFileDate(ftp.FtpList.Items[i].FileTime)) then
            begin
              WriteToLog('Обновление существующего файла ' + aName);
              ftp.DirectFile := true;
              ftp.DirectFileName := AppendPathDelim(LocalPath) + aName;
              ftp.RetrieveFile(UTF8ToSys(aName), false);
              FileSetDateUTF8(ftp.DirectFileName, DateTimeToFileDate(ftp.FtpList.Items[i].FileTime));
            end else
            if (FileSize(UTF8ToSys(AppendPathDelim(LocalPath) + aName)) <> ftp.FtpList.Items[i].FileSize) then
            begin
              ftp.DirectFile := true;
              ftp.DirectFileName := AppendPathDelim(LocalPath) + aName;
              if ftp.RetrieveFile(UTF8ToSys(aName), false) then WriteToLog('Файл ' + aName + ' успешно закачан.')
                else WriteToLog('Ошибка при загрузке файла. Код ошибки ' + ftp.ResultString);
              FileSetDateUTF8(ftp.DirectFileName, DateTimeToFileDate(ftp.FtpList.Items[i].FileTime));
            end;
          end;
      end;
  end;
  ftp.ChangeToRootDir;
end;

procedure TMainForm.RefreshBtnClick(Sender: TObject);
var
  ftpclient: TFtpSend;
begin
  try
    ftpclient := TFtpSend.Create;
    ftpclient.FtpList.Clear;
    ftpclient.BinaryMode := False;
    ftpclient.TargetHost := HostEdit.Text;
    if UTF8Length(LoginEdit.Text) <> 0 then ftpclient.UserName := LoginEdit.Text; \\проверка введен ли логин или используется анонимное подключение
    if UTF8Length(PasswdEdit.Text) <> 0 then ftpclient.Password := PasswdEdit.Text; \\проверка на пустой пароль
    ftpclient.TargetPort := cFtpProtocol;
    ftpclient.PassiveMode := true;
    ftpclient.Login;
    WriteToLog('Авторизация: ' + ftpclient.ResultString);
    Synchronization(ftpclient, ServerPathEdit.Text, LocalPathEdit.Text);
    FindAllDirectories(ftpclient, ServerPathEdit.Text, LocalPathEdit.Text);
    WriteToLog('Завершение сессии');
    ftpclient.Logout;
  finally
    FreeAndNil(ftpclient);
  end;
end;

Э, хм, а запросить какой-нибудь скрипт на сервере построить для вас структуру каталогов в виде одного текстового файла - никак?

А подробней можно? Специально для решения этого вопроса поднимал rfc 959, но ничего похожего не видел

Padre_Mortius писал(а):А подробней можно?

Условно говоря сначала отсылается такой запрос:
http://you.server.org/cgi-bin/scan_catalogs
Вот этот самый scan_catalogs с помощью FindFirst()-FindNext() строит структуру каталога и записывает в текстовый файл корневого каталога ftp-сервера, например в catalogs.txt. Далее получаешь этот файл с ftp-сервера, читаешь и вуа-ля, узнаёшь текущую структуру ftp-сервера. Сравниваешь со своей и добавляешь-удаляешь что-либо в случае необходимости.

Данное решение не подходит в связи с тем, что доступ есть только через ftp-протокол и только на чтение.

Синхронизация файлов можно скачать отсюда.