您的位置:首页网页设计ASP实例 → 利用FSO取得BMP,JPG,PNG,GIF文件信息大小,宽、高等

利用FSO取得BMP,JPG,PNG,GIF文件信息大小,宽、高等

时间:2004/11/7 3:01:00来源:本站整理作者:蓝点我要评论(0)

<%

  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

  ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

  ':::   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 ""

  For Each f1 in objFC

    if instr(ucase(f1.Name), ".GIF") then

       response.write ""

    end if

  Next

  response.write "
" & f1.name & "" & f1.DateCreated & "" & f1.Size & ""

       if gfxSpex(f1.Path, w, h, c, strType) = true then

          response.write w & " x " & h & " " & c & " colors"

       else

          response.write " "

       end if

       response.write "
"

  set objFC = nothing

  set objF = nothing

  set objFSO = nothing



%>














相关阅读 Windows错误代码大全 Windows错误代码查询激活windows有什么用Mac QQ和Windows QQ聊天记录怎么合并 Mac QQ和Windows QQ聊天记录Windows 10自动更新怎么关闭 如何关闭Windows 10自动更新windows 10 rs4快速预览版17017下载错误问题Win10秋季创意者更新16291更新了什么 win10 16291更新内容windows10秋季创意者更新时间 windows10秋季创意者更新内容kb3150513补丁更新了什么 Windows 10补丁kb3150513是什么

文章评论
发表评论

热门文章 没有查询到任何记录。

最新文章 迅雷新手完全入门手册 asp下面javascript上传图片限制格式大小方法告诉大家网页弹出窗口应用总结ASP常见错误类型大全asp常见错误分析和解决办法

人气排行 总是弹出visual studio 实时调试器 三种解决SQLSERVER存储过程及调用详解Asp获取真实IP地址ASP中连接Mssql的几种方法一个简单好用的UBB编辑器(含代码)如何用Split将字符串转换为数组并获取数组下ASP防止表单重复提交的办法告诉你免费的简单聊天室源代码