Написав одну функцию InternetDownload1 , может оказаться, что с
некоторых сайтах Интернета она не сможет загрузить файл. Поэтому необходимо написать
вторую функцию InternetDownload2 . Итог: обе функции позволяют скачивать
файлы из Интернета, но если одна из них не может скачать, используем вторую.
uses WinInet, IdHTTP;
function InternetDownload1(URL, f: string): boolean;
const MaxBuffer = $10000;
var H1, H2: pointer;
H3: integer;
Buffer: array[1..MaxBuffer] of char;
Count: cardinal;
begin
Result:=true;
H1:=InternetOpen('', 0, nil, nil, 0);
try
H2:=InternetOpenURL(H1, PChar(URL), nil, 0, 0, 0);
if H2=nil then
begin
Result:=false;
InternetCloseHandle(H1);
Exit;
end;
try
H3:=FileCreate(f);
if H3<0 then
begin
Result:=false;
InternetCloseHandle(H1);
Exit;
end;
Count:=0;
try
repeat
InternetReadFile(H2, @Buffer, SizeOf(Buffer), Count);
Count:=FileWrite(H3, Buffer, Count);
until Count<=0;
finally
FileClose(H3);
end;
finally
InternetCloseHandle(H2);
end;
finally
InternetCloseHandle(H1);
end;
end;
function InternetDownload2(URL, f: string): boolean;
const MaxBuffer = $10000;
var Stream: TMemoryStream;
idHTTP1: TIdHTTP;
H3: integer;
Count: cardinal;
Buffer: array[1..MaxBuffer] of char;
begin
Result:=true;
Stream:=TMemoryStream.Create;
idHTTP1:=TIdHTTP.Create(Application);
try
idHTTP1.Get(URL, Stream);
except
Result:=false;
Stream.Free;
idHTTP1.Free;
Exit;
end;
H3:=FileCreate(f);
if H3<0 then
begin
Result:=false;
Stream.Free;
idHTTP1.Free;
Exit;
end;
FileSeek(H3, 0, 0);
Stream.Seek(0, 0);
repeat
Count:=Stream.Read(Buffer, MaxBuffer);
if Count>0 then
FileWrite(H3, Buffer, Count);
until Count<=0;
FileClose(H3);
Stream.Free;
idHTTP1.Free;
end;
где:
URL – адрес файла в Интернете, который нужно скачать;
f – полное имя файла, сохраняемого на компьютере.
Проверим обе функции:
procedure TForm1.Button1Click(Sender: TObject);
const URL = 'http://newerow1989.ru/img/autor/autor0.jpg';
f1 = 'E:\autor1.jpg';
f2 = 'E:\autor2.jpg';
begin
InternetDownload1(URL, f1);
InternetDownload2(URL, f2);
end;
|