|
|
<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>
| |
|
|
|
|
<%
' **********************************************************
' 外部ファイル
' **********************************************************
%><!-- #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()
%>
| |
|
|
|
|
<%
' **********************************************************
' ダウンロード
' **********************************************************
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
%>
| |
|
|
|
|
<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>
<%= 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
%>
| |
|
|
|