"ダウンローダーを作る"

はじめに

大きなファイルなどをダウンロードする時に便利かもしれない、ダウンローダーを作っていこうと思います。壁紙チェンジャー以来の連載ものです。

最終更新日 2001 09/09

第一回　とりあえずダウンロード

ＩＥ３以降がインストール済みでなければダメなのですが、WinInet.dllを利用します。これをもちいれば、比較的簡単に、httpやftpが利用可能です。で、今回使用するＡＰＩの定義を以下にしめします。
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
　　　　　　　　　　　　　　　　　　　　　　　　 (ByVal sAgent As String, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lAccessType As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal sProxyName As String, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal sProxyBypass As String, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lFlags As Long) As Long
Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
　　　　　　　　　　　　　　　　　　　　　　　　 (ByVal hInternetSession As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal sUrl As String, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal sHeaders As String, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lHeadersLength As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lFlags As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lContext As Long) As Long
Declare Function InternetReadFile Lib "wininet.dll" _
　　　　　　　　　　　　　　　　　　　　　　　　 (ByVal hFile As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByRef lpBuffer As Any, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lNumBytesToRead As Long, _
　　　　　　　　　　　　　　　　　　　　　　　　 ByRef lNumberOfBytesRead As Long) As Long
Declare Function InternetCloseHandle Lib "wininet.dll" _
　　　　　　　　　　　　　　　　　　　　　　　　(ByVal hInet As Long) As Long

Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_INVALID_PORT_NUMBER = 0

Const INTERNET_FLAG_ASYNC = &H10000000
Const INTERNET_FLAG_FROM_CACHE = &H1000000
Const INTERNET_FLAG_OFFLINE = &H1000000

Const INTERNET_FLAG_RELOAD = &H80000000
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Const INTERNET_FLAG_NO_AUTO_REDIRECT = &H200000
Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100

となっています。

では、プログラムをかいてみましょう。標準モジュールに

'インターネットハンドル保存用
Dim hIntnet As Long

'URLハンドル保存用
Dim hURL As Long
Public Function OpenHTTPFile(URL As String)As Boolean
　　'戻り値の初期化
　　OpenHTTPFile = False

　　'インターネットハンドル取得
　　hIntnet = InternetOpen("Sample",INTERNET_OPEN_TYPE_PRECONFIG,vbNullString, vbNullString, 0)

　　'失敗したら抜ける
　　If hIntnet = 0 Then Exit Function

　　'ＵＲＬハンドル取得
　　hURL = InternetOpenUrl(hIntnet,URL,vbNullString,0,INTERNET_FLAG_RELOAD,0)
　　 '失敗の時
　　If hURL = 0 Then
　　 　　InternetCloseHandle hIntnet
　　 　　Exit Function
　　End If

　　OpenHTTPFile = True

End Function
Public Function GetHTTPFile(ByRef Buff() As Byte) As Long
　　Dim lngRC As Long
　　Dim BytesRead As Long

　　lngRC = InternetReadFile(hURL, Buff(0), 1024, BytesRead)
　　If lngRC = 0 Or BytesRead = 0 Then
　　　　GetHTTPFile = 0
　　Else
　　　　GetHTTPFile = BytesRead
　　End If
End Function
Public Sub CloseHTTPFile()
　　InternetCloseHandle hURL
　　InternetCloseHandle hIntnet
End Sub
Public Sub DownLoadFile(URL As String , SaveFile As String)
　　 　　'データ保存用
　　　　Dim ReadData() As Byte

　　　　'戻り値格納・サイズ指定
　　　　Dim lngRC As Long
　　　　'ＵＲＬ・保存場所が指定してあるか？
　　　　If URL <> "" And SaveFile <> "" Then
　　　　　　'保存先を開く
　　　　　　Open SaveFile For Binary As #1
　　　　　　'ＵＲＬを開く
　　　　　　If OpenHTTPFile(URL) = True Then

　　　　　　　　'読み込みバッファの初期化・確保
　　　　　　　　ReDim ReadData(1023)

　　　　　　　　'読み込み
　　　　　　　　lngRC = GetHTTPFile(ReadData())


　　　　　　'読み込みが終わるまで繰り返す。
　　　　　　Do Until lngRC = 0
　　　　　　　　'保存のため配列のサイズを調整
　　　　　　　　ReDim Preserve ReadData(lngRC - 1)
　　　　　　　　'ディスクに書き込み
　　　　　　　　Put #1, , ReadData

　　　　　　　　'システムに制御を戻す。（長時間ループにおちいる場合にそなえて）
　　　　　　　　DoEvents

　　　　　　　　'データ読み込み
　　　　　　　　lngRC = GetHTTPFile(ReadData())
　　　　　　Loop
　　　　End If
　　　　'閉じる
　　　　CloseHTTPFile
　　　　Close #1
　　　　End If

　　　　'メッセージ表示
　　　　MsgBox "ダウンロード終了"

End Sub

これでファイルのダウンロードができます。

使い方は DownLoadFile ＵＲＬ名 , 保存先 でできます。（多分）

とりあえず今回はここまで。では・・・・。
次回はプロキシサーバーかな。レジューム機能は３か４回目あたりでやる予定。

戻る