<%
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
%>