Версия для печати
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум на Исходниках.RU > Delphi: Сетевое программирование > Скачиваем файлы из интернета


Автор: Aqel 19.11.18, 09:20
Есть код для скачивания через поток:

<{CODE_COLLAPSE_OFF}><{CODE_WRAP_OFF}>
    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 (, : 493)

Автор: Славян 19.11.18, 12:43
Может надо как-то официально сказать, чтобы закрыть поток (записать файл), а не просто оборвать - str.Free ? :unsure:

Автор: Aqel 19.11.18, 13:09
тоже думаю...

Powered by Invision Power Board (https://www.invisionboard.com)
© Invision Power Services (https://www.invisionpower.com)