<%
'::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::
': BMP, GIF, JPG and PNG :::
'::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::
'::::::
': 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 :::
'::::::
'::::::::::::::::::::::::::::::::::::::: ::::::::::::::::::::::::::::
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)
End if
If bytes =-1 then' Get All!
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 (1, 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
%>
(Author: continent)