Newsgroup: it.comp.www.asp
Titolo: DIMENSIONI in PIXEL (classic asp)

Come calcolare la dimensione in pixel di un'immagine JPG in classic ASP?
in ASP classic,  non si trova lo script adatto per calcolare le dimensioni
in PIXEL di un'iimagine.
Quello proposto e riproposto in rete (allego sotto) spara dei valori
assurdi, e non solo a me, visto che nei forum, rispondono tutti con dei
valori assurdi (per intenderci 4600 invece che 320, ecc.)
<%
'##################################
'#Come ricavare la dimensione in
'#pixel di una immagine .jpg .gif
'#.bmp
'##################################
Dim Dimensione
Function ImageSize(Immagine)
  Dimensione = Array("","")
  Formato = Right(UCase(Immagine),3)
  Select Case Formato
    Case "JPG"
      start = 167
      max = 4
      xs = 3
      xe = 4
      ys = 1
      ye = 2
    Case "GIF"
      start = 10
      max = 4
      xs = 2
      xe = 1
      ys = 4
      ye = 3
    Case "BMP"
      start = 24
      max = 8
      xs = 4
      xe = 3
      ys = 8
      ye = 7
  End Select
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.OpenTextFile(Server.MapPath(Immagine),1)
  s = Right(ts.Read(start), max)
  Dimensione(0) = hextodec(hexat(s,xs) & hexat(s,xe))
  Dimensione(1) = hextodec(hexat(s,ys) & hexat(s,ye))
  ts.Close
  ImageSize = Dimensione
End Function
Function hexat(s, n)
  hexat = hex(asc(mid(s, n, 1)))
  If len(hexat) = 1 then hexat = "0" & hexat
End Function
Function hextodec(cadhex)
  Dim n, i, ch, decimal
  decimal = 0
  n = Len(cadhex)
  For i = 1 to n
    decimal = decimal * 16
    ch = Mid(cadhex, i, 1)
    decimal = decimal + inStr("0123456789ABCDEFabcdef", ch) - 1
  Next
  hextodec = decimal
End Function
Immagine = "tuaimmagine.jpg"  'qui il path virtuale dell'immagine
Dimensione = ImageSize(Immagine)
Response.Write "Larghezza: " & Dimensione(0) & " pixel" & "<br>"
Response.Write "Altezza: " & Dimensione(1) & " pixel"
%>

 valori assurdi (per intenderci 4600 invece che 320, ecc.)
Sì, probabilmente per via della compressione.
Prova questo, a me funziona di sicuro
<%
  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
     strType = GetBytes(flnm, 0, 3)
        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 function
'QUI LANCIO IL FILE DA CONTROLLARE
filename = Request.querystring("filename")
estensione = UCase(Right(filename, 3))
IF estensione = "JPG" OR estensione = "PEG" Then
	filename = "../immagini/" & filename
	immagine = Server.MapPath(filename)
 	Set objFSO = CreateObject("Scripting.FileSystemObject")
  	Set objF = objFSO.GetFile(immagine)
    if gfxSpex(objF.Path, w, h, c, strType) = true then
        larghezza = w
	 altezza = h
	 peso = objF.Size
	 peso = peso/1028
	 peso = round(peso, 2)
    end if
	set objFC = nothing
	set objF = nothing
	set objFSO = nothing
 
End IF
%>
------------------------------------------------
Meglio dire a tua madre che fai il pianista 
in un bordello, piuttosto che il webmaster.
------------------------------------------------


--
Enjoy the .NET community! ASPItalia.com
 
http://forum.aspitalia.com/
 
http://www.aspitalia.com/

Non so se sono sfigato o se sono scemo.
Mi dite come diavolo fanno a funzionare. Ogni volta che li lancio mi danno
una serie di errori, non dovuti al mio PC
Per esempio manca un then dopo un if.... insomma non dovrebbero funzionare a
voi????
E invece alla grande. BOH!

 valori assurdi (per intenderci 4600 invece che 320, ecc.)
in rete ne ho trovati 2: uno funziona e l'altro no... quello che non
funziona č quello che viene proposto su molti siti italiani...
L'altro č meno diffuso ma c'č! Dovrebbe essere uno di quelli qua sopra...
ciao

ECCOLA QUA TRASFORMATA:
<%
 function GetBytes(flnm, offset, bytes)
      on error resume next
      Set objFSO = CreateObject("Scripting.FileSystemObject")
      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
         GetBytes = objTextStream.Read(lngSize)
      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)
      gfxSpex = False
      strType = GetBytes(flnm, 0, 3)
        strBuff = GetBytes(flnm, 0, -1)

 end function
 Set objFSO = CreateObject("Scripting.FileSystemObject")
  'questa variabile è quella che porta il nome del file da analizzare nella
funzione
 nomefile="3.jpg"
 Set objF = objFSO.GetFile(Server.MapPath("foto/"&nomefile))
    if instr(ucase(objF.Name), ".JPG") then
       'stampo i valori:
tipofile,nome,datacreazione,dimensione,larghezza,altezza,colori
    response.write "<Table border=1><tr><td>" & objF.Type &"</td><td>" &
objF.name & "</td><td>" & objF.DateCreated & "</td><td>" &
Int(objF.Size/1024)&" kb</td></TR></table>"
    if gfxSpex(objF.Path, w, h, c, strType) = true then response.write w & "
x " & h & " " & c & " colori"
    end if
  set objF = nothing
  set objFSO = nothing
%>

Un errore era dato dal fatto che copiando dalla mail, non andava a capo
correttamente (&_ per intenderci)
La versione che ho pubblicato io, funziona solo per JPG, ma è più veloce,
più compatta, e passi un parametro cone nome dell'immagine, e ti da i dati
che servono.
Puoi poi disabilitarli. Io addirittura da me, ho tolto anche alcuni
parametri passati alla funzione gfxSpex, accelerando ancora la funzione