关于论坛帖子的防盗链实现--DLL

'******************************
'Write By: DLL
'NetBuilder 出品
'文件名使用URL参数/表单项传递,项名为FileName,对GIF和JPG直接输出图片流,其他文件则一律弹出下载提示框
'******************************
On Error Resume Next
Response.Buffer = True
Response.Clear

Const HidDir = "../XBB2003DFSDADA/"   '根据你的文件所在目录修改

SUB UseStream(FileName,FileNameString)
     Dim FileStream,File,FileContentType,IsAttachment
     Set FileStream = Server.CreateObject("ADODB.Stream")
     FileStream.Open
     FileStream.Type = 1
     File = server.MapPath(FileName)
     FileStream.LoadFromFile(File)
     FileContentType = GetContentType(FileName)
     If FileContentType <> "image/gif" And FileContentType <> "image/jpeg" 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

Function GetFilePath(FileName,HiddenDir)       '限制盗链的函数,当来源地址中的域名和当前文件地址的域名不同时则输出自定义错误图片NoImg.gif,您也可以设置为用Session限制
     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 = HiddenDir & FileName
     'Else
           'GetFilePath = "NoImg.gif"
     'End If
End Function

Function GetContentType(FlName)
     Select Case lcase(Right(flName, 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 ".gif"
           GetContentType = "image/gif"
     Case ".jpg", "jpeg"
           GetContentType = "image/jpeg"
     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

Dim FileName,FilePath
FileName = Trim(Request("FileName"))
FilePath = GetFilePath(FileName,HidDir)

If Lcase(Right(FilePath, 4)) = ".gif" Then             '如果是GIF文件则可直接用Server.Execute输出它的二进制流.
     Response.AddHeader "Content-Disposition", "filename=" & FileName
     Response.AddHeader "Content-Length", FileStream.Size
     Response.Charset = "UTF-8"
     Response.ContentType = GetContentType(FileName)
     Server.Execute(FilePath)
     If err.Number <> 0 Then
           err.Clear
           Server.Execute("NoImg2.gif")
           Response.End()
     End If
Else    '如果不是GIF图象则使用ADODB.STREAM对象输出其二进制流
     UseStream FilePath,FileName
     If Err.Number <> 0 Then
           Err.Clear
           Server.Execute("NoImg2.gif")
     End If
End If

如果程序出错则输出自定义错误图片NoImg2.gif