Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
// ПРЕДИСЛОВИЕ:
{
Копаясь как-то в исходниках модулей третьей Delphi, я наткнулся на файл,
который назывался WinInet.pas. Имея врожденное любопытство, я заглянул
в него и нашел там очень много интересных вещей. О некоторых из них я
попытаюсь рассказать в данной статье, в частности, как, используя этот
модуль, организовать докачку файлов при обрыве связи. В модуле WinInet.pas
содержатся описания прототипов функций и некоторых типов входящих в т.н.
Microsoft Windows Internet Extensions, описания которых я не нашел в
справочной системе (хотя может плохо искал) :-(. Поэтому пришлось идти
почти вслепую.
}
// ТЕОРИЯ:
{
Для начала рассмотрим все функции, константы и типы, которые мы будем
использовать:
}
// 1) HINTERNET, вот как он описан:
type
HINTERNET = Pointer;
PHINTERNET = ^HINTERNET;
// При детальном рассмотрении, это обычный указатель.
// 2) функции InternetOpen и InternetCloseHandle:
function InternetOpen(lpszAgent: PChar; dwAccessType: DWORD;
lpszProxy, lpszProxyBypass: PChar; dwFlags: DWORD): HINTERNET; stdcall
;
{
где:
lpszAgent <-|Имя программы, с помощью которой мы соединяемся,
|может принимать любые значения
dwAccessType <-|Каким макаром соединяться с и-нетом
|принимаемые значения:
| PRE_CONFIG_INTERNET_ACCESS -как в системном реестре
| LOCAL_INTERNET_ACCESS -напрямую
| GATEWAY_INTERNET_ACCESS -через GateWay
| CERN_PROXY_INTERNET_ACCESS -через проксю
lpszProxy <-|Имя прокси сервера (ставим в nil)
lpszProxyBypass<-|Не уверен, но смахивает на имена хостов, для которых не
|использовать проксю (ставим в nil)
dwFlags <-|Принимаеемые значения:
| INTERNET_FLAG_ASYNC -этот запрос асинхронный (если есть
| поддержка), но мы поставим 0
}
// возвращает пресловутый HINTERNET, который будет требоваться при вызове
// всех остальных функций. С вызова этой функции начинается вся наша работа
// с интернетом, а с вызова второй заканчивается.
function InternetCloseHandle(hInet: HINTERNET): BOOL; stdcall
;
// где: nInet ранее созданый указатель.
// 3) функция InternetOpenUrl:
function InternetOpenUrl(hInet: HINTERNET; lpszUrl: PChar;
lpszHeaders: PChar; dwHeadersLength: DWORD; dwFlags: DWORD;
dwContext: DWORD): HINTERNET; stdcall
;
{
где:
hInet <-|Ранее созданый указатель
lpszUrl <-|Сам УРЛ
lpszHeaders <-|Дополнительные строки в НТТР запрос
dwHeadersLength<-|Длинна предыдущего
dwFlags <-|Принимаемые значения:
| INTERNET_FLAG_RAW_DATA -принимать как RAW данные
| INTERNET_FLAG_EXISTING_CONNECT -не создавать для
| объекта нового соединения
| (поставим в 0)
dwContext <-|пока не знаю, ставим в 0
}
// Функция возвращает HINTERNET, указывающий на конкретный файл (далее он в
// параметрах функций будет называться hFile).
// 4) функция InternetReadFile:
function InternetReadFile(hFile: HINTERNET; lpBuffer: Pointer;
dwNumberOfBytesToRead: DWORD; var
lpdwNumberOfBytesRead: DWORD): BOOL; stdcall
;
{
где:
hFile <-|Указатель, созданый предыдущей функцией
lpBuffer <-|Указатель на буфер куда читать
dwNumberOfBytesToRead<-|Сколько максимум читать (можно сказать размер
| буфера, хотя не факт)
lpdwNumberOfBytesRead<-|Сколько реально прочитано байт
}
// Этой функой мы будем читать файл из и-нета.
// 5) функция InternetSetFilePointer:
function InternetSetFilePointer(hFile: HINTERNET;
lDistanceToMove: Longint; pReserved: Pointer;
dwMoveMethod, dwContext: DWORD): DWORD; stdcall
;
{
где:
hFile <-|Указатель созданый функцией InternetOpenUrl
lDistanceToMove<-|На сколько байт смещать указатель
pReserved <-|??
dwMoveMethod <-|Как смещать (=0)
dwContext <-|??
}
// Собственно, эта функция и поможет нам организовать докачку. Она смещает
// указатель в файле, после чего передача файла начнется с этого места.
// В принципе этих данных уже достаточно для наших целей, но есть еще одна
// полезная функция, которая пригодится нам:
function InternetQueryDataAvailable(hFile: HINTERNET; var
lpdwNumberOfBytesAvailable: DWORD;
dwFlags, dwContext: DWORD): BOOL; stdcall
;
{
где:
hFile <-|Указатель, созданный функцией InternetOpenUrl
lpdwNumberOfBytesAvailable<-|Сколько осталось байт
dwFlags <-|??
dwContext <-|??
}
// Как вы уже догадались, с помощью этой функции можно узнать сколько
// осталось байт скачать (или размер файла, если вызвать ее сразу после
// InternetOpenUrl).
//Ну, собственно, и все по теории.
// ПРАКТИКА:
Условия задачи:
Требуемые материалы:
Далее идет полный листинг модуля:
unitUnit1; interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, wininet, StdCtrls, ComCtrls; type
TForm1 = class
(TForm) Edit1: TEdit; //<-строка для УРЛа Label1: TLabel; Button1: TButton; //<-кнопка Start Button2: TButton; //<-кнопка Stop ProgressBar1: TProgressBar; //<-декорация procedure
Button1Click(Sender: TObject);
//<-|процедура начала скачки procedureButton2Click(Sender: TObject);
//<-|принудительный обрыв procedureFormCreate(Sender: TObject); private
{ Private declarations } public
{ Public declarations } end
; var
Form1: TForm1; stop: boolean;
//<-|вспомогательная переменная отв. за // |остановку скачки implementation{$R *.DFM} procedure
TForm1.Button1Click(Sender: TObject); var
hInet,
//<-переменная сод. указатель на сессию hURL: HINTERNET; //<-указатель на URL fSize, //<-размер файла ReadLen, //<-количество реально прочитанных байт RestartPos: DWORD; //<-|позиция с которой начинается // |докачка fBuf: array[1..1024] of
byte;
//<-буфер куда качаем f: file;
//<-файл куда качаем Header: string;
//<-|дополнительная переменная в HTTP // |заголовок beginRestartPos := 0;
//<- |инициализация fSize := 0; //<- |переменных Button1.Enabled := false; Button2.Enabled := true
;
//Если на винте есть файл то считаем, что нужно докачивать ifFileExists('c:123.tmp') then
begin
AssignFile(f, 'c:123.tmp'); Reset(f, 1); RestartPos := FileSize(F); Seek(F, FileSize(F)); end
else
begin
//иначе с начала AssignFile(f, 'c:123.tmp'); ReWrite(f, 1); end
;
//открываем сессию hInet := InternetOpen('Mozilla', PRE_CONFIG_INTERNET_ACCESS, nil, nil
, 0);
//Пишем дополнительную строку для заголовка Header := 'Accept: */*'; //открываем URL hURL := InternetOpenURL(hInet, PChar(Edit1.Text), pchar(Header), StrLen(pchar(Header)), 0, 0); //устанавливаем позицию в файле для докачки ifRestartPos > 0 then
InternetSetFilePointer(hURL, RestartPos, nil
, 0, 0);
//смотрим ск-ко надо скачать InternetQueryDataAvailable(hURL, fSize, 0, 0); ifRestartPos > 0 then
begin
ProgressBar1.Min := 0; ProgressBar1.Max := fSize + RestartPos; ProgressBar1.Position := RestartPos; end
else
begin
ProgressBar1.Min := 0; ProgressBar1.Max := fSize + RestartPos; end
;
//качаем до тех пор пока реально прочитаное число байт не //будет равно нулю или не стор while(ReadLen <> 0) and
(stop = false
) do
begin
//читаем в буфер InternetReadFile(hURL, @fBuf, SizeOf(fBuf), ReadLen); //смотрим ск-ко осталось докачать InternetQueryDataAvailable(hURL, fSize, 0, 0); ProgressBar1.Position := ProgressBar1.Max - fSize; BlockWrite(f, fBuf, ReadLen); //<-пишем в файл Application.ProcessMessages; end
; stop := false
; Button1.Enabled := true
; Button2.Enabled := false
; InternetCloseHandle(hURL);
//<-|закрываем InternetCloseHandle(hInet); //<-|сесcии CloseFile(f); //<-|и файл end; procedure
TForm1.FormCreate(Sender: TObject); begin
stop := false
;
//<-прервать скачку Button2.Enabled := false;
//<-кнопка останова скачки end; procedure
TForm1.Button2Click(Sender: TObject); begin
stop := true
;
//<-сообщаем о необходимости прерывания скачки end; end
.