WEB开发网
开发学院WEB开发ASP 利用ASP获得图象的实际尺寸的示例 阅读

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

 2000-10-20 10:12:28 来源:WEB开发网   
核心提示:<!--#include virtual="/learn/test/lib_graphicdetect.asp"--><html><head><TITLE>dbtable.asp</TITLE></head><body b
<!--#include virtual="/learn/test/lib_graphicdetect.asp"-->
<html><head>
<TITLE>dbtable.asp</TITLE>
</head>
<body bgcolor="#FFFFFF">
<%
  graphic="images/learnaspiconmain.gif"
  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 If
End Function


Function isPNG(fichero)
    If inStr(uCase(fichero), ".PNG") <> 0 Then
    isPNG = true
    Else
    isPNG = false
    End If
End Function


Function isGIF(fichero)
    If inStr(uCase(fichero), ".GIF") <> 0 Then
    isGIF = true
    Else
    isGIF = false
    End If
End Function


Function isBMP(fichero)
    If inStr(uCase(fichero), ".BMP") <> 0 Then
    isBMP = true
    Else
    isBMP = false
    End If
End Function


Function isWMF(fichero)
    If inStr(uCase(fichero), ".WMF") <> 0 Then
    isWMF = true
    Else
    isWMF = false
    End If
End 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 If
End 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 If
End 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 = HW
End 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 = HW
End 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 = HW
End 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 = HW
End 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 = HW
End Function


Function isDigit(c)
    If inStr("0123456789", c) <> 0 Then
    isDigit = true
    Else
    isDigit = false
    End If
End Function


Function isHex(c)
    If inStr("0123456789ABCDEFabcdef", c) <> 0 Then
    isHex = true
    Else
    ishex = false
    End If
End 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 = decimal
End Function
%>

Tags:利用 ASP 获得

编辑录入:爽爽 [复制链接] [打 印]
赞助商链接