首页 电脑 电脑学堂 查看内容

利用ASP获得图象的实际尺寸的示例

2009-2-16 10:28 785 0

摘要: <!--#include virtual="/learn/test/lib_graphicdetect.asp"--><html><head><TITLE&g...
关键词: nbsp Function fichero HexAt HexToDec Else Then End fso decimal

<!--#include virtual="/learn/test/lib_graphicdetect.asp"--><html><head><TITLE>dbtable.asp</TITLE></head><body bgcolor="#FFFFFF"><%   graphic="images/learnaspiconmain.webp"   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>   The library that is included is: <%Dim HW Function AscAt(s, n)       AscAt = Asc(Mid(s, n, 1))End Function Function HexAt(s, n)       HexAt = Hex(AscAt(s, n))End Function Function isJPG(fichero)       If inStr(uCase(fichero), ".JPG") <> 0 Then       isJPG = true       Else       isJPG = false       End IfEnd Function Function isPNG(fichero)       If inStr(uCase(fichero), ".PNG") <> 0 Then       isPNG = true       Else       isPNG = false       End IfEnd Function Function isGIF(fichero)       If inStr(uCase(fichero), ".GIF") <> 0 Then       isGIF = true       Else       isGIF = false       End IfEnd Function Function isBMP(fichero)       If inStr(uCase(fichero), ".BMP") <> 0 Then       isBMP = true       Else       isBMP = false       End IfEnd Function Function isWMF(fichero)       If inStr(uCase(fichero), ".WMF") <> 0 Then       isWMF = true       Else       isWMF = false       End IfEnd Function Function 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 Function Function 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 Function Function ReadJPG(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(Server.MapPath("/" & 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 Function Function ReadPNG(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(Server.MapPath("/" & 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 Function Function ReadGIF(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(Server.MapPath("/" & 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 Function Function ReadWMF(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(Server.MapPath("/" & 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 Function Function ReadBMP(fichero)    Dim fso, ts, s, HW, nbytes       HW = Array("","")       Set fso = CreateObject("Scripting.FileSystemObject")       Set ts = fso.OpenTextFile(Server.MapPath("/" & 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 Function Function isDigit(c)       If inStr("0123456789", c) <> 0 Then       isDigit = true       Else       isDigit = false       End IfEnd Function Function isHex(c)       If inStr("0123456789ABCDEFabcdef", c) <> 0 Then       isHex = true       Else       ishex = false       End IfEnd Function 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       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%>
声明:文章版权归原作者所有 部分文章转自互联网 如有侵权请联系 [邮箱地址] 删除

路过

雷人

握手

鲜花

鸡蛋

最新评论

返回顶部