利用ADODB.Stream 防盗链

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
'******************************
'文件名使用URL参数/表单项传递,项名为FileName,对GIF和JPG等图片直接输出,其他文件则一律弹出下载提示框
'例:
' 下载文件
'******************************
On Error Resume Next
Response.Buffer = True
Response.Clear
Const FileDir = "" '根据你的文件所在目录修改
Function GetFilePath(FileName,FileDir) '防止盗链,当来源地址中的域名和当前文件地址的域名不同时则输出自定义错误图片nosteal.gif
Dim Server_v1,Server_v2
Server_v1 = Cstr(Request.ServerVariables("HTTP_REFERER"))
Server_v2 = Cstr(Request.ServerVariables("SERVER_NAME"))
IF(Server_v1<>"" And Mid(Server_v1,8,Len(Server_v2)) = Server_v2)THEN
GetFilePath = FileDir & FileName
ELSE
GetFilePath = "nosteal.gif"
END IF
End Function
Function GetContentType(FileName)
Select Case LCASE(Right(FileName, 4))
Case ".asf"
GetContentType = "video/x-ms-asf"
Case ".avi"
GetContentType = "video/avi"
Case ".doc"
GetContentType = "application/msword"
Case ".zip"
GetContentType = "application/zip"
Case ".xls"
GetContentType = "application/vnd.ms-excel"
Case ".jpg","jpeg",".gif",".png",".bmp"
GetContentType = "image/*"
Case ".wav"
GetContentType = "audio/wav"
Case ".mp3"
GetContentType = "audio/mpeg3"
Case ".mpg", "mpeg"
GetContentType = "video/mpeg"
Case ".rtf"
GetContentType = "application/rtf"
Case ".htm", "html"
GetContentType = "text/html"
Case ".txt"
GetContentType = "text/plain"
Case ELSE
GetContentType = "application/octet-stream"
End Select
End Function
Sub UseStream(FilePathString,FileNameString)
Dim FileStream,File,FileContentType,IsAttachment
SET FileStream = Server.CreateObject("ADODB.Stream")
FileStream.Open
FileStream.Type = 1
FileStream.LoadFromFile(Server.MapPath(FilePathString))
FileContentType = GetContentType(FileNameString)
IF(FileContentType <> "image/*")THEN
IsAttachment = "attachment; "
ELSE
IsAttachment = ""
END IF
Response.AddHeader "Content-Disposition", IsAttachment & "filename=" & FileNameString
Response.AddHeader "Content-Length", FileStream.Size
Response.Charset = "UTF-8"
Response.ContentType = FileContentType
Response.BinaryWrite FileStream.Read
Response.Flush
FileStream.Close
SET FileStream = Nothing
End Sub
Dim FileName,FilePath
FileName = Trim(Request.QueryString("FileName"))
FilePath = GetFilePath(FileName,FileDir)
UseStream FilePath,FileName
IF(Err.Number <> 0)THEN
Err.Clear
Server.Execute("NoImg.gif")
END IF
%>

コメントを残す

メールアドレスが公開されることはありません。