Форум по программированию Delphi Sources

 



Вернуться   Форум по программированию Delphi Sources > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 19.11.2018, 12:12
Аватар для Aqel
Aqel Aqel вне форума
Прохожий
 
Регистрация: 08.10.2011
Адрес: Пермь
Сообщения: 12
Версия Delphi: XE8
Репутация: 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

Весь проект этого кода:
Вложения
Тип файла: zip Скачивание.zip (8.5 Кбайт, 0 просмотров)
__________________
Всё намного проще, чем есть на самом деле...
Ответить с цитированием
  #2  
Старый 19.11.2018, 21:16
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,252
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

А кто ошибки будет проверять? Они не факт что из потока выберутся сами.
Ответить с цитированием
  #3  
Старый 20.11.2018, 06:09
Аватар для Aqel
Aqel Aqel вне форума
Прохожий
 
Регистрация: 08.10.2011
Адрес: Пермь
Сообщения: 12
Версия Delphi: XE8
Репутация: 10
Печаль

Ошибка:

[dcc32 Warning] Unit1.pas(799): W1000 Symbol 'Resume' is deprecated
__________________
Всё намного проще, чем есть на самом деле...
Ответить с цитированием
  #4  
Старый 20.11.2018, 06:18
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,252
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

Это не ошибка, это предупреждение компилятора. Нв это пока можно забить. Тем более, как ты говоришь, скачка происходить, т.е. поток стартует таки.

А где ты ищешь файл?
Ответить с цитированием
  #5  
Старый 20.11.2018, 07:43
Аватар для Aqel
Aqel Aqel вне форума
Прохожий
 
Регистрация: 08.10.2011
Адрес: Пермь
Сообщения: 12
Версия Delphi: XE8
Репутация: 10
Сообщение

Файл (по пути) должен сохраняться вместе с программой.
__________________
Всё намного проще, чем есть на самом деле...
Ответить с цитированием
  #6  
Старый 20.11.2018, 19:46
Аватар для lmikle
lmikle lmikle вне форума
Модератор
 
Регистрация: 17.04.2008
Сообщения: 7,252
Версия Delphi: 7, XE3, 10.2
Репутация: 49087
По умолчанию

Ав от что-то мне подсказывает, что файл просто сохраняется в другое место. Там есть особенности, начиная с Win7 с использованием диалогов. Смотри внимательнее путь к файлу, когда получаешь его из диалога.
Ответить с цитированием
  #7  
Старый 10.12.2018, 22:18
slaidouh77 slaidouh77 вне форума
Прохожий
 
Регистрация: 10.12.2018
Сообщения: 2
Версия Delphi: 10.3 CE
Репутация: 10
Смущение

Цитата:
Сообщение от Aqel
Файл (по пути) должен сохраняться вместе с программой.

Код:
unit Unit1;

interface

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

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;
    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.Start;
  // Теперь с процедуры мы выйдем, но поток работает
  // и живёт своей жизней
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.

Поправил, все норм сохраняет туды куды в диалоге выбрал!
линк должен быть http:// онли!
Ответить с цитированием
Этот пользователь сказал Спасибо slaidouh77 за это полезное сообщение:
Aqel (11.12.2018)
Ответ



Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 08:19.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources", 2004-2018

ВКонтакте   Facebook   Twitter