19.11.2018, 12:12
|
|
Прохожий
|
|
Регистрация: 08.10.2011
Адрес: Пермь
Сообщения: 13
Версия Delphi: XE8 SP1
Репутация: 10
|
|
Скачиваем файлы из интернета
Есть код для скачивания через поток:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, XPMan;
const
MY_MESS = WM_USER + 100;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
SaveDialog1: TSaveDialog;
Button2: TButton;
IdHTTP1: TIdHTTP;
XPManifest1: TXPManifest;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure thrTerminate(Sender:TObject);
procedure MyProgress(var msg:TMessage);message MY_MESS;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type
TDownLoader = class(TThread)
private
FToFolder: string;
FURL: string;
protected
procedure Execute;override;
public
property URL:string read FURL write FURL;
property ToFolder:string read FToFolder write FToFolder;
procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SaveDialog1.FileName:=copy(Edit1.Text,LastDelimiter('\/',Edit1.Text)+1,maxint);
if SaveDialog1.Execute then
Edit2.Text:=SaveDialog1.FileName;
end;
{ TDownLoader }
procedure TDownLoader.Execute;
var http:TIdHTTP;
str:TFileStream;
begin
//Создим класс для закачки
http:=TIdHTTP.Create(nil);
http.OnWork:=IdHTTP1Work;
http.OnWorkBegin:=IdHTTP1WorkBegin;
http.OnWorkEnd:=IdHTTP1WorkEnd;
//каталог, куда файл положить
ForceDirectories(ExtractFileDir(ToFolder));
//Поток для сохранения
str:=TFileStream.Create(ToFolder, fmCreate);
try
//Качаем
http.Get(url,str);
finally
//Нас учили чистить за собой
http.Free;
str.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var d:TDownLoader;
begin
//Создадим класс потока.
//Поток для начала будет остановлен
d:=TDownLoader.Create(true);
//Передадим параметры потоку
d.URL:=Edit1.Text;
d.ToFolder:=Edit2.Text;
//Поток должен удалить себя по завершению своей работы
d.FreeOnTerminate:=true;
d.OnTerminate:=thrTerminate;
//И запустим его на закачку.
d.Resume;
//Теперь с процедуры мы выйдем, но поток работает
//и живёт своей жизней
end;
procedure TForm1.MyProgress(var msg: TMessage);
begin
case msg.WParam of
0:begin ProgressBar1.Max:=msg.LParam;ProgressBar1.Position:=0; end;
1:ProgressBar1.Position:=msg.LParam;
end;
end;
procedure TForm1.thrTerminate(Sender: TObject);
begin
ShowMessage('Готово');
end;
procedure TDownLoader.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
PostMessage(Application.MainForm.Handle,MY_MESS,1,AWorkCount);
end;
procedure TDownLoader.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Int64);
begin
PostMessage(Application.MainForm.Handle,MY_MESS,0,AWorkCountMax);
end;
procedure TDownLoader.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
//
end;
end.
...но у меня он не робит - прогресс показывает скачивание, только никакого скачанного файла нету после завершения. В чём может быть проблема?
Ps: Delphi XE 8 sp1
Весь проект этого кода:
__________________
Всё намного проще, чем есть на самом деле...
|