2013年08月07日


ServerXMLHTTP を使用してバイナリデータのダウンロードを行うスクリプト

殆どがServerXMLHTTPオブジェクトにまかされていて、イベントも存在しないのであまり巨大なファイルはダウンロードしてはいけません。

ですが、10メガ以内のファイル( 単純なフリーソフト等 ) ならば、特に問題は出ないと思います。( これに関してはかなり長い間運用して来ました )
Dim ErrorMessage
' **********************************************************
' ファイルをダウンロード
' **********************************************************
strUrl = "http://www5f.biglobe.ne.jp/~t-susumu/dl/tpad/tpad109.zip"
strPath = "C:\Users\lightbox\Documents\Downloads\tpad109.zip"
if HTTPDownload( strUrl, strPath ) then
	MsgBox("ダウンロードが成功しました")
else
	MsgBox( ErrorMessage )
end if


' **********************************************************
' ダウンロード
' 1) ダウンロードする URL
' 2) 保存するPC内のパス
' **********************************************************
Function HTTPDownload( strUrl, strPath )

	Dim objHTTP

	Set objHTTP = WScript.CreateObject("Msxml2.ServerXMLHTTP")

	HTTPDownload = True

	on error resume next
	Call objHTTP.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPDownload = False
		Exit Function
	end if
	on error goto 0

	on error resume next
	objHTTP.Send
	if Err.Number <> 0 then
		ErrorMessage = Err.Description
		HTTPDownload = False
		Exit Function
	end if
	on error goto 0

	Dim Stream

	Set Stream = WScript.CreateObject("ADODB.Stream")

	Stream.Open
	Stream.Type = 1	' バイナリ
	Stream.Write objHTTP.responseBody
	Stream.SaveToFile strPath, 2 ' 上書き
	Stream.Close

End Function




タグ:通信
posted by at 15:41 | Comment(0) | ツール | このブログの読者になる | 更新情報をチェックする


この記事へのコメント
コメントを書く
お名前:

ホームページアドレス:

コメント:

認証コード: [必須入力]


※画像の中の文字を半角で入力してください。
※ブログオーナーが承認したコメントのみ表示されます。