• 相关软件
    >利用FSO取得BMP,JPG,PNG,GIF文件信息 创建者:webmaster 更新时间:2005-07-02 00:19

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


    %>

    相关文章
    本页查看次数: