segunda-feira, 22 de abril de 2002

Veja largura a altura, tamanho em Bytes e as cores de uma imagem


'###############################################
' Este é o teste... coloque qualquer GIF nesta pasta
' E você verá o milagre acontecendo!
' Pode tambem ser com qualquer extensão lembrando
' Somente de mudar no IF ou então adapta-lo para ler
' Qualquer tipo de Arquivo, você pode usar um case!
' se for o caso !!! hehehh

'###############################################
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objF = objFSO.GetFolder("c:\inetpub\wwwroot\minhaimagens")
  Set objFC = objF.Files


  response.write "<table border=""0"" cellpadding=""5"">"


  For Each f1 in objFC
    if instr(ucase(f1.Name), ".JPG") 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 "&nbsp;"
       end if


       response.write "</td></tr>"


    end if


  Next


  response.write "</table>"


  set objFC = nothing
  set objF = nothing
  set objFSO = nothing

'##############################################


  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



  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



  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
 &njsp;         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
%>



Esta matéria foi postada originalmente no ASP4Developers por Thiago Machado Souza (site), que na época era "Programador Desbravador, buscando quebrar todas as fronteiras além do horizonte da arte de programar !
www.thiagomachado.com.br". Hoje, vai saber...

0 comentários: