Du kan prøve det her:
Et lille problem er at selv om det viser thumbnails af billederne, bliver de loadet som fuldstørelse billeder.
<% OPTION EXPLICIT %>
<% Response.Expires = 0 %>
<% Response.Buffer = True %>
<%
Function Name(file)
Name = LEFT(file,InStr(file,".")-1)
End Function
Function Extension(file)
Extension = RIGHT(file,(LEN(file)-InStr(file,".")))
End Function
Function ShowFileList(folderspec,columns)
Dim ImgRow, TxtRow
Dim fso, f, f1, fc, s, Ext, i
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder(folderspec)
Set fc = f.Files
s = s & "<table border=1 cellspacing=4 cellpadding=4 align=center bgcolor=#000000><tr>"
i = 0
For Each f1 in fc
Ext = LCase(Extension(f1.name))
IF Ext = "jpg" OR Ext = "jpeg" OR Ext = "gif" OR Ext = "png" THEN
IF i MOD columns = 0 THEN
s = s & ImgRow & "</tr><tr>"
s = s & TxtRow & "</tr><tr bgcolor=#999999>"
ImgRow = ""
TxtRow = ""
i = 0
END IF
ImgRow = ImgRow & "<td><table border=""0"" width=""104"" height=""104"" cellspacing=0 cellpadding=0 bgcolor=#000000><tr><td align=center><a href=""vis.asp?id=" & f1.name & """>" & ShowImg(f1.name,96,96) & "</a></td></tr></table></td>"
TxtRow = TxtRow & "<td align=center><a href=""vis.asp?id=" & f1.name & """>" & f1.name & "</a></td>"
i = i + 1
END IF
Next
s = s & ImgRow & "</tr><tr>"
s = s & TxtRow & "</tr>"
s = s & "</table>"
ShowFileList = s
End Function
Function ShowImg(file,width,height)
Size = ReadImg(file)
'Width: Size(0)
'Height: Size(1)
IF Size(0) < width AND Size(1) < height THEN ' Begge mindre end de givne størrelser
width = Size(0)
height = Size(1)
ELSEIF Size(0) < Size(1) THEN ' Bredde mindre, højde større end de givne størrelser
width = FormatNumber(Size(0) / (Size(1) / height),0)
ELSEIF Size(0) > Size(1) THEN ' Bredde større, højde mindre end de givne størrelser
height = FormatNumber(Size(1) / (Size(0) / width),0)
END IF
ShowImg = ShowImg & "<img border=0 src=""" & file & """ width=""" & width & """ height=""" & height & """>"
End Function
Dim id, path
id = Request.QueryString("id")
IF id <> "" THEN
Response.Write id & " "
Size = ReadImg(id)
Response.Write "(" & Size(0) & " x " & Size(1) & ")<p>"
Response.Write "<img src=""" & id & """><p>"
Response.Write "<a href=java script:history.back()>Tilbage</a>"
ELSE ' Thumbnails
path = Request.ServerVariables("PATH_TRANSLATED")
path = LEFT(path,InStrRev(path,"\"))
Response.Write ShowFileList(path,5)
END IF
' DIMENSIONER
Dim Size
Function AscAt(s, n)
AscAt = Asc(Mid(s, n, 1))
End Function
Function HexAt(s, n)
Dim lsH
lsH = Hex(AscAt(s, n))
If Len(lsH) <> 2 Then lsH = "0" & lsH
HexAt = lsH
End Function
Function isJPG(filen)
If inStr(uCase(filen), ".JPG") <> 0 Or inStr(uCase(filen), ".JPEG") <> 0 Then
isJPG = true
Else
isJPG = false
End If
End Function
Function isPNG(filen)
If inStr(uCase(filen), ".PNG") <> 0 Then
isPNG = true
Else
isPNG = false
End If
End Function
Function isGIF(filen)
If inStr(uCase(filen), ".GIF") <> 0 Then
isGIF = true
Else
isGIF = false
End If
End Function
Function ReadImg(filen)
If isGIF(filen) Then
ReadImg = ReadGIF(filen)
Else
If isJPG(filen) Then
ReadImg = ReadJPG(filen)
Else
If isPNG(filen) Then
ReadImg = ReadPNG(filen)
End If
End If
End If
End Function
Sub Rep(s)
Response.Write s & "<BR>"
End Sub
Function ReadJPG(filen)
Dim fso, ts, s, HW, ns, n, ok
HW = Array("","")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Server.MapPath(filen), 1)
ts.Skip(2)
ns = ts.Read(2)
Do While Not (ns = "ÿÀ" Or ns = "ÿÂ")
ns = ts.Read(2)
n = HexToDec(HexAt(ns,1) & HexAt(ns,2))
n = n - 2
ts.Skip(n)
ns = ts.Read(2)
Loop
ts.Skip(3)
s = ts.Read(4)
HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
HW(1) = HexToDec(HexAt(s,1) & HexAt(s,2))
ts.Close
Set ts = Nothing
ReadJPG = HW
End Function
Function ReadPNG(filen)
Dim fso, ts, s, HW, nbytes
HW = Array("","")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Server.MapPath(filen), 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(filen)
Dim fso, ts, s, HW, nbytes
HW = Array("","")
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Server.MapPath(filen), 1)
ts.Skip(6)
s = ts.Read(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 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(ch) Then
decimal = decimal + ch
Else
decimal = decimal + Asc(uCase(ch)) - Asc("A") + 10
End If
Else
HexToDec = -1
End If
Next
HexToDec = decimal
End Function
%>
Så kan du lave en side som hedder vis.asp som denne for at vise et billedet i fuld størrelse.
<%
pic = Request.QueryString("id")
%>
<table border="1" cellspacing="5" cellpadding="2" align="center" bgcolor="#000000">
<tr><td bgcolor="#999999">
<table border="0" cellspacing="0" cellpadding="0" align="center" bgcolor="#000000"><tr><td><% response.write "<img src=" & pic & ">"%></td></tr></table>
</td></tr></table>
Ny bruger
Nybegynder
Opret
Preview
