www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\flash\downfile.asp

    <!--#include file="config.asp" -->
<%
Response.Expires = -9999
Response.AddHeader "pragma", "no-cache"
Response.AddHeader "cache-ctrol", "no-cache"

Dim url,strUrl,strPath
url = Replace(Replace(Replace(Request("url"), "'", ""), "%", ""), "\", "/")

If Len(url) > 3 Then
	If Left(url,1) = "/" Then
		Response.Status = "301 Moved Permanently"
		Response.AddHeader "Location", url
		Response.Flush
	End If
	If InStr(url, "../") > 0 Then
		Response.Status = "301 Moved Permanently"
		Response.AddHeader "Location", url
		Response.Flush
	End If
	strUrl = Left(url,10)
	If InStr(strUrl, "://") > 0 Then
		Response.Status = "301 Moved Permanently"
		Response.AddHeader "Location", url
		Response.Flush
	End If
	If InStr(url, "/") > 0 Then
		url =Replace(url, "../", "")
		strPath = Server.MapPath(NewAsp.ChannelPath&url)
		Call DownloadLocalFile(strPath)
	Else
		Response.Status = "301 Moved Permanently"
		Response.AddHeader "Location", url
		Response.Flush
	End If
End If

Sub DownloadLocalFile(strFile)
	Dim s,fso,f
	Dim FilePath,FileName,FileSize,BinaryData
	On Error Resume Next
	Server.ScriptTimeOut=999999
	Response.Clear
	If InStr(strFile,":")=0 Then FilePath=Server.MapPath(strFile) Else FilePath=strFile
	Set fso=NewAsp.CreateAXObject("Scripting.FileSystemObject")
	If Not fso.FileExists(FilePath) Then
		Exit Sub
	End If
	Set s=NewAsp.CreateAXObject("adodb.stream")
	s.Open:s.Type=1
	Set f=fso.GetFile(FilePath)
	FileSize=f.size
	FileName=f.name
	s.LoadFromFile(FilePath)
	If Err Then
	 	Response.Write("<h1>错误: </h1>" & Err.Description & "<p>")
		Response.End
	End If
	Set f=Nothing:Set fso=Nothing
	BinaryData=s.Read
	s.Close:Set s=Nothing
	If CheckFileType(FileName) Then Exit Sub
	If Response.IsClientConnected Then
		If Not (InStr(LCase(FileName),".gif")>0 Or InStr(LCase(FileName),".jpg")>0 Or InStr(LCase(FileName),".jpeg")>0 Or InStr(LCase(FileName),".bmp")>0 Or InStr(LCase(FileName),".png")>0) Then
			Response.AddHeader "Content-Disposition", "attachment; filename="&FileName
		End If
		Response.AddHeader "Content-Length", FileSize
		Response.Charset = "UTF-8"
		Response.ContentType = "application/octet-stream"
		Response.BinaryWrite BinaryData
		Response.Flush
	End If
End Sub

Function CheckFileType(ByVal strFile)
	Dim i, strFileExt,strExtArry
	CheckFileType=True
	On Error Resume Next
	If ""=strFile Then Exit Function
	strFile=LCase(strFile)
	strExtArry=Array(".asp",".asa",".aspx",".php",".jsp",".mdb",".bak",".htm",".css",".js",".inc",".config")
	For i=0 To UBound(strExtArry)
		If InStr(strFile,strExtArry(i))>0 Then
			CheckFileType=True
			Exit Function
		End If
	Next
	CheckFileType=False
End Function
%>