ファイルのダウンロード

frame.htm

<HTML>
<HEAD>
<TITLE>ダウンロード</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; CHARSET=shift_jis">
</HEAD>
<FRAMESET id="TopFrame">
	<FRAME name="HeadFrame" src="control.asp?view=head">
</FRAMESET>
</HTML>

control.php

<%
' **********************************************************
' 外部ファイル
' **********************************************************
%><!-- #include virtual = "/asp/common.inc" --><%
%><!-- #include virtual = "/asp/dbMySQL.inc" --><%
%><!-- #include file = "model.inc" --><%

' **********************************************************
' 定数定義
' **********************************************************
Const PASS_MESSAGE = "1"
Const PASS_COND = "2"

' **********************************************************
' グローバル変数定義
' **********************************************************
Dim ErrMessage		' エラー処理用
Dim Message			' 通常メッセージ用
Dim InData			' フレーム間引継ぎ埋め込み用
Dim OptionList		' コンボボックス埋め込み用
Dim OutData			' 結果表示埋め込み用
Dim Cn,Rs			' データベース用

' ------------------------------------------------
' データベース接続
' ------------------------------------------------
Call DBConnectByEnv( Cn )

' **********************************************************
' 処理コントロール
' **********************************************************
Select Case Request.ServerVariables( "REQUEST_METHOD" )
	Case "GET","POST"
		Select Case MyData("GNO")
			Case PASS_COND
				Call GetData( )
				if ErrMessage <> "" then
					MyData("GNO") = PASS_MESSAGE
				end if
		End Select
End Select

' **********************************************************
' ビュー
' **********************************************************
CreateInData( )
Select Case MyData("GNO")
	Case PASS_MESSAGE
		%><!-- #include file = "view.inc" --><%

	Case PASS_COND
		Call EditDataHead()
		%><!-- #include file = "view.inc" --><%

	Case Else
		if MyData("view") = "head" then
			Call RestoreCookie( )
			Call EditDataHead( )
			%><!-- #include file = "view.inc" --><%
		end if

End Select

' ------------------------------------------------
' データベース接続解除
' ------------------------------------------------
Call DBClose( Cn )
Call DBClose( Rs )

' **********************************************************
' デバッグ用
' **********************************************************
DispData()

%>

model.inc

<%
' **********************************************************
' ダウンロード
' **********************************************************
Function GetData( )

	Dim Http,Stream
	Dim Target,TargetFile

	' リモート Web 上のターゲットアドレス
	Target = MyData("In1Target")
	' ローカル Web 上のターゲットアドレス
	TargetFile = "file/" & Mid( Target, InstrRev(Target,"/")+1 )

	' ダウンロード用のオブジェクト
	Set Http = Server.CreateObject( "MSXML2.XMLHTTP" )
	on error resume next
	Call Http.Open("GET", Target, FALSE )
	if Err.Number <> 0 then
		Call OutCr( "<PRE>" )
		Call OutCr( "アドレス:" & Target )
		Call OutCr( Err.Description )
		Call OutCr( "</PRE>" )
		Set Fs = Stream
		Set Http = Nothing
		Exit Function
	end if
	on error goto 0
	Call Http.Send()

	' ファイル化用のオブジェクト
	Set Stream = Server.CreateObject("ADODB.Stream")
	Call Stream.Open()
	Stream.Type = adTypeBinary
	Call Stream.Write( Http.responseBody )
	Call Stream.SaveToFile( _
		Server.MapPath(TargetFile), _
		adSaveCreateOverWrite _
	)
	Call Stream.Close()

	Set Stream = Nothing
	Set Http = Nothing

	OutData = "<IMG src=""" & TargetFile & """>"

End Function

' **********************************************************
' VIEW の編集
' **********************************************************
Function EditDataHead( )


End Function

' **********************************************************
' VIEW2 の編集
' **********************************************************
Function EditDataBody( )


End Function

%>

view.inc

<SCRIPT language=JavaScript>

// *********************************************************
// フォームのチェック
// *********************************************************
function CheckData() {

	return true;
}

</SCRIPT>


<HTML>
<HEAD>
	<META http-equiv="Content-type" content="text/html; charset=Shift_JIS">
	<TITLE>ASP 雛形</TITLE>
<STYLE>
	.MyCell {
		background-color:silver
	}
</STYLE>
</HEAD>
<BODY>
<SPAN style='color:blue'><%= ErrMessage %></SPAN>
<SPAN style='color:black;font-weight:bold'><%= Message %></SPAN>

<FORM
	name=frmMain
	method=GET
	action=control.asp
	onSubmit='return CheckData()'
>
<TABLE border=0 bgcolor=black cellspacing=1 cellpadding=5>
<TR>
	<TD class=MyCell>HTTP アドレス</TD>
	<TD class=MyCell>
		<INPUT
			type=text
			name=In1Target
			value="<%= MyData("In1Target") %>"
			size=100
		>
	</TD>
	<TD class=MyCell>
		<INPUT type=submit name=send value="送信">
	</TD>
	<TD class=MyCell>
		<INPUT 
			type=button
			value="Cancel"
			onClick='top.location="frame.htm"'
		>
	</TD>
</TR>
<TR>
	<TD style='background-color:white' colspan=6>
		&nbsp;<%= OutData %>
	</TD>
</TR>
</TABLE>

<INPUT type=hidden name=GNO value="<%= PASS_COND %>">
</FORM>

</BODY>
</HTML>

埋め込み用 ASP スクリプトと model.inc への実装

Microsoft の簡潔なサンプルはこちら

<%

Dim Stream,FilePath,FileExt,ContentType

FilePath = Request.QueryString("path")
FileExt = Mid( FilePath, InstrRev(FilePath,".")+1 )
ContentType = ""
if UCase( FileExt ) = "JPEG" then
	ContentType = "image/jpeg"
end if
if UCase( FileExt ) = "JPG" then
	ContentType = "image/jpeg"
end if
if UCase( FileExt ) = "GIF" then
	ContentType = "image/gif"
end if
if UCase( FileExt ) = "PNG" then
	ContentType = "image/png"
end if

Set Stream = Server.CreateObject("ADODB.Stream")
Call Stream.Open()
Stream.Type = adTypeBinary
on error resume next
if Instr( FilePath, "\" ) <> 0 then
	Call Stream.LoadFromFile( FilePath )
	if Err.Number <> 0 then
		ContentType = ""
	end if
else
	Call Stream.LoadFromFile( Server.MapPath(FilePath) )
	if Err.Number <> 0 then
		ContentType = ""
	end if
end if
on error goto 0

if ContentType = "" then
	Response.ContentType = "image/png"
	FilePath = Server.MapPath("err.png")
	Call Stream.LoadFromFile( FilePath )
else
	Response.ContentType = ContentType
end if
Call Response.BinaryWrite( Stream.Read )

Call Stream.Close()

Set Stream = Nothing
%>

<%
' **********************************************************
' ダウンロード
' **********************************************************
Function GetData( )

	Dim Http,Stream
	Dim Target,TargetFile

	' リモート Web 上のターゲットアドレス
	Target = MyData("In1Target")
	' ローカル Web 上のターゲットアドレス
	TargetFile = "file/" & Mid( Target, InstrRev(Target,"/")+1 )

	' ダウンロード用のオブジェクト
	Set Http = Server.CreateObject( "MSXML2.XMLHTTP" )
	on error resume next
	Call Http.Open("GET", Target, FALSE )
	if Err.Number <> 0 then
		Call OutCr( "<PRE>" )
		Call OutCr( "アドレス:" & Target )
		Call OutCr( Err.Description )
		Call OutCr( "</PRE>" )
		Set Fs = Stream
		Set Http = Nothing
		Exit Function
	end if
	on error goto 0
	Call Http.Send()

	' ファイル化用のオブジェクト
	Set Stream = Server.CreateObject("ADODB.Stream")
	Call Stream.Open()
	Stream.Type = adTypeBinary
	Call Stream.Write( Http.responseBody )
	Call Stream.SaveToFile( _
		Server.MapPath(TargetFile), _
		adSaveCreateOverWrite _
	)
	Call Stream.Close()

	Set Stream = Nothing
	Set Http = Nothing

	OutData = "<IMG src=""file.asp?path="
	OutData = OutData & Server.URLEncode(TargetFile) & """>"

End Function

' **********************************************************
' VIEW の編集
' **********************************************************
Function EditDataHead( )


End Function

' **********************************************************
' VIEW2 の編集
' **********************************************************
Function EditDataBody( )


End Function

%>