Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 05.12.2013, 19:00   #1
SawaMEN
Пользователь
 
Аватар для SawaMEN
 
Регистрация: 30.04.2012
Сообщений: 15
Восклицание Скачать потоком с ProgressBar

Здравствуйте)
Уже давно ищу способ скачать большой файл в потоке с програссбаром...
Знаю, что тема уже обьезженная, но тем не менее я не помемаю как это реализовать.

Объясните че, куда...Только по-попонятнее пожалуйста))



Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP;

const 
  MY_MESS = WM_USER + 100;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    SaveDialog1: TSaveDialog;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure MyProgress(var msg:TMessage);message MY_MESS;
  private
    { Private declarations }
  public
    { Public declarations }
    procedure thrTerminate(Sender:TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type 
  TDownLoader = class(TThread)
  private
    FURL: string;
    FToFolder: string;
  protected 
    procedure Execute; override; 
  public
    property URL:string read FURL write FURL;
    property ToFolder:string read FToFolder write FToFolder;
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);
  //каталог, куда файл положить
  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.Resume; 
  //Теперь с процедуры мы выйдем, но поток работает
  //и живёт своей жизней
  
  d.FreeOnTerminate:=true; 
  d.OnTerminate:=thrTerminate;
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;

end.
SawaMEN -MeN233-
vk.com/sawamen
http://sawamen.my1.ru/
SawaMEN вне форума Ответить с цитированием
Старый 05.12.2013, 20:42   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

По-моему не получится. Не припомню чтоб HTTP компонент умел прогресс давать.
Он пока не скачает все что запрошено прога не пойдет дальше. И у него не наблюдается событий поблочной скачки.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 05.12.2013, 21:38   #3
ДралсяСошибками
Форумчанин
 
Аватар для ДралсяСошибками
 
Регистрация: 31.05.2011
Сообщений: 301
По умолчанию

OnWork, хотя сомнительно (
ДралсяСошибками вне форума Ответить с цитированием
Старый 05.12.2013, 23:09   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Врядли... Я бы не надеялся. Этот компонент не для того разработан.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 05.12.2013, 23:28   #5
uberchel
Участник клуба
 
Аватар для uberchel
 
Регистрация: 19.01.2009
Сообщений: 1,453
По умолчанию

Как у вас будет работать функция MyProgress, если обработчиков Work, WorkBegin нет для посылки lParam и wParam...
uberchel вне форума Ответить с цитированием
Старый 06.12.2013, 12:46   #6
SawaMEN
Пользователь
 
Аватар для SawaMEN
 
Регистрация: 30.04.2012
Сообщений: 15
По умолчанию

Цитата:
Сообщение от Stilet Посмотреть сообщение
По-моему не получится. Не припомню чтоб HTTP компонент умел прогресс давать.
Он пока не скачает все что запрошено прога не пойдет дальше. И у него не наблюдается событий поблочной скачки.
Не... Точно можно...
SawaMEN -MeN233-
vk.com/sawamen
http://sawamen.my1.ru/
SawaMEN вне форума Ответить с цитированием
Старый 06.12.2013, 12:47   #7
SawaMEN
Пользователь
 
Аватар для SawaMEN
 
Регистрация: 30.04.2012
Сообщений: 15
По умолчанию

Цитата:
Сообщение от uberchel Посмотреть сообщение
Как у вас будет работать функция MyProgress, если обработчиков Work, WorkBegin нет для посылки lParam и wParam...
Это случайно)
Пытался-же...
SawaMEN -MeN233-
vk.com/sawamen
http://sawamen.my1.ru/
SawaMEN вне форума Ответить с цитированием
Старый 06.12.2013, 12:50   #8
SawaMEN
Пользователь
 
Аватар для SawaMEN
 
Регистрация: 30.04.2012
Сообщений: 15
Восклицание

Цитата:
Сообщение от Stilet Посмотреть сообщение
Врядли... Я бы не надеялся. Этот компонент не для того разработан.
Ну не в потоке-же можно...
(Делал по примеру от сюда)

Компилируется только в 2006 правда...
Там типо в других инди старая...
Даже в delphi XE3
А мнеб на delphi 7...Говорят можно решить..
SawaMEN -MeN233-
vk.com/sawamen
http://sawamen.my1.ru/
SawaMEN вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Проблемы с потоком HELMOS Общие вопросы Delphi 16 01.02.2013 23:30
Проблема с потоком timur oO Помощь студентам 2 14.04.2010 17:02
Проблема с потоком Araver Общие вопросы Delphi 4 16.10.2007 04:30