Эта функция показывает, как подключиться к 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;
|