[Resolvido] obter todos os dados da imagem

[xanburzum 169]

Recuperar propriedades da imagem de um arquivo não-local ,obter todos os dados da imagem, arquivo com base na definição de algoritmos em tamanho IMGSZ que também pega a imagem de um site remoto usando XML, suporta arquivos GIF e JPG.

 

A sintaxe a utilizar getSize é a seguinte:

 

someBoolean = pegatamanho(URL, width, height, depth, flType)

‘URL, largura, altura, profundidade, flType

 

• someBoolean será definido com base verdadeiro ou falso se o script foi capaz de determinar os atributos de imagens

• URL é uma entrada informando a URL da imagem, tais como http://www.sintchospir.com/images/sua_imagem.jpg

• largura será definida para a largura da imagem, ou -1 para script failed

• A altura será definido para a altura da imagem, ou -1 para script failed

•Profundidade será definido como a profundidade da imagem, ou -1 para script failed

• FlType será definido o tipo de arquivo de imagem foi, GIF ou JPG

 

Utilizando as funções de string binária como midb e lenb. Uma vez que todas as imagens são arquivos binários, essas funções são necessárias.

 

 

<%
  
   function GetBytes(objHTTP, offset, bytes)

     Dim SizeofFile
     on error resume next
     SizeofFile = objHTTP.getResponseHeader("Content-Length")
     'Obtém o tamanho do arquivo a partir do cabeçalho HTTP
     if offset > 0 then 'começar em bytes não no início
     strbuff = midb(objHTTP.responseBody, offset, bytes)
     end if
     if bytes = -1 then        ' Get All!
        GetBytes = objHTTP.responseBody  'ReadAll
     else 
        GetBytes = midb(objHTTP.responseBody, 1, bytes)
     end if
  end function


  function lngConvert(strTemp)
     lngConvert = clng(ascb(leftb(strTemp, 1)) + ((ascb(rightb(strTemp, 1)) * 256)))
  end function

  function lngConvert2(strTemp)
     lngConvert2 = clng(ascb(rightb(strTemp, 1)) + ((ascb(leftb(strTemp, 1)) * 256)))
  end function

  
    function pegatamanho(URL, width, height, depth, flType)

     dim PNGflType 
     dim GIFflType
     dim BMPflType
     dim flTypeOf
     dim obj
     flTypeOf = ""
     flType = "(unknown)"
     Set obj = Server.CreateObject ("Microsoft.XMLHTTP")
     obj.open "GET", URL, False
     obj.send
     '"Aqui nós temos os dados para o arquivo de imagem
     pegatamanho = False
     PNGflType = chr(137) & chr(80) & chr(78)
     GIFflType = chrb(71) & chrb(73) & chrb(70)
     BMPflType = chr(66) & chr(77)
     'Aqui estão as definições para o flTypes imagem, suportam GIF e JPG, mas você pode adicionar outros:)
     flTypeOf = GetBytes(obj, 0, 3)
     'Saiba quaul o flType da imagem
     if flTypeOf = GIFflType then    'É um GIF!!!
     flType = "GIF"    
     strbuffer = getbytes(obj, 0, -1) 'obter todos os dados da imagem
     width= lngconvert(midb(strbuffer, 7, 2))
     Height = lngconvert(midb(strbuffer, 9, 2))
     Depth = 2 ^ ((ascb(GetBytes(obj, 11, 1)) and 7) + 1)
     'É muito importante observar o ascB e midB, as imagens são arquivos binários 
     pegatamanho = True
     else
     strBuff = GetBytes(obj, 0, -1)        'obter o arquivo inteiro
     SizeofFile = lenb(strBuff)
     flgFound = 0
     strTarget = chrb(255) & chrb(216) & chrb(255)
     flgFound = instrb(strBuff, strTarget)
     char = (midb(strbuff, 1, 3)) 'confira os primeiros caracteres
     if flgFound = 0 then 'diferente de jpg ou GIF
       exit function
     end if
     flType = "JPG"
     lngPos = flgFound + 2
     ExitLoop = false
     do while ExitLoop = False and lngPos < SizeofFile
           do while ascb(midb(strBuff, lngPos, 1)) = 255 and lngPos < SizeofFile
              lngPos = lngPos + 1
           loop
           'pesquisa até encontrar os dados
           if ascb(midb(strBuff, lngPos, 1)) < 192 or ascb(midb(strBuff, lngPos, 1)) > 195 then
              lngMarkerSize = lngConvert2(midb(strBuff, lngPos + 1, 2))
              lngPos = lngPos + lngMarkerSize  + 1
           else
              ExitLoop = True 'temos tudo que precisamos
           end if

     loop

           if ExitLoop = False then 
 
              Width = -1
              Height = -1
              Depth = -1
    
           else

              Height = lngConvert2(midb(strBuff, lngPos + 4, 2))
              Width = lngConvert2(midb(strBuff, lngPos + 6, 2))
              Depth = 2 ^ (ascb(midb(strBuff, lngPos + 8, 1)) * 8)
              pegatamanho = True

           end if
                   
     end if
  
  set obj = Nothing
  end function





%>