Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

thiagocs

Dimensões de imagem com FSO

Por , em ASP Clássico

Recommended Posts

thiagocs    0

thiagocs
Postado

dá ero na linha decimal = decimal + ch

 

<!--#include file="fso_functions.asp"--><html><head><TITLE>IMGSIZE</TITLE></head><body bgcolor="#FFFFFF"><%   graphic="C:\web\www\upload5\temp\img\casa.jpg"   HW = ReadImg(graphic)   Response.Write graphic & " Dimensions: " & HW(0) & "x" & HW(1) & "<br>"   response.write "<img src="& graphic & """"    response.write height=""" & HW(0) & """   response.write width=""" & HW(0) & "">"%></body></html>

<%Dim HWFunction AscAt(s, n)       AscAt = Asc(Mid(s, n, 1))End FunctionFunction HexAt(s, n)       HexAt = Hex(AscAt(s, n))End FunctionFunction isJPG(fichero)       If inStr(uCase(fichero), ".JPG") <> 0 Then       isJPG = true       Else       isJPG = false       End IfEnd FunctionFunction isPNG(fichero)       If inStr(uCase(fichero), ".PNG") <> 0 Then       isPNG = true       Else       isPNG = false       End IfEnd FunctionFunction isGIF(fichero)       If inStr(uCase(fichero), ".GIF") <> 0 Then       isGIF = true       Else       isGIF = false       End IfEnd FunctionFunction isBMP(fichero)       If inStr(uCase(fichero), ".BMP") <> 0 Then       isBMP = true       Else       isBMP = false       End IfEnd FunctionFunction isWMF(fichero)       If inStr(uCase(fichero), ".WMF") <> 0 Then       isWMF = true       Else       isWMF = false       End IfEnd FunctionFunction isWebImg(f)       If isGIF(f) Or isJPG(f) Or isPNG(f) Or isBMP(f) Or isWMF(f) Then       isWebImg = true       Else       isWebImg = true       End IfEnd FunctionFunction ReadImg(fichero)       If isGIF(fichero) Then       ReadImg = ReadGIF(fichero)       Else       If isJPG(fichero) Then       ReadImg = ReadJPG(fichero)       Else       If isPNG(fichero) Then       ReadImg = ReadPNG(fichero)       Else       If isBMP(fichero) Then       ReadImg = ReadPNG(fichero)       Else       If isWMF(fichero) Then       ReadImg = ReadWMF(fichero)       Else       ReadImg = Array(0,0)       End If       End If       End If       End If       End IfEnd FunctionFunction ReadJPG(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(fichero, 1)       s = Right(ts.Read(167), 4)       HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))       HW(1) = HexToDec(HexAt(s,1) & HexAt(s,2))       ts.Close    ReadJPG = HWEnd FunctionFunction ReadPNG(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(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 = HWEnd FunctionFunction ReadGIF(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(fichero, 1)       s = Right(ts.Read(10), 4)       HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))       HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))       ts.Close    ReadGIF = HWEnd FunctionFunction ReadWMF(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(fichero, 1)       s = Right(ts.Read(14), 4)       HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))       HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))       ts.Close    ReadWMF = HWEnd FunctionFunction ReadBMP(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(fichero, 1)       s = Right(ts.Read(24), 8)       HW(0) = HexToDec(HexAt(s,4) & HexAt(s,3))       HW(1) = HexToDec(HexAt(s,8) & HexAt(s,7))       ts.Close    ReadBMP = HWEnd FunctionFunction isDigit(c)       If inStr("0123456789", c) <> 0 Then       isDigit = true       Else       isDigit = false       End IfEnd FunctionFunction isHex(c)       If inStr("0123456789ABCDEFabcdef", c) <> 0 Then       isHex = true       Else       ishex = false       End IfEnd FunctionFunction HexToDec(cadhex)       Dim n, i, ch, decimal       decimal = 0       n = Len(cadhex)       For i=1 To n       ch = Mid(cadhex, i, 1)       If isHex(ch) Then       decimal = decimal * 16       If isDigit(c) Then       decimal = decimal + ch       Else       decimal = decimal + Asc(uCase(ch)) - Asc("A")       End If       Else       HexToDec = -1       End If       Next       HexToDec = decimalEnd Function%>

Compartilhar este post

Link para o post
Compartilhar em outros sites

WebASP    0

WebASP
Postado

graphic="C:\sys\sys_image\pilha.jpg" HW = ReadImg(graphic) Response.Write graphic & " Dimensions: " & HW(0) & "x" & HW(1) & "<br>" response.write "<img src="""& graphic response.write """ height=""" & HW(0) response.write """ width=""" & HW(0) & """>"arruma este file ae aqui rodo certinho um aimagem jpg de 250 x 203foi mostradaC:\sys\sys_image\pilha.jpg Dimensions: 80x33 mais na imagem 80 x 80

Compartilhar este post

Link para o post
Compartilhar em outros sites

pedro rodrigues    4

pedro rodrigues
Postado

Opa! Como vai pessoal?

 

Estou precisando capturar a largua e altura (dimensões) de uma imagem. Ao pesquisar cai nesse tópico.

 

Referente ao erro citado pelo thiagocs, eu descobri que precisa arrumar o trecho abaixo:

 

Function HexToDec(cadhex)
 Dim n, i, ch, decimal
 decimal = 0
 n = Len(cadhex)
 For i=1 To n
 ch = Mid(cadhex, i, 1)
 If isHex(ch) Then
 decimal = decimal * 16
[size="4"][color="#ff0000"][u][i][b] [/b][/i][/u][/color][/size][size="4"][color="#ff0000"][u][i][b]If isDigit(c) Then[/b][/i][/u][/color][/size]
 decimal = decimal + ch
 Else
 decimal = decimal + Asc(uCase(ch)) - Asc("A")
 End If
 Else
 HexToDec = -1
 End If
 Next
 HexToDec = decimal
End Function

Para:

 

Function HexToDec(cadhex)
 Dim n, i, ch, decimal
 decimal = 0
 n = Len(cadhex)
 For i=1 To n
 ch = Mid(cadhex, i, 1)
 If isHex(ch) Then
 decimal = decimal * 16
[color="#ff0000"][u][i][b] [/b][/i][/u][/color][color="#ff0000"][u][i][b][size="4"]If isDigit(ch) Then[/size][/b][/i][/u][/color]
 decimal = decimal + ch
 Else
 decimal = decimal + Asc(uCase(ch)) - Asc("A")
 End If
 Else
 HexToDec = -1
 End If
 Next
 HexToDec = decimal
End Function
Mas eu não deu certo, exibiu a dimensão errada da imagem.

 

Alguém tem um código que capture a altura e largua (dimensão) de uma imagem?

 

Obriagdo,

 

Pedro

Compartilhar este post

Link para o post
Compartilhar em outros sites

xanburzum    169

xanburzum
Postado

olha este exemplo:

 

‹%


function GetBytes(flnm, offset, bytes)
Dim objFSO
Dim objFTemp
Dim objTextStream
Dim lngSize
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 ' 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
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
%›

usando

 

 

<%
Set objFS = Server.CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile("c:\imagem.jpg")
If gfxSpex(objFile.Path, w, h, c, strType) = True then
Response.Write " Imagem: <b>" & objFile.name & "</b><br>"
Response.Write "Tamanho: <b>" & w & "x" & h & "</b>"
End If
Set objFile = Nothing
Set objFS = Nothing
%>

Compartilhar este post

Link para o post
Compartilhar em outros sites
Ir para a lista de tópicos ASP Clássico
×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.

  Aceito