Программирование Delphi

Эта функция показывает, как подключиться к FTP серверу и загрузить файл. Она использует функции из wininet.dll.

Вы должны поместить на форму TProgressBar, чтобы показывать ход работы и TLabel, который будет отображать информацию о процессе.

uses
  WinInet, ComCtrls;

function FtpDownloadFile(strHost, strUser, strPwd: string;
  Port: Integer; ftpDir, ftpFile, TargetFile: string;
  ProgressBar: TProgressBar): Boolean;

  function FmtFileSize(Size: Integer): string;
  begin
    if Size >= $F4240 then
      Result := Format('%.2f', [Size / $F4240]) + ' Mb'
    else
    if Size < 1000 then
      Result := IntToStr(Size) + ' байт'
    else
      Result := Format('%.2f', [Size / 1000]) + ' Kb';
  end;

const
  READ_BUFFERSIZE = 4096;  // или 256, 512, ...
var
  hNet, hFTP, hFile: HINTERNET;
  buffer: array[0..READ_BUFFERSIZE - 1] of Char;
  bufsize, dwBytesRead, fileSize: DWORD;
  sRec: TWin32FindData;
  strStatus: string;
  LocalFile: file;
  bSuccess: Boolean;
begin
  Result := False;

  { Открываем сессию интернет }
  hNet := InternetOpen(
    'Program_Name', // Agent
    INTERNET_OPEN_TYPE_PRECONFIG, // AccessType
    nil,  // ProxyName
    nil,  // ProxyBypass
    0     // или INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE
  );

  {
    Агент содержит имя приложения или
    вызов функций Internet
  }

  { Смотрим, правильный ли дескриптор соединения }
  if hNet = nil then
  begin
    ShowMessage('Не могу получить доступ к WinInet.Dll');
    Exit;
  end;

  { Соединяемся с FTP сервером }
  hFTP := InternetConnect(
    hNet, // Дескриптор из InternetOpen
    PChar(strHost), // FTP сервер
    port, // (INTERNET_DEFAULT_FTP_PORT),
    PChar(StrUser), // имя пользователя
    PChar(strPwd),  // пароль
    INTERNET_SERVICE_FTP, // FTP, HTTP или Gopher?
    0, // флаг: 0 или INTERNET_FLAG_PASSIVE
    0 
  );

  if hFTP = nil then
  begin
    InternetCloseHandle(hNet);
    ShowMessage(Format('Host "%s" is not available',[strHost]));
    Exit;
  end;

  { изменяем директорию }
  bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir));

  if not bSuccess then
  begin
    InternetCloseHandle(hFTP);
    InternetCloseHandle(hNet);
    ShowMessage(Format('Не могу установить директорию на %s.',[ftpDir]));
    Exit;
  end;

  { Чтение размера файла }
  if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then
  begin
    fileSize := sRec.nFileSizeLow;
    // fileLastWritetime := sRec.lastWriteTime
  end else
  begin
    InternetCloseHandle(hFTP);
    InternetCloseHandle(hNet);
    ShowMessage(Format('Cannot find file ',[ftpFile]));
    Exit;
  end;

  { Открываем файл }
  hFile := FtpOpenFile(
    hFTP, // Дескриптор ftp сессии
    PChar(ftpFile), // имя файла
    GENERIC_READ, // dwAccess
    FTP_TRANSFER_TYPE_BINARY, // dwFlags
    0 // Используется для обратного вызова процедур
  ); 

  if hFile = nil then
  begin
    InternetCloseHandle(hFTP);
    InternetCloseHandle(hNet);
    Exit;
  end;

  { Создаем новый локальный файл }
  AssignFile(LocalFile, TargetFile);
  {$i-}
  Rewrite(LocalFile, 1);
  {$i+}

  if IOResult <> 0 then
  begin
    InternetCloseHandle(hFile);
    InternetCloseHandle(hFTP);
    InternetCloseHandle(hNet);
    Exit;
  end;

  dwBytesRead := 0;
  bufsize := READ_BUFFERSIZE;

  while (bufsize > 0) do
  begin
    Application.ProcessMessages;

    if not InternetReadFile(
      hFile,
      @buffer, // адрес буфера, где хранятся данные
      READ_BUFFERSIZE, // количество байт для чтения из файла
      bufsize // реальное количество прочитанных байт
    ) then Break; 

    if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then
      BlockWrite(LocalFile, buffer, bufsize);
    dwBytesRead := dwBytesRead + bufsize;

    { Show Progress }
    ProgressBar.Position := Round(dwBytesRead * 100 / fileSize);
    Form1.Label1.Caption := 
      Format(
        '%s of %s / %d %%',
        [
          FmtFileSize(dwBytesRead),
          FmtFileSize(fileSize), 
          ProgressBar.Position
        ]
      );
  end;

  CloseFile(LocalFile);

  InternetCloseHandle(hFile);
  InternetCloseHandle(hFTP);
  InternetCloseHandle(hNet);
  Result := True;
end;