指定されたURLのファイルをDL保存 (ID:31433)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ちょっと適当だけど、以下でどうですか？

unit unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs
  ,Buttons, StdCtrls, ExtCtrls, ComCtrls
  ,WinInet ,HTTPApp
  ;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    DLoad: TButton;
    DLurl: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    save_dir: TEdit;
    StatusBar1: TStatusBar;
    procedure FormShow(Sender: TObject);
    procedure DLoadClick(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//---------------------------------------------------------
// WEBからダウンロード関数
function DownloadFileUseWinInet(SourceFile,DestFile:string; obj1:TObject): Boolean;
var
     FS          : TFileStream;
     hSession    : HINTERNET;
     hService    : HINTERNET;
     dwBytesRead : DWORD;
     lpBuffer    : array[0..1024+1] of Char;
begin
     Result:= True;
     if obj1<>nil then
        TStatusPanel(obj1).text := 'Download start !!';

hSession:=InternetOpen('MyAppli', INTERNET_OPEN_TYPE_PRECONFIG,nil,nil,0);
     if Assigned(hSession) then begin
       hService := InternetOpenUrl(hSession,PChar(SourceFile),nil,0,0,0);
       if Assigned( hService ) then begin
         //上書き保存(なければ新規作成)
         try
         FS :=TFileStream.Create(DestFile,fmCreate);
         try
           dwBytesRead := 1024;
           while True do begin
             lpBuffer:=#0;
             if InternetReadFile(hService,@lpBuffer,1024,dwBytesRead) then begin
               //これがないと動作中にFormの移動などが不可となる
               //Sleep(0)の0は適当0〜10程度でいいようだ
               Application.ProcessMessages;
               Sleep(0);
               if dwBytesRead=0 then break;
               FS.WriteBuffer(lpBuffer,dwBytesRead);
             end else begin
               Result:=False;
               break;
             end;
           end;
         finally
           FreeAndNil(FS);
         end;
         except
           Result:=False;
         end;
       end;
     end else begin
       Result:=False;
     end;
     InternetCloseHandle(hService);

if obj1<>nil then begin
        if Result=true then begin
           TStatusPanel(obj1).text := 'Download successful !!';
        end else begin
           TStatusPanel(obj1).text := 'Download failed !!';
        end;
     end;
end;

//--------------------------------------
procedure TForm1.FormShow(Sender: TObject);
begin
  DLurl.Text := 'http://www.google.com/';
end;

procedure TForm1.DLoadClick(Sender: TObject);
var
  SourceFile, DestFile: string;
  obj1:TObject;
begin

SourceFile := DLurl.Text ;
  DestFile   := save_dir.Text+ExtractFileName(UnixPathToDosPath(SourceFile));

obj1 := StatusBar1.Panels[0];

if (DownloadFileUseWinInet(SourceFile, DestFile,obj1)=false) then begin
     showmessage('Download error！！ '+DestFile);
  end;

end;

end.

←解決時は質問者本人がここをチェックしてください。

戻る