웹에서 파일 다운로드 받기

빵집에 파일 다운로드 기능이 있다....
웹브라우져에서 http://xxxx.zip을 클릭하면 바로 다운로드 되다는 ... 그걸 말하는게 아니고....

빵집을 실행해 놓고.. 웹브라우져에서 zip파일 다운로드 링크를 .. 클릭을 하지말고
그 링크를 드래그해다가 빵집에다가 떨궈보자.....

그러면 빵집이 그 링크가 가리키는 경로의 파일을 다운로드해서 열어준다.....
그걸 설명하고자 하는것이니 한번도 안해본사람은(많을거다...맹글어 놓고도 얘기를 안했으니 --;; ) 일단 함 해보기 바란다......


파일을 다운로드 하는 방법중에 간단한 방법이 URLDownloadToFile 함수가 있다...
URLMon.pas에 있는 API함수인데... 사용법이 간단하고 명확해서 사용하기 좋다...
물론 인터넷에 연결이 안되있거나 하면 결과를 리턴해준다...

그런데 보통 이함수를 쓸때.. 두번째, 세번째 파라미터만 세팅을 해서 쓰는게 보통이다..
두번째가 URL이고 세번째가 저장할 파일명이다....
사실 이 두가지만 알면 되겠는데....

마지막 인자인 StatusCB: IBindStatusCallback 가 ... 척 보면 알겠지만... 심상치 않다..
혹시나해서 IBindStatusCallback를 열어보니..OnProgress라는 메소드도 있고....
척보니..이건 이벤트핸들러용으로 사용되는 인터페이스였다...

해서 .. 끼워맞춰서 구현을 했는데...
잘동작한다.... ^^;;;;

우선 IBindStatusCallback를 TInterfacedObject 와 다중상속을 해서
TURLDownload라는 클래스로 구현을 하고...

이 클래스에 Download라는 메소드를 만들어서 거기에서 URLDownloadToFile함수를 썼다..
마지막 파라미터에 Self라고 해서 IBindStatusCallback형 파라미터를 세팅했다..

이 클래스에는
 
function GetLocation(URL: String): String;  
 

이런 메소드도 있는데... 파일다운로드 URL이 다이렉트로 파일을 가리킬수도 있지만
제로보드처럼 빙빙돌려서 다운로드 하는경우도 많으므로 http헤더에 로케이션이 있나확인해서
최종 다이렉트 URL을 얻어내서 ..
그 URL을 다운로드하도록 했뜨아...(이런걸보고 쌩쑈라고 하지여... --a )
아..여기서 인디콤포넌트가 쓰였다..

자.. 아래는 다운로드클래스의 소스인데 중간에 FProgress_Form가 나오는데 그거는 프로그래스창이다....
적당히 고쳐서 쓰자....

또 uses에 BZUtils도 추가되어있는데... 역시 적당히 고쳐서 쓰자....

 
unit URLDownloads;
 
interface 
 
uses 
 Windows, SysUtils, URLMon, ActiveX, Forms, Classes, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
 Progress_Frm, Dialogs;
 
type 
 TOnProgressEvent = procedure ( Sender: TObject; Max, Position: DWord; StatusText: String; var Abort: Boolean ) of object;
 TOnStartEvent = procedure ( Sender: TObject; URL: String ) of object;
 TOnStopEvent = procedure ( Sender: TObject ) of object;
 
 TURLDownload = class( TInterfacedObject, IBindStatusCallback )
 private 
   FURL: String;
   FAbort: Boolean;
   FOnStart: TOnStartEvent;
   FOnStop: TOnStopEvent;
   FOnProgress: TOnProgressEvent;
   FProgress_Form: TProgress_Form;
   FLocalFileName: String;
   FErrorMsg: String;
   FAfterOpen: Boolean;
   function GetLocation(URL: String): String;
   procedure HTTPRedirect(Sender: TObject; var dest: String; var NumRedirect: Integer; var Handled: Boolean);
   procedure DoStart(URL: String);
   procedure DoStop;
   procedure DoProgress(Max, Position: DWord; StatusText: String; var Abort: Boolean);
 protected 
  {IBindStatusCallback} 
   function OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult; stdcall;
   function GetPriority(out nPriority): HResult; stdcall;
   function OnLowResource(reserved: DWORD): HResult; stdcall;
   function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
   function OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult; stdcall;
   function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
   function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult; stdcall;
   function OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult; stdcall;
 public 
   function Download(FilePath: String): Boolean;
   procedure Abort;
   property ErrorMsg: String read FErrorMsg;
   property LocalFileName: String read FLocalFileName;
   property URL: String read FURL write FURL;
   property OnStart: TOnStartEvent read FOnStart write FOnStart;
   property OnStop: TOnStopEvent read FOnStop write FOnStop;
   property OnProgressStatus: TOnProgressEvent read FOnProgress write FOnProgress;
 end;
 
implementation 
 
uses 
 BZUtils;
 
function TURLDownload.OnStartBinding(dwReserved: DWORD; pib: IBinding): HResult;
begin 
 DoStart( URL );
 Result := S_OK;
end;
 
function TURLDownload.GetPriority(out nPriority): HResult;
begin 
 Result := S_OK;
end;
 
function TURLDownload.OnLowResource(reserved: DWORD): HResult;
begin 
 Result := S_OK;
end;
 
function TURLDownload.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult;
var 
 Abort: Boolean;
begin 
 Abort := False;
 
 DoProgress( ulProgressMax, ulProgress, szStatusText, Abort );
 
 Application.ProcessMessages;
 if Abort or FAbort then Result := E_ABORT
                    else Result := S_OK;
end;
 
function TURLDownload.OnStopBinding(hresult: HResult; szError: LPCWSTR): HResult;
begin 
 FErrorMsg := szError;
 DoStop;
 Result := S_OK;
end;
 
function TURLDownload.GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult;
begin 
 Result := S_OK;
end;
 
function TURLDownload.OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium): HResult;
begin 
 Result := S_OK;
end;
 
function TURLDownload.OnObjectAvailable(const iid: TGUID; punk: IUnknown): HResult;
begin 
 Result := S_OK;
end;
 
function GetURLRoot( URL: String ): String;
var 
 i: Integer;
begin 
 Result := URL;
 if Length( URL ) > 0 then 
  for i := 2 to Length( URL ) do 
   if ( URL[i] = '/' ) and not ( URL[i-1] in ['/',':'] ) then 
    begin 
      Result := Copy( URL, 1, i );
      Break;
    end;
 if ( Length( Result ) > 0 ) and ( Result[ Length( Result ) ] <> '/' ) then Result := Result + '/';
end;
 
function GetBaseURL( URL: String ): String;
var 
 i: Integer;
begin 
 Result := URL;
 for i := Length( URL ) downto 1 do 
  if URL[i] = '/' then 
   begin 
     Result := Copy( URL, 1, i );
     Break;
   end;
 if ( Length( Result ) > 0 ) and ( Result[ Length( Result ) ] <> '/' ) then Result := Result + '/';
end;
 
function ExtractURLFileName( S: String ): String;
var 
 i: Integer;
begin 
 Result := S;
 if Length( S ) > 0 then 
  for i := Length( S ) downto 1 do 
   if S[i] in ['/','\','=','&'] then 
    begin 
      Result := Copy( S, i + 1, Length( S ) - i );
      Exit;
    end;
end;
 
function TURLDownload.GetLocation( URL: String ): String;
var 
 Http: TIdHTTP;
 Location: String;
begin 
 Result := URL;
 Location := '';
 
 Http := TIdHTTP.Create( nil );
 try 
   Http.OnRedirect := HTTPRedirect;
   Http.Request.Referer := GetURLRoot( URL );
   Http.Head( URL );
 
   Location := Http.Response.Location;
 finally 
   Http.Free;
 end;
 
 if Location <> '' then 
  begin 
    if ( LowerCase( Copy( Location, 1, Length( 'http://' ) ) ) <> 'http://' )// and 
       //( LowerCase( Copy( Location, 1, Length( 'ftp://' ) ) ) <> 'ftp://' ) 
       then 
     begin 
       if Location[1] = '/' then Delete( Location, 1, 1 );
       Location := GetBaseURL( URL ) + Location;
     end;
    Result := GetLocation( Location );
  end;
end;
 
function TURLDownload.Download(FilePath: String): Boolean;
var 
 FileName: String;
begin 
 URL := GetLocation( URL );
 FileName := FilePath + ExtractURLFileName( URL );
 FAbort := False;
 
 URLDownloadToFile( nil, PChar( URL ), PChar( FileName ), 0, Self );
 
 FLocalFileName := FileName;
 Result := not FAbort and ( ErrorMsg = '' ) and FAfterOpen;
end;
 
procedure TURLDownload.Abort;
begin 
 FAbort := True;
end;
 
procedure TURLDownload.HTTPRedirect(Sender: TObject; var dest: String; var NumRedirect: Integer; var Handled: Boolean);
begin 
 Handled := True;
end;
 
procedure TURLDownload.DoStart(URL: String);
begin 
 FAfterOpen := True;
 if Assigned( OnStart ) then OnStart( Self, URL )
 else 
  begin 
    FProgress_Form := TProgress_Form.Create( nil );
    FProgress_Form.SetStatus( psDownload );
    FProgress_Form.AbortProc := Abort;
    FProgress_Form.StaticText_Msg.Caption := URL;
 
    FProgress_Form.CheckBox_AfterOpen.Enabled := IsArchiveFile( ExtractURLFileName( URL ) );
    FProgress_Form.CheckBox_AfterOpen.Checked := FProgress_Form.CheckBox_AfterOpen.Enabled;
    FProgress_Form.CheckBox_AfterOpen.Visible := True;
 
    FProgress_Form.Show( True );
  end;
end;
 
procedure TURLDownload.DoStop;
begin 
 if Assigned( OnStop ) then OnStop( Self )
 else 
  begin 
    if FProgress_Form <> nil then 
     begin 
       FAfterOpen := FProgress_Form.CheckBox_AfterOpen.Checked;
       FProgress_Form.Free;
       FProgress_Form := nil;
     end;
  end;
end;
 
procedure TURLDownload.DoProgress(Max, Position: DWord; StatusText: String; var Abort: Boolean);
begin 
 if Assigned( FOnProgress ) then FOnProgress( Self, Max, Position, StatusText, Abort )
 else 
  begin 
    if FProgress_Form <> nil then 
     begin 
       FProgress_Form.ProgressBar1.Max := Max;
       FProgress_Form.ProgressBar1.Position := Position;
 
       if FProgress_Form.StaticText_DownloadSize.Caption = '' then 
        begin 
          if Max > 0 then FProgress_Form.StaticText_DownloadSize.Caption := FormatFloat( '#,###,###,###,###0', Max ) + ' Byte';
        end;
 
       Abort := FAbort;
     end;
  end;
end;
 
end.  
 



이 TURLDownload를 사용하는 방법은..

 
procedure TMain_Form.Download( URL: String );
var 
 DownloadFile: String;
 URLDownload: TURLDownload;
begin 
 DownloadFile := GetDownloadPath;
 
 URLDownload := TURLDownload.Create;
 URLDownload.URL := URL;
 if URLDownload.Download( DownloadFile ) then 
  begin 
    DownloadFile := URLDownload.LocalFileName;