Thread: resizing images
View Single Post
  #5 (permalink)  
Old Sep 30th, 2004, 08:56
Rob's Avatar
Rob Rob is offline
Head Admin & CEO

SuperMember
Join Date: Jul 2003
Location: at my desk
Age: 34
Posts: 2,953
Blog Entries: 7
Thanks: 7
Thanked 4 Times in 4 Posts
Here ya go. Nothing needed except ASP and the FileSystemObject:-
Code: Select all
<%
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This routine will attempt to identify any filespec passed  :::
':::  as a graphic file (regardless of the extension). This will :::
':::  work with BMP, GIF, JPG and PNG files.                     :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::          Based on ideas presented by David Crowell          :::
':::                   (credit where due)                        :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah     Copyright *c* MM,  Mike Shaffer     blah blah :::
'::: blah blah      ALL RIGHTS RESERVED WORLDWIDE      blah blah :::
'::: blah blah  Permission is granted to use this code blah blah :::
'::: blah blah   in your projects, as long as this     blah blah :::
'::: blah blah      copyright notice is included       blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function gets a specified number of bytes from any    :::
':::  file, starting at the offset (base 1)                      :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       offset      => Offset at which to start reading       :::
':::       bytes       => How many bytes to read                 :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::            Downloaded From 4guysfromrolla.com               :::
'::: http://www.4guysfromrolla.com/webtech/code/imgsz.asp.html   :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Function GetBytes(flnm, offset, bytes)
    Dim objFSO
    Dim objFTemp
    Dim objTextStream
    Dim lngSize
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' First, we get the filesize
    Set objFTemp = objFSO.GetFile(flnm)
    lngSize = objFTemp.Size
    Set objFTemp = Nothing
	fsoForReading = 1
    Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)
    If offset > 0 Then strBuff = objTextStream.Read(offset - 1)
    
    If bytes = -1 Then
		GetBytes = objTextStream.Read(lngSize)  'ReadAll
    Else
		GetBytes = objTextStream.Read(bytes)
    End If
    objTextStream.Close
    Set objTextStream = Nothing
    Set objFSO = Nothing
End Function

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  Functions to convert two bytes to a numeric value (long)   :::
':::  (both little-endian and big-endian)                        :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Function lngConvert(strTemp)
	lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
End Function

Function lngConvert2(strTemp)
	lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
End Function
  
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::                                                             :::
':::  This function does most of the real work. It will attempt  :::
':::  to read any file, regardless of the extension, and will    :::
':::  identify if it is a graphical image.                       :::
':::                                                             :::
':::  Passed:                                                    :::
':::       flnm        => Filespec of file to read               :::
':::       width       => width of image                         :::
':::       height      => height of image                        :::
':::       depth       => color depth (in number of colors)      :::
':::       strImageType=> type of image (e.g. GIF, BMP, etc.)    :::
':::                                                             :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
function gfxSpex(flnm, width, height, depth, strImageType)
	dim strPNG
	dim strGIF
	dim strBMP
	dim strType
	strType = ""
	strImageType = "(unknown)"

	gfxSpex = False

	strPNG = chr(137) & chr(80) & chr(78)
	strGIF = "GIF"
	strBMP = chr(66) & chr(77)

	strType = GetBytes(flnm, 0, 3)

	If strType = strGIF Then ' is GIF
		strImageType = "GIF"
		Width = lngConvert(GetBytes(flnm, 7, 2))
		Height = lngConvert(GetBytes(flnm, 9, 2))
		Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
		gfxSpex = True
	ElseIf left(strType, 2) = strBMP Then ' is BMP
		strImageType = "BMP"
		Width = lngConvert(GetBytes(flnm, 19, 2))
		Height = lngConvert(GetBytes(flnm, 23, 2))
		Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
		gfxSpex = True
	ElseIf strType = strPNG Then ' Is PNG
		strImageType = "PNG"
		Width = lngConvert2(GetBytes(flnm, 19, 2))
		Height = lngConvert2(GetBytes(flnm, 23, 2))
		Depth = getBytes(flnm, 25, 2)
		select case asc(right(Depth,1))
			case 0
				Depth = 2 ^ (asc(left(Depth, 1)))
				gfxSpex = True
			case 2
				Depth = 2 ^ (asc(left(Depth, 1)) * 3)
				gfxSpex = True
			case 3
				Depth = 2 ^ (asc(left(Depth, 1)))  '8
				gfxSpex = True
			case 4
				Depth = 2 ^ (asc(left(Depth, 1)) * 2)
				gfxSpex = True
			case 6
				Depth = 2 ^ (asc(left(Depth, 1)) * 4)
				gfxSpex = True
			case else
				Depth = -1
		end select
	Else
		strBuff = GetBytes(flnm, 0, -1)		' Get all bytes from file
		lngSize = len(strBuff)
		flgFound = 0
		strTarget = chr(255) & chr(216) & chr(255)
		flgFound = instr(strBuff, strTarget)
		if flgFound = 0 then
			exit function
		end if
		strImageType = "JPG"
		lngPos = flgFound + 2
		ExitLoop = false
		do while ExitLoop = False and lngPos < lngSize
			do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
				lngPos = lngPos + 1
			loop
			if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
				lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
				lngPos = lngPos + lngMarkerSize  + 1
			else
				ExitLoop = True
			end if
		loop
		if ExitLoop = False then
			Width = -1
			Height = -1
			Depth = -1
		else
			Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
			Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
			Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
			gfxSpex = True
		end if        
	end if
end function

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::     Test Harness                                              :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' To test, we'll just try to show all files with a .GIF extension in the root of C:
'  Set objFSO = CreateObject("Scripting.FileSystemObject")
'  Set objF = objFSO.GetFolder("c:\")
'  Set objFC = objF.Files
'
'  response.write "<table border=""0"" cellpadding=""5"">"
'
'  For Each f1 in objFC
'    if instr(ucase(f1.Name), ".GIF") then
'       response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated & "</td><td>" & f1.Size & "</td><td>"
'
'       if gfxSpex(f1.Path, w, h, c, strType) = true then
'          response.write w & " x " & h & " " & c & " colors"
'       else
'          response.write ""
'       end if
'
'       response.write "</td></tr>"
'
'    end if
'
'  Next
'
'  response.write "</table>"
'
'  set objFC = nothing
'  set objF = nothing
'  set objFSO = nothing
%>
Start eating Smokie...
__________________
Rob - SEO Specialist
Owner & Founder of Webforumz.com

I am currently unavailable for private work