<%
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: BMP, GIF, JPG and PNG:::
':::, Original: Junyd:::::::::
'::::: To:::::::::::::--(::), Ouyangdongjie:;::;.:;::
'::: :::
':: This dongdong can get this file from BMP, GIF, JPG and PNG image bytes::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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 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
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: The following is the ability to convert two bytes into a unified value::
'::: (small endian and large 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 feature does most of the real work. It intends to try:::
'::: Read any file::
'::: If it is an image of a chart, identify it. :::
'::: :::
'::: 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 (+) & Chr (78)
Strgif = "GIF"
Strbmp = Chr ($) & 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, 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)) < 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:::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' To test, we put the file on the 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
%>
