ae image fra Activedeveloper.dk laver ingen thumbnails
Jeg har forsøgt at få nedenstående kode (ae image 1.0) til at spille på min server. Den laver ingen fejl, den genererer en "thumbnail"-mappe og tilhørende html-filer, den giver mig en OK status til slut..Det eneste den ikke gør er at generere thumbnals i mappen thumbnails...
Er der nogen der kan gennemskue hvorfor ?
Koden:
'<% mode = "asp"
if mode = "asp" then Server.ScriptTimeOut = 3600
if mode = "asp" then Response.Expires = 0
'*******************************************************************************
' Oprindelig version:
' aeImage v0.5 - Copyright (c)2001 Lasse Bunk
'*******************************************************************************
' This is a simple resize demo.
' For complete documentation and support, please write to lasse@303.dk
'*******************************************************************************
' Ny version:
' aeImage v1.0 - Copyright (c)2004 Christoffer Thygesen
'*******************************************************************************
' Ny version der finder billeder i alle undermapper og genererer tumbnails og oversigtssider med billederne
' For complete documentation and support, please write to chtweb@cht.dk / http://cht.dk
'*******************************************************************************
' Vær opmærksom på at ved kørsel af dette script vil filer med navnet images.html i mapper med billeder blive slettet!
' ligeledes vil filen oversigt.html blive slettet, hvis der findes en sådan i samme mappe som denne fil!
'*******************************************************************************
' Installation instructions.
' For complete documentation and support, please write to lasse@303.dk
'*******************************************************************************
'
'1. In the command prompt, run: Regsvr32 c:\winnt\system32\aeImage.dll
' or whereever you have stored the component :-)'
'
'2. Copy the Intel JPEG Library (ijl11.dll) to your System-folder
' (e.g. c:\winnt\system32\)
'
'3. Remember to set write permissions on folders you want to store images.
'
'4. GO! :)
'*******************************************************************************
'Dette script kan både køres som vbs og asp, omdøb blot filen før kørsel.
'*******************************************************************************
'==================
'Indstillinger start
'==================
generatepages = 1
generate_tumbnails = 1
overwrite_tumbnails = 0 'overskriv tumbnails, hvis de findes?
logtofile = 0
err_log_to_file = 0
ShowImageSizeOnPage = 0 'width and height
subdirsfolder = Mappath(".")
MaxSize = 180 ' Den maximale højde/brede målt i pixels på de tumbnails der genereres (de billeder der vises på oversigtssiderne).
kolonner = 4 'hvor mange kolonner skal der være på oversigtssiderne?
slideshow = 0
log_all_files_to_file = 0 '[0]
' Vælg komponent (til at finde oplysningerne om højde og bredde)
' 1 = Scripting.FileSystemObject (jpg,gif)
' 2 = ImgSize.Check (jpg,gif,bmp)
' 3 = aeImage.Canvas (jpg,gif,bmp)
komponent = 3
asp_support_ved_visning = 0
'==================
'Funktioner, script start
'==================
Dim oImg, lOldWidth, lOldHeight, lNewWidth, lNewHeight
Dim lRandom
Dim sPathIn, sPathOut
'Random value to cheat browser-cache
'Randomize
'lRandom = Int(Rnd * 1000000)
Function ResizeImg(sPathIn)
if not ComponentInstalled("aeImage.Canvas") then
if mode <> "asp" then WScript.echo("aeImage.Canvas er ikke installleret")
if mode = "asp" then response.write("aeImage.Canvas er ikke installleret")
else
'File to load
'sPathIn = Mappath("demo.jpg")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oImg = CreateObject("aeImage.Canvas")
'File to save
'sPathOut = "demo_out.jpg"
folder = left(sPathIn,InStrRev(sPathIn,"\"))
'WScript.Echo(folder)
'sPathOut = "tumbnails\pre_" & sPathIn
sPathOut = left(sPathIn,InStrRev(sPathIn,"\")) & "tumbnails\pre_" & mid(sPathIn,InStrRev(sPathIn,"\")+1)
if overwrite_tumbnails = 1 or not fso.FileExists(sPathOut) then
if not fso.FolderExists(folder&"tumbnails") then
fso.CreateFolder(folder&"tumbnails")
end if
SizeWidth = MaxSize
on error resume next
With oImg
'Load the image and get dimensions
.LoadImage(sPathIn)
lOldWidth = .Width
lOldHeight = .Height
if .Height > .Width then
SizeWidth = Int(SizeWidth*.Width/.Height)
end if
'Resize to 100px width - when a dimension (height for this one) is
'omitted, proportions will be automatically constrained.
.Resize SizeWidth
lNewWidth = .Width
lNewHeight = .Height
'Save the image (remember to set write permissions on your server)
.SaveImage(sPathOut)
'WScript.Echo(lOldWidth&" x "&lOldHeight&VbCrLf&lNewWidth&" x "&lNewHeight&VbCrLf)
End With
tmp = ErrLog(sPathIn)
if fso.FileExists(sPathOut) then
tmp = WriteResFile(now & " | " & sPathIn & " | OK",Mappath("log-done.txt"))
end if
on error goto 0
end if
Set oImg = Nothing
Set FSO = Nothing
end if
End Function
Function Mappath(value)
if mode = "asp" then
Mappath = Server.Mappath(value)
else
Mappath = left(Wscript.ScriptFullName,InstrRev(Wscript.ScriptFullName,"\")) & value
end if
End Function
Function FindMapper(startmappe)
'WScript.Echo("finder mapper: " & startMappe )
tmp = WriteRes("---start---")
'startMappe = Mappath(".")
'=========================
'Script start, find mapper og filer
'=========================
if right(startMappe,1) = "/" or right(startMappe,1) = "\" then
startMappe = left(startMappe,len(startMappe)-1)
end if
'phypath = Request.ServerVariables("APPL_PHYSICAL_PATH")
ReDim mappeArray(1)
ReDim urlArray(1)
mappeArray(0) = startMappe
urlArray(0) = startUrl
taellerTilfoej = 1
taellerOp = 0
Set fs = CreateObject("Scripting.FileSystemObject")
Do While taellerOp < UBound(mappeArray)
tempsti = mappeArray(taellerOp)
tempurl = urlArray(taellerOp)
'finder undermapper
Set f = fs.GetFolder(tempsti)
Set fc = f.SubFolders
For Each f1 in fc
'hvis kun mapper uden "underscore" eller "and tegn" som første tegn skal med
If (medUnderscore <> "ON") or (Left(f1.name,1) <> "_" and Left(f1.name,1) <> "&") Then
ReDim Preserve mappeArray(UBound(mappeArray) + 1)
ReDim Preserve urlArray(UBound(urlArray) + 1)
mappeArray(taellerTilfoej) = (tempsti & "\" & f1.name)
urlArray(taellerTilfoej) = (tempurl & "\" & f1.name)
taellerTilfoej = taellerTilfoej + 1
if log_all_files_to_file = 1 then tmp = WriteRes(tempurl & "\" & f1.name)
End If
Next
taellerOp = taellerOp + 1
Loop
if log_all_files_to_file = 1 then
'finder filer i mapperne
For tael = 0 To UBound(mappeArray)-1
set f = fs.GetFolder(mappeArray(tael))
Set fc = f.Files
For Each f1 in fc
filTaeller = filTaeller + 1
startDef = urlArray(tael)&"\"& f1.name
curfile = startMappe & urlArray(tael) & "\" & f1.name
numfiles = numfiles+1
plads = plads+f1.size
Set filepath = fs.GetFile(curfile)
if log_all_files_to_file = 1 then tmp = WriteRes(f.path&"\"&f1.name & " --- " & filetype & " --- " & images)
numupdated = numupdated+1
Next
Next
end if
filepath = Mappath("oversigt.html")
Set fs = CreateObject("Scripting.FileSystemObject")
if fs.FileExists(filepath) then
fs.DeleteFile(filepath)
end if
'find mapper med billeder
' finder filer i mapperne
For tael = 0 To UBound(mappeArray)-1
set f = fs.GetFolder(mappeArray(tael))
Set fc = f.Files
images = 0
numfiles = 0
For Each f1 in fc
filTaeller = filTaeller + 1
filetype = mid(lcase(f1.name),InstrRev(f1.name,".")+1)
if Instr("|jpg|jpeg|jpe|bmp|tif|tiff|",filetype) > 0 then
thisfolder = fs.GetFolder(mappeArray(tael))
thisfoldername = mid(thisfolder,InstrRev(thisfolder,"\")+1)
if thisfoldername <> "tumbnails" and thisfoldername <> "_vti_cnf" then
images = 1
numfiles = numfiles+1
'Dan tumbnail
if not ComponentInstalled("aeImage.Canvas") then
if mode <> "asp" then WScript.echo("aeImage.Canvas er ikke installleret")
if mode = "asp" then response.write("aeImage.Canvas er ikke installleret")
else
if generate_tumbnails = 1 then tmp = ResizeImg(thisfolder&"\"&f1.name)
end if
end if
end if
startDef = urlArray(tael)&"\"& f1.name
curfile = startMappe & urlArray(tael) & "\" & f1.name
plads = plads+f1.size
Set filepath = fs.GetFile(curfile)
numupdated = numupdated+1
Next
if images = 1 then
tmp = WriteRes(thisfolder & " --- " & images)
subfolder = mid(thisfolder,len(startMappe))
if subfolder <> "" and right(subfolder,1) <> "\" then subfolder = subfolder & "\"
tmp = WriteResFile("<a href=""" & mid(" "&replace(subfolder,"\","/"),2) & "images.html""> <" & mid(thisfolder,len(startMappe)-1) & "> </a> " & numfiles & " images<br>",Mappath("oversigt.html"))
if generatepages = 1 then tmp = GeneratePage(thisfolder)
end if
Next
End Function
Function GeneratePage(folder)
filepath = folder&"\images.html"
Set fs = CreateObject("Scripting.FileSystemObject")
if fs.FileExists(filepath) then
fs.DeleteFile(filepath)
end if
tmp = AddLine("<html>",filepath)
tmp = AddLine("<head>",filepath)
tmp = AddLine("<title>"&title&"</title>",filepath)
tmp = AddLine("<link rel=""stylesheet"" type=""text/css"" href=""style.css"">",filepath)
tmp = AddLine("<style type=""text/css"">",filepath)
tmp = AddLine("",filepath)
tmp = AddLine("BODY {",filepath)
tmp = AddLine(" font-family: Verdana,Arial;",filepath)
tmp = AddLine(" font-size : 10 pt;",filepath)
tmp = AddLine(" border: 0px solid #000000;",filepath)
tmp = AddLine(" background: transparent;",filepath)
tmp = AddLine(" background-color:#eeeeee;",filepath)
tmp = AddLine(" scrollbar-face-color: #CCCCCC;",filepath)
tmp = AddLine(" scrollbar-shadow-color: #FFFFFF;",filepath)
tmp = AddLine(" scrollbar-highlight-color: #FFFFFF;",filepath)
tmp = AddLine(" scrollbar-3dlight-color: #FFFFFF;",filepath)
tmp = AddLine(" scrollbar-darkshadow-color: #FFFFFF;",filepath)
tmp = AddLine(" scrollbar-track-color: #FFFFFF;",filepath)
tmp = AddLine(" scrollbar-arrow-color: #000000;",filepath)
tmp = AddLine("}",filepath)
tmp = AddLine("",filepath)
tmp = AddLine(".img {",filepath)
tmp = AddLine(" font-family : Verdana, Geneva, Arial, Helvetica, sans-serif;",filepath)
tmp = AddLine(" font-size : 12px;",filepath)
tmp = AddLine(" text-align : center;",filepath)
tmp = AddLine(" width : 25%;",filepath)
tmp = AddLine(" background-color : #ffffff;",filepath)
tmp = AddLine(" border-color : #cccccc;",filepath)
tmp = AddLine(" border-style : solid;",filepath)
tmp = AddLine(" border-width : 1px;",filepath)
tmp = AddLine("}",filepath)
tmp = AddLine("A {",filepath)
tmp = AddLine(" font-family: Verdana,Arial;",filepath)
tmp = AddLine(" text-decoration: none;",filepath)
tmp = AddLine(" font-size: 10pt;",filepath)
tmp = AddLine(" color: Blue;",filepath)
tmp = AddLine("}",filepath)
tmp = AddLine("",filepath)
tmp = AddLine("A:Hover {",filepath)
tmp = AddLine(" color : Red;",filepath)
tmp = AddLine(" font-family: Verdana,Arial;",filepath)
tmp = AddLine(" text-decoration: none;",filepath)
tmp = AddLine(" font-size: 10pt;",filepath)
tmp = AddLine("}",filepath)
tmp = AddLine("",filepath)
tmp = AddLine("</style>",filepath)
tmp = AddLine("</head>",filepath)
tmp = AddLine("<body>" & VbCrLf,filepath)
tmp = AddLine("<SCRIPT language=JavaScript>",filepath)
tmp = AddLine(" <!--",filepath)
tmp = AddLine(" function openpage(link){",filepath)
tmp = AddLine(" var winwidth=screen.availWidth-10;",filepath)
tmp = AddLine(" var winheight=screen.availHeight-10;",filepath)
tmp = AddLine("",filepath)
'tmp = AddLine(" UniqueWindow = window.open(link, '_blank','width='+winwidth+',height='+winheight+',directories=yes,status=yes,location=yes,menubar=yes,toolbar=yes,resizable=1,status=1,scrollbars=1,left=0,top=0');")
tmp = AddLine(" UniqueWindow = window.open(link, '_blank','fullscreen=yes','width='+winwidth+',height='+winheight+',directories=no,status=yes,location=no,menubar=no,toolbar=no,resizable=1,status=1,scrollbars=1,left=0,top=0');",filepath)
tmp = AddLine(" }",filepath)
tmp = AddLine(" // -->",filepath)
tmp = AddLine("</SCRIPT>" & VbCrLf,filepath)
Set MyDirectory = CreateObject("Scripting.FileSystemObject")
Set MyFiles = MyDirectory.GetFolder(folder)
i = 0
tmp = AddLine("<table align=center border=1 bordercolordark='#000000' bordercolor='#000000' cellpadding='4' cellspacing='4' bgcolor='#eeeeee' bordercolorlight='#000000' style='font-family: Verdana; font-size: 10 pt; color: #000000; border-style: ridge; border-width: 1; padding: 1'>",filepath)
'<table border=0 style="border: 1 solid #000000" width="100%">'
'response.write "<table border=0 align=center>"
TotalSpace = 0
x = 0
For each filefound in MyFiles.files
'if left(filefound.Name,4) = "pre_" then
filename = filefound.name
filetype = mid(lcase(filefound.Name),InstrRev(filefound.Name,".")+1)
if Instr("|jpg|jpeg|jpe|bmp|tif|tiff|",filetype) > 0 then
x = x + 1
if i = 0 then
tmp = AddLine("<tr>",filepath)
end if
i = i+1
'response.write "<td align=center><a href='" & folder & "/" & mid(filefound.Name,1) & "'><img src='" & "tumbnails\"&filename & "'></a><br>" & filename & "<br>"
'!!width=200 height=200
'!!height=100
'height=100
if slideshow = 1 then
tmp = AddLine("<td class=img>" & WordBreak(mid(filename,1),15) & "<br>" & "<a href=java script:openpage('" & URLReplace(url & "show-singleimage.asp?image=" & mid(filename,1)) & "');><img src='pre_" & Replace(("tumbnails\"&filename),"#","%23") & "' border=0" & " alt='" & mid(filename,1) & "'><br>Fit image to window</a><br><a href=java script:openpage('" & URLReplace(mid(filename,1)) & "');>View in full size</a><br>",filepath)
else
tmp = AddLine("<td class=img>" & WordBreak(mid(filename,1),15) & "<br>" & "<a href='" & URLReplace(mid(filename,1)) & "'><img src='" & Replace(("tumbnails\pre_"&filename),"#","%23") & "' border=0" & " alt='" & mid(filename,1) & "'><br>Fit image to window</a><br><a href=java script:openpage('" & URLReplace(mid(filename,1)) & "');>View in full size</a><br>",filepath)
end if
if asp_support_ved_visning = 1 then
tmp = AddLine("<a href=java script:openpage('show-singleimage.asp?image=" & filename & "');>" & filename & "</a><br>",filepath)
end if
'Show image in a Popup-window
'response.write "<td align=center><a href=java script:openWin2('show-singleimage.asp?image=" & folder & "/" & mid(filename,1) & "')><img src='" & folder&"\"&filename & "'></a><br>" & filename & "<br>" & Formatnumber(filefound.size/1024) & " KB<br>"
'height=100
ShowFileSize = FileSize(folder&"\"&filename)
tmp = AddLine(FormatNumber(ShowFileSize/1024) & " KB<br>" & ShowImageSize(folder&"\"&mid(filename,1)) & "</td>",filepath)
TotalSpace = TotalSpace+ShowFileSize
if i = kolonner then
tmp = AddLine("</tr>",filepath)
i = 0
end if
numfiles = numfiles+1
end if
'end if
Next
if i > 0 then
x = i
While x < kolonner
tmp = AddLine("<td class=img> </td>" & VbCrLf,filepath)
x = x+1
Wend
tmp = AddLine("</tr>",filepath)
end if
tmp = AddLine("</table>",filepath)
tmp = AddLine("<br>Total " & Formatnumber(TotalSpace/1024) & " KB in " & numfiles & " images.",filepath)
tmp = AddLine("<p align=""center""><a href=""http://cht.dk""><font face=""Verdana"" size=""1"" color=""#FFCC66"">Poweredby CHT.dk</font></a></p>",filepath)
tmp = AddLine("</body>",filepath)
tmp = AddLine("</html>",filepath)
End Function
Function WriteRes(content)
if showtext = 1 then
' response.write content & "<br>"
end if
if logtofile = 1 then
filepath = Mappath("file.txt")
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.OpenTextFile(filepath, 8, True, False)
a.writeline(content)
'tilføj tekst, start på ny linje
'a.writeline("Tekst")
'tilføj tekst
'a.write("Tekst")
a.close
Set a = Nothing
Set fso = Nothing
if resumeerr = 1 then
on error goto 0
end if
end if
if 1>2 then
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.OpenTextFile(filepath, 2, True)
a.Write(content)
a.Close
Set a = Nothing
Set fso = Nothing
end if
End Function
Function WriteResFile(content,filepath)
'if logtofile = 1 then
on error resume next
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.OpenTextFile(filepath, 8, True, False)
a.writeline(content)
'a.writeline(" * * * * * * * * * * * * * * * * * * * * * * * * ")
'tilføj tekst, start på ny linje
'a.writeline("Tekst")
'tilføj tekst
'a.write("Tekst")
a.close
Set a = Nothing
Set fso = Nothing
'end if
if 1>2 then
Set fso = CreateObject("Scripting.FileSystemObject")
Set a = fso.OpenTextFile(filepath, 2, True)
a.Write(content)
a.Close
Set a = Nothing
Set fso = Nothing
end if
if resumeerr = 1 then
on error goto 0
end if
End Function
Function AddLine(text,filepath)
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(filepath, 8, True, False)
a.writeline(text)
a.close
End Function
Function WordBreak(ByVal S, ByVal MaxLength)
Dim i, Ch, StartPos
For i = 1 To Len(S)
Ch = Mid(S, i, 1)
If (Ch = " ") Or (Ch = vbCr) Or (Ch = vbLf) or (Ch = vbTab) Then
StartPos = i
End If
If (i - StartPos > MaxLength) Then
S = Left(S, i - 1) & "­" & Mid(S, i)
StartPos = i
End If
Next
WordBreak = S
End Function
Function URLReplace(mytext)
URLReplace = Replace(mytext," ","%20")
URLReplace = Replace(URLReplace,"#","%23")
'URLReplace = mytext
End Function
'Function Mappath(value)
' Mappath = Replace(Replace(Server.Mappath(Replace(Replace(value, "," , "chr44"), ";" , "chr59")), "chr59" , ";"), "chr44" , ",")
'End Function
'Function URLReplace(url)
' URLReplace = Server.URLEncode(Replace(Replace(Replace(url,"&","!!26;"),"#","!!23;"),",","!!2C;"))
' 'URLReplace = url
' 'Replace(url,"#","%23")
'End Function
Function FileSize(pathname)
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(pathname) Then
' fetch Window's file information
Set f_info = fso.GetFile(pathname)
FileSize = f_info.size
'fdatecreated = f_info.datecreated
'fdatelastmodified = f_info.datelastmodified
'fsize = f_info.size
'response.write " - Date: " & FormatDateTime(fdatelastmodified,2) & " " & FormatDateTime(fdatelastmodified,3)
'response.write "<PRE>" & VBCRLF
'response.write " file size: " & FormatNumber(fsize/1024) & " characters" & VBCRLF
'response.write " file created: <B>" & FormatDateTime(fdatecreated,1) & " </B> " & FormatDateTime(fdatecreated,3) & VBCRLF
'response.write "last modified: <B>" & FormatDateTime(fdatelastmodified,1) & " </B> " & FormatDateTime(fdatelastmodified,3) & VBCRLF
'response.write "</PRE>" & VBCRLF
End If
End Function
Function ShowImageSize(sPathIn)
if ShowImageSizeOnPage = 1 then
if komponent = 1 then
Set fso = CreateObject("Scripting.FileSystemObject")
fn = (sPathIn)
'fn = Server.Mappath("billed1.jpg")
pn = fn
tstr = ""
Set f = fso.OpenTextFile(pn)
Select Case UCase(Right(fn,4))
Case ".GIF",".JPG"
If NOT f.AtEndOfStream Then
If UCase(Right(fn,4))=".GIF" Then 'always works
chars = f.read(10)
width = asc(mid(chars,8,1))*256 + asc(mid(chars,7,1))
height = asc(mid(chars,10,1))*256 + asc(mid(chars,9,1))
hw = " WIDTH=" & width & " HEIGHT=" & height
Else 'usually works
chars = f.read(200)
height = asc(mid(chars,164,1))*256 + asc(mid(chars,165,1))
width = asc(mid(chars,166,1))*256 + asc(mid(chars,167,1))
'If (height<600) and (height>3) and (WIDTH>3) and (WIDTH<600) Then
ShowImageSize = width & " x " & height
'hw = " WIDTH=" & width & " HEIGHT=" & height
'Else
' 'could be wrong height, width... forget 'em
'End If
End If
End If
End Select
f.Close
Set f = Nothing
Set fso = Nothing
elseif komponent = 2 then
set Img = CreateObject ("ImgSize.Check")
Img.FileName = (sPathIn)
if Img.Error <> "" then
ShowImageSize = "0 x 0"
'ShowImageSize = "An error occurred in processing this image.<br>"
'Response.Write "The error was: <b>" & Img.Error & "</b>"
else
'Response.Write "<p>Image <b>" & sPathIn & "</b> successfully read.<br>"
ShowImageSize = Img.Width & " x " & Img.Height
end if
set Img = nothing
else
on error resume next
Set oImg_imgsize = CreateObject("aeImage.Canvas")
With oImg_imgsize
'Load the image and get dimensions
.LoadImage (sPathIn)
lOldWidth = .Width
lOldHeight = .Height
ShowImageSize = lOldWidth & " x " & lOldHeight
End With
Set oImg_imgsize = Nothing
on error goto 0
end if
end if
End Function
Function ErrLog(logdata)
if err_log_to_file = 1 then
if err.number <> 0 then
tmp = WriteResFile(now & " " & err.number & ": " & err.description & VbCrLf & LogData & VbCrLf,Mappath("err-log.txt"))
err.clear
end if
end if
End Function
Function ComponentInstalled(CheckComponent)
On Error Resume Next
ComponentInstalled = FALSE
Err = 0
Dim TempObj
Set TempObj = CreateObject(CheckComponent)
If 0 = Err Then ComponentInstalled = TRUE
Set TempObj = Nothing
Err = 0
On Error Goto 0
End Function
'==================
'Udfør
'==================
'tmp = ResizeImg( Mappath("demo.jpg") )
'tmp = ResizeImg( "d:\Image4.jpg" )
tmp = FindMapper(Mappath("."))
if mode <> "asp" then WSCript.Echo("Script udført")
if mode = "asp" then response.write "Script udført"
'%>
