用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

%>

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 6
    评论
VB中使用FSo(File System Object)对象可以很方便地搜索文件并进行相关操作。通过FSo对象,我们可以使用其属性和方法来搜索指定目录下的文件,也可以搜索文件夹下的子文件夹中的文件。 使用FSo搜索文件的步骤如下: 1. 创建FSo对象:可以通过下面的代码创建一个FSo对象: Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") 2. 搜索文件:使用FSo的GetFolder方法指定文件夹路径,再使用其Files属性来获取该文件夹下的文件集合。可以通过下面的代码获取目录下的所有文件: Dim folder As Object Set folder = fso.GetFolder("C:\MyFiles") MsgBox folder.Files.Count 上述代码中,我们首先获取C:\MyFiles文件夹对应的FSo目录对象,然后获取该目录下的所有文件集合。最后,我们可以使用Count属性获取该文件夹中的文件数目。 3. 搜索子文件夹中的文件:如果想要搜索子文件夹中的文件,可以使用FSo的SubFolders属性来获取子文件夹集合,再递归查找每个子文件夹中的文件。下面的代码演示了如何搜索指定目录及其子目录中的所有文件Function SearchFiles(ByVal folder As Object) As Long Dim count As Long count = folder.Files.Count Dim subFolder As Object For Each subFolder In folder.SubFolders count = count + SearchFiles(subFolder) Next SearchFiles = count End Function 使用该函数,我们可以传入FSo目录对象,返回该目录及其子目录中的文件数。 总之,FSo提供了强大的搜索功能,可以满足VB中搜索文件的多种需求。可以灵活地使用FSo的属性和方法,实现快速、效的文件搜索。

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 6
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值