Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Delphi для качков

Автор: Лозовский Александр
Прислал: Матвеев Игорь

Статья из журнала Хакер за 04.2003

 Любому человеку, мало-мальски знакомому с интернетом, известны такие программы-качалки, как GetRight, Reget и Flashget. Их расплодилось великое множество, все они занимают первые места в рейтингах и продаются за немалые деньги. FlashGet, например, постоянно требует от меня заплатить буржую $29.99 за дальнейшее использование его программы. Все это, конечно, понятно, хочется денег, да побольше... Но разве русский человек может заплатить такую сумму?:) Так что давай сегодня напишем свой Reget, и ты сможешь демонстрировать всем знакомым девушкам свою физиономию в about программы :)

Реквизит

 Он нам понадобится. Прошли те времена, когда все делалось в два диалога и одну строчку кода. Нам придется писать программу с использованием функций библиотеки Winlnet.dll и заголовочного файла, соответственно, Winlnet.Pas. Сразу пропиши его в uses, а то потом забудешь и начнешь тыкаться, искать свою ошибку. Так вот, давай для начала попробуем разобраться с самыми необходимыми функциями, а с остальными ты разберешься сам на msdn.microsoft.com (полный линк давать не буду, т.к. он ОЧЕНЬ большой). Посмотри там следующие функции: InternetDial, InternetGoOnline или InternetCrackUrl (думаю, эта функция тебя должна заинтересовать :)). Но вернемся к реальности. У нас на повестке дня следующие функции:

1) function lnternetOpen(lpszAgent: PChar; dwAccessType: DWORD; IpszProxyName,
IpszProxyBypass: PChar; dwRags: DWORD): HINTERNET; stdcall;

 Она открывает интернет-сессию для приложения. Вот какие у нее аргументы:

IpszAgent - имя программы. Серьезные люди пишут application.exename, а старики - ParamStr(O). На самом деле это не так важно, программа все равно будет работать.
dwAccessType - способ соединения. Вот его типы: PRE_CONFIGJNTERNET_ACCESS - как в реестре. INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY - не юзать internet setup file. GATEWAY INTERNET ACCESS - через шлюз. CERN_PROXYJNTERNET_ACCESS - через прокси. IpszProxyName - имя прокси.
IpszProxyBypass - кому не надо использовать проксю.
dwFlags - режим работы. Если ставить INTERNET_FLAG_ASYNC, то будет асинхронный. В данном случае это только дополнительный напряг, поэтому ставь 0.

2) function lnternetOpenUrl(hlnet: HINTERNET; IpszUrl: PChar; IpszHeaders: PChar;
dwHeadersLength: DWORD; dwFlags: DWORD; dwContext: DWORD): HINTERNET; stdcall;

 Это функция открывает заданный УРЛ! :) Ее описание:

hinet - переменная типа HINTERNET. Ее значение возвращает функция InternetOpen.
IpszUrl - собственно сам УРЛ.
IpszHeaders - дополнительные строки в HTTP запросе. Нам они не нужны.
dwHeadersLength - их длина.
dwFlags - их тут больше 10 значений. Вот самое нужное: INTERNET_FLAG_EXISTING_CONNECT - не создавать для объекта нового соединения.
dwContext - пиши 0.

3) function lnternetReadFile(hFile: HINTERNET; IpBuffer: Pointer; dwNumberOfBytesToRead: DWORD;
var IpdwNumberOfBytesRead: DWORD): BOOL; stdcall;

 InternetReadFile читает удаленный файл. Если ты знаком со старой доброй ReadFile (или JRead), то поймешь сам, а это для тех, кто не знает:

hFile - сюда ты подставляешь значение из предыдущей функции (можно и FtpOpenFile, если тебе это ближе).
IpBuffer - буфер, через него мы будем читать файл. Как ты должен помнить, буфер- это массив. Таким образом, файл читается кусками, равными размеру этого массива, а у нас он объемом 1024 байта, т.е. один килобайт.
dwNumberOfBytesToRead - какое количество байт необходимо прочесть. Он должен быть равен размеру нашего массива, т.е. 1024.
IpdwNumberOfBytesRead - сколько же действительно байт прочитано. Если все отлично, то функция возвращает true, иначе - false.

4) function InternetSetRlePointerfhFile: HINTERNET; IDistanceToMove: Longint; pReserved: Pointer;
dwMoveMethod, dwContext: DWORD): DWORD; stdcall;

 Для незнакомых с SetFilePointer поясню. Эта функция сдвигает позицию чтения файла на заданное число байт. Т.е. если тебе надо прочитать файл не с начала, а с отметки 1000 байт, то пользуйся InternetSetFilePointer. Вот ее параметры:

hFile - этот параметр уже рассматривался.
IDistanceToMove - на какое количество байт смещать указатель.
pReserved - оставлено до лучших времен, а само значение должно быть равно нулю.
dwMoveMethod - откуда делать смещение: FILE_BEGIN - с начала. FILE_END - с конца :). FILECURRENT - с текущей позиции. dwContext - должно быть нулем. Как ты уже догадался, эта функция и будет обеспечищгь нам докачку. Если конда прервется на отметке 1.2 Мб, то мы сможем вернуться на нужную нам позицию. При успешном возврате функция вернет значение в 1.2 Мб. Но учти, если сервак не поддерживает докачки, то файл придется читать с самого начала.

5) function InternetQueryDataAvailable(hFile: IpdwNumberOfBytesAvailable: DWORD;
dwFlags, dwContext: DWORD): BOOL; stdcall; HINTERNET;

Она выясняет объем доступных данных, т.е. размер запрашиваемого файла. Пояснения:

hFile - переменная типа HINTERNET. Уже рассматривалась выше. IpdwNumberOfBytesAvailable - доступные байты. dwFlags - ставь в 0. dwContext - здесь также установи 0.

6) function InternetCloseHandle(hlnet: HINTERNET): BOOL; stdcall;

В InternetCloseHandle нет ничего сложного. Эта функция просто закрывает интернет-сессию.

 Все. С разбором функций мы закончили. Их тебе хватит для написания примитивного гетрайта :). А если ты ознакомишься с MSDN'овскими доками и поймешь )аботу потоков... Тогда я буду ждать 80% скидки на твой VasyaExtraGet за 9.99$ ). Так что закрывай журнальчик, попей пивка, и садись кодить. Главное, не убей правильное настроение. Если его пока нет, не расстраивайся, будем писать вместе :).

Интерфейс

 Кидай на форму два TEdit, четыре TLabel, SaveDialog и 4 Кнопки. Постарайся разложить это добро как на рис.1:

 Первые три кнопки обзови (параметр "caption"): "Загрузить", "Отмена" и "Выход", а на четвертой поставь 3 точки. Label'ы будут называться так:

Label1: "Откуда качать?"
Label2: "А куда сохранять?"
Label3: "Размер файла:"
Label4: "О"

 В общем, постарайся соответствовать рисунку. На нем все предельно ясно, так что перейдем к самому процессу кодинга.

Кодинг

 Для начала добавь в раздел public объявление переменной NADO: boolean; (она нужна для прерывания загрузки), создай событие OnClick для 4-й кнопки и впиши туда такой код:

IF SaveDialogl.Execute then Edit2.Text := SaveDialogl.FileName;

 Этот код добавлен, чтобы не вводить путь вручную. Теперь посмотри на код ниже. Попытайся понять содержимое этого листинга. Понял? Не понял? :) В общем, набей его в свой проект. Логика работы программы такая. Сначала мы проверяем наличие заданного файла. Если его нет, то качаем с нуля, если же он существует, то за начальную позицию для докачки берем размер локального файла и подставляем это значение в InternetSetFilePointer. Что мы и делаем. Затем циклически читаем по 1024 байта от интернет-файла, пока не скачаем его целиком. Это и будет конец загрузки. Хотя, на случай ручного прерывания, впиши в OnClick для 2-й кнопки такой код:

NADO := FALSE

 Все остальное ясно и по комментариям, поэтому я протестирую эту программу и перейду к заключению.

 Вот что нужно вписать в OnClick для кнопок:

procedure TForml .BitBtn1Click(Sender: TObject); 
var
  F: File;
  ResumePos, BufferLen, SumSize: DWORD;
  hSession, hURL: Hlnternet;
  Buffer: array[1..1024] of Byte;
  err: boolean;
begin
 SumSize := 0; ResumePos := 0;  //Инициализируемся
 AssignFile(F, Edit2.Text); //Свяжемся с файлом
 IF FileExists(Edit2.Text) then //Есть ли на диске этот файл
   begin
     Reset(f,1); //Ax, есть? Откроем!
     ResumePos := FileSize(F); //Откуда докачать
     Seek(F, FileSize(F)); //А писать будем в конец
   end else ReWrite(f,1); //А раз нет, так создадим
   NADO := TRUE; //Надо качать...
   //Открыли сессию
   hSession := lnternetOpen('X-Kachalka', PRE_CONFIG INTERNET_ACCESS, nil, nil, 0);
   //И наш УРЛ
   hURL := lnternetOpenURL(hSession,PChar(Edit1.Text),nil, O, 0, O);
   //Сколько там наш файл весит?
   lnternetQueryDataAvailable(hURL, SumSize, 0, 0);
   labe4.Caption := IntToStr(SumSize); //Сообщим об этом
   if ResumePos>0 then //Если докачиваем,
     begin
          lnternetSetFilePointer(hURL,ResumePos,nil,0,0); //То сместимся
     end;
   REPEAT //Качаем
     err:= lnternetReadFile(hURL, @Buffer,SizeOf(Buffer),BufferLen); //Читаем буфер
     IF err= false then //Ошибка чтения
       begin
         ShowMessage ('Произошел облом :('); //Сообщим и выходим
         exit;
       end;
     BlockWrite(f, Buffer, BufferLen); //Пишем в файл
     Application. Processmessages;
   UNTIL (BufferLen- 0) Or (NADO= FALSE); //Качаем, пока не все или надо
 ShowMessage ('Успешно загружено!');
end;

Пять минут - полет нормальный

 Я запустил закачку файла, но в середине процесса у меня подло прервалась связь (случайно задел модем ногой, он упал со стола и выдернулся из сети), за что я и словил известное тебе сообщение. Подняв модем и восстановив коннект, я запустил докачку и успешно слил файл. Заметь, с весьма неплохой скоростью, а все это благодаря компании Майкрософт и нашим с тобой прямым ручкам.

Заключение

 Программа получилась очень простой, и в твоих руках возможность довести ее до нужного уровня: убрать цикл в отдельный поток, а иначе будет тормозить интерфейс, добавить различные прогрессбары и прочую приятную лабуду (][ об этом писал не раз).

Загрузить исходники

 На этом все. Удачи тебе и до новых встреч в эфире.

Проект Delphi World © Выпуск 2002 - 2004
Автор проекта: ___Nikolay