codice:
<%
Function ImgProxy_Serve( ByVal sPath )
'Code to read an image from the disk and display it to the user
Dim objStream, sNotes
ImgProxy_Serve = False
'Check if the image is being hotlinked
If ImgProxy_IsHotlink() Then
'Redirect the request to the "no hotlinkers" image
Response.Redirect "/images/nohotlink.gif"
End If
'If the function was passed a URL then convert this path
' into an absolute path within the physical filesystem
If InStr( 1, sPath, ":" ) = 0 Then
sPath = Server.MapPath( sPath )
End If
'Check the filename we are looking at really exists, if it doesnt then other
' systems can handle the file not found error
If ImgProxy_FileExists( sPath ) Then
'Create an initialise our data stream
If ImgProxy_PrepStream( objStream, sPath ) Then
'Set some cache control headers to reduce bandwidth
' consumption if possible
Response.Expires = 60*24*7
Response.CacheControl = "public"
'Set the content type appropriately
If InStr( 1, sPath, ".gif", vbTextCompare ) > 0 Then
'GIF
Response.ContentType = "image/gif"
ElseIf InStr( 1, sPath, ".jpg", vbTextCompare ) > 0 Or InStr( 1, sPath, ".jpeg", vbTextCompare ) > 0 Then
'JPG
Response.ContentType = "image/jpeg"
ElseIf InStr( 1, sPath, ".png", vbTextCompare ) > 0 Then
'PNG
Response.ContentType = "image/png"
Else
'Other - default to gif
Response.ContentType = "image/gif"
End If
'Feed the binary data to the client
Response.BinaryWrite objStream.Read
'Set the return value to true
ImgProxy_Serve = True
'Tidy up the connection
objStream.Close
Else
Response.Write "No Stream"
End If
Set objStream = Nothing
End If
'Check if we have managed to successfully serve up the image,
' because if so we can terminate the script here, otherwise
' let the script run an re-enter the 404 handler
If ImgProxy_Serve Then
Response.End
End If
End Function
Function ImgProxy_FileExists( ByVal sPath )
'Code to check that a given filename really does exist on the file-system,
' otherwise any additional work will be a waste of time.
Dim objFSO
ImgProxy_FileExists = False
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
If objFSO.FileExists( sPath ) Then
ImgProxy_FileExists = True
End If
End If
Set objFSO = Nothing
On Error Goto 0
End Function
Function ImgProxy_IsHotlink()
'Code to check if the request appears to be from this website or is from somewhere else
Dim sRefer, sHost
ImgProxy_IsHotlink = False
sRefer = Request.ServerVariables("HTTP_REFERER")
sHost = Request.ServerVariables("HTTP_HOST")
If sRefer <> vbNullString Then
'Strip HTTP:// prefix
If StrComp( Left( sRefer, 7 ), "http://", vbTextCompare ) = 0 Then
sRefer = Right( sRefer, Len( sRefer ) - 7 )
End If
'Truncate at trailing slash
If InStr( 1, sRefer, "/" ) > 0 Then
sRefer = Left( sRefer, InStr( 1, sRefer, "/" ) - 1 )
End If
'IP address check
If sRefer <> Request.ServerVariables("LOCAL_ADDR") Then
If StrComp( sRefer, sHost, vbTextCompare ) <> 0 And StrComp( sRefer, "www." & sHost, vbTextCompare ) <> 0 Then
'Image is being hotlinked
ImgProxy_IsHotlink = True
End If
End If
End If
End Function
Function ImgProxy_PrepStream( ByRef objStream, ByVal sPath )
'Code to cleanly handle the configuration and activation of the ADO
' data stream
Const adTypeBinary = 1
ImgProxy_PrepStream = False
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
'Check the object has been successfully created
If Err.Number = 0 Then
objStream.Open
objStream.Type = adTypeBinary
objStream.LoadFromFile sPath
'Check object could actually load the file
If Err.Number = 0 Then
ImgProxy_PrepStream = True
End If
End If
On Error Goto 0
End Function
Function ImgProxy_FixPath( ByVal sPath )
'Code to update the external URL and/or path to one which points to the true location
' of the image - this true location will never be revealed to the browser
'Defaults assume that your external directory is called "myimages" and that the real
' version of this directory (where the actual images are stored) is called "myimages_new".
'You would need to modify this part if you were to move the real images directory outside
' of the webroot.
sPath = Replace( sPath, "/myimages/", "/myimages_new/", 1, 1, vbTextCompare )
sPath = Replace( sPath, "\myimages\", "\myimages_new\", 1, 1, vbTextCompare )
ImgProxy_FixPath = sPath
End Function
Function ReDirect_Hotlink( ByVal sFile )
'Code to integrate the anti-hotlinking script with the 404 handler
'Check if it is eligible for remapping
'Default assumes that the images you want to protect live in a directory
' called "myimages" and that you are only using GIF, PNG or JPEG filetypes
If EvalRegExp( sFile, "^/myimages/.+\.(gif|png|jpg|jpeg)$" ) Then
sFile = ImgProxy_FixPath( sFile )
ImgProxy_Serve sFile
End If
End Function
Function EvalRegExp( ByVal sInput, ByVal sRegExp )
'Code to evaluate a regular expression using the regexp object
Dim objRegular
EvalRegExp = False
Set objRegular = New RegExp
On Error Resume Next
objRegular.IgnoreCase = True
objRegular.Pattern = sRegExp
EvalRegExp = objRegular.Test( sInput )
On Error Goto 0
Set objRegular = Nothing
End Function
%>
Permessi di invio
Rispondi quotando