如何使用服务器端vbscript获取图像宽度? Asp经典

时间:2010-03-07 17:14:12

标签: asp-classic vbscript

我一直在努力寻找一种方法来获取驻留在我们服务器上的.png文件的图像宽度。我试图读取文件的前24个字节,并从字节17-20解析出宽度。我在网上找到了几个例程但没有成功。奇怪的是,似乎我得到从十六进制到十进制解码的字节21-24的高度就好了。我已经使用十六进制查看器验证了文件内容,文件很好。这是例程的主要部分:

Function ReadPNG(fichero)
Dim fso, ts, s, HW, nbytes
    HW = Array("0", "0")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpenTextFile(Server.MapPath("\forums\attachments/" & fichero), 1)
    s = Right(ts.Read(24), 8)
    HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
    HW(1) = HexToDec(HexAt(s,7) & HexAt(s,8))
    ts.Close
    ReadPNG = HW
End Function

Function HexAt(s, n)
    HexAt = Hex(AscAt(s, n))
End Function

Function HexToDec(ByVal HexVal)

Dim i, num, part
num = 0
For I = 1 to Len(HexVal)
    part = Mid(StrReverse(UCase(HexVal)), I, 1)
    If IsNumeric(part) Then
        num = num + (CInt(part) * 16 ^ (I - 1) )
    Else
        num = num + ( (Asc(part) - 55) * 16^(I - 1) )
    End If
Next

HexToDec = num

End Function

例如,我的文件在宽度字节(十进制384)中有十六进制“00 00 01 80”                        和高度字节(十进制306)中的十六进制“00 00 01 32”

我得到了高度306但是你的宽度正在返回“0011”(十进制17)。

我完全陷入困境!我也不必使用这个例程。

谢谢, 吉姆

3 个答案:

答案 0 :(得分:4)

这是我前一段时间看过的一篇文章,看起来它可能会简化一些事情。我没有测试过,所以让我知道你的结果。

<%
dim iWidth, iheight
sub ImgDimension(img)
dim myImg, fs
Set fs= CreateObject("Scripting.FileSystemObject")
if not fs.fileExists(img) then exit sub
set myImg = loadpicture(img)
iWidth = round(myImg.width / 26.4583)
iheight = round(myImg.height / 26.4583)
set myImg = nothing
end sub

ImgDimension(Server.MapPath("server image file"))
%> 

点击此处查看帖子:http://www.haneng.com/asp-forum/ASP---Get-Image-Size_12971.html

更新:看到此方法无法在64位中运行。以下是另一种替代方法的链接:http://www.4guysfromrolla.com/webtech/050300-1.shtml

答案 1 :(得分:2)

我使用这个简单的函数来返回宽度,高度和文件大小(例如640x480 - 200KBytes):

   Function ImgDim(img)
    Dim objFSO, objGF, objLP, imgWdt, imgHgt, imgSiz
    img = Server.MapPath("/pictures/"& img) 'path to picture
    Set objFSO= CreateObject("Scripting.FileSystemObject")
    If objFSO.fileExists(img) Then
     Set objGF = objFSO.GetFile(img)
      imgSiz = objGF.Size
     Set objGF = Nothing
     Set objLP = loadpicture(img)
      imgWdt = round(objLP.width / 26.4583)
      imgHgt = round(objLP.height / 26.4583)
     Set objLP = Nothing
     Set fs = Nothing
     ImgDim = imgWdt &"x"& imgHgt &" - "& imgSiz/1024 &"KBytes"
    End If
   End Function

工作得很漂亮,希望有所帮助。

答案 2 :(得分:0)

这是我在很久以前发现的用于获取图像信息的一组通用函数。我会按照我最后一直使用它的方式。

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::                                                             :::'
':::  This routine will attempt to identify any filespec passed  :::'
':::  as a graphic file (regardless of the extension). This will :::'
':::  work with BMP, GIF, JPG and PNG files.                     :::'
':::                                                             :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::          Based on ideas presented by David Crowell          :::'
':::                   (credit where due)                        :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah     Copyright *c* MM,  Mike Shaffer     blah blah :::'
'::: blah blah      ALL RIGHTS RESERVED WORLDWIDE      blah blah :::'
'::: blah blah  Permission is granted to use this code blah blah :::'
'::: blah blah   in your projects, as long as this     blah blah :::'
'::: blah blah      copyright notice is included       blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::'
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::'

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

我一直在使用它来为图像库生成随机XML文件。只有在我将新图像上传到库时才会运行脚本。

以下是用法:(或至少我如何使用它)

'collect the image information into an array'
Dim blnGfxSpex, width, height, colors, strType
intCount = 0
For Each objFile In objFS.GetFolder(".\images").Files
    If LCase(Right(objFile.Name, 4)) = ".jpg" and intCount <= intNumOfFiles Then
        blnGfxSpex = gfxSpex((".\images\" & objFile.Name), width, height, colors, strType)

        arrImages(intCount) = "<image>" & vbNewLine & _
                                "<filename>" & objFile.Name & "</filename>" & vbNewLine & _
                                "<caption></caption>" & vbNewLine & _
                                "<width>" & width & "</width>" & vbNewLine & _
                                "<height>" & height & "</height>" & vbNewLine & _
                                "</image>" & vbNewLine
        intCount = intCount + 1
    End If
Next

如您所见,我正在初始化宽度,高度等变量,并且函数会根据需要设置它们。我知道使用像这样的全局变量不是犹太教,但它确实有用。

表现并不像你想象的那么糟糕。在这种特殊情况下,我将图像库过滤为JPG,但这是由于XML所针对的图像库的限制,而不是由于功能的限制。