DOWNLOADING FILES IN DELPHI
Сегодня в твоем любимом Delphi мы напишем простенькую программу, которая
будет скачивать файлы из Сети! И даже с возможностью докачки!
Для начала раскидай элементы следующим образом
2 edit’а, 4 кнопки и один save dialog . Сделали? А теперь даю весь
исходник и комментарии. Вы уже не маленькие, и расписывать каждый шаг
я не буду. Однако если появятся вопросы – пишите мне по адресу tonik@mail.kz
и я отвечу!
unit microdownloader;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
Forms,
Dialogs, StdCtrls, WinInet;
type
TForm1 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
SaveDialog1: TSaveDialog;
Edit2: TEdit;
procedure Button4Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
NADO: boolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button4Click(Sender: TObject);
begin
IF SaveDialog1.Execute then Edit2.Text:= SaveDialog1.FileName;
end;
procedure TForm1.Button1Click(Sender: TObject);
var F: File;
ResumePos,BufferLen,SumSize: DWORD;
hSession, hURL: HInternet;
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); //откроем файл!
ResumePos:=FileSize(F); //адрес откуда будем докачивать
Seek(F, FileSize(F)); //А писать будем в конец
end else ReWrite(f,1); //А раз нет, так создадим
NADO:= TRUE; //Надо качать...
//Открыли сессию
hSession:= InternetOpen('X-Kachalka',PRE_CONFIG_INTERNET_ACCESS,nil,nil,0);
//И наш УРЛ
hURL := InternetOpenURL(hSession,PChar(Edit1.Text),nil,0,0,0);
//Сколько там наш файл весит?
InternetQueryDataAvailable(hURL, SumSize,0,0);
label4.Caption:= IntToStr (SumSize); //Сообщим об этом
if ResumePos>0 then //Если докачиваем,
begin
InternetSetFilePointer(hURL,ResumePos,nil,0,0); //То сместимся
end;
REPEAT //Качаем
err:= InternetReadFile(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;
procedure TForm1.Button3Click(Sender: TObject);
begin
application.Terminate;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
NADO:= FALSE
end;
end.
Ведь все просто? Попробуйте теперь проверить в боевых условиях – скачайте
все номера freetech’а своей качалкой =))
Как можно наворотить качалку?
Сделать интерфейс получше =). Как видите, ничего красивого в нынешнем
нет. Лучше сразу сделать что-то похожее на FlashGet или другую популярную
качалку. Сделать возможность скачивать несколько файлов одновременно.
Скачивать в несколько потоков. Скачивать по расписанию. Искать мирроры.
И так далее. Удачи в девелоперском деле!
freetonik ( tonik@mail.kz
)
|
