griefforyou的程序人生

当你感到悲哀痛苦时,最好是去学些什么东西。学习会使你永远立于不败之地。...

用FSO获得图片文件的信息(大小,宽,高)

<%
'':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'':::  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(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

%>

阅读更多
个人分类: Web开发文档
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

加入CSDN,享受更精准的内容推荐,与500万程序员共同成长!
关闭
关闭