Problemer med at uploade png og bmp filer
Hej(Jeg anvender ASPImage v2)
Hver gang jeg uploader et bmp eller png-billede, så siger den: "Filen kunne ikke indlæses - prøv med en anden fil"
Ved linien:
Set Image = Server.CreateObject("AspImage.Image")
if not Image.LoadImage(FileName) then
SendBack("Filen kunne ikke indlæses - prøv med en anden fil")
end if
Hvis jeg uploader jpg eller gif, er der ingen problemer.
Please hjælp! :-)
_________________________________________
<%
Server.ScriptTimeout = 10000000
if Request.ServerVariables("REQUEST_METHOD") = "POST" then
Set Upload = Server.CreateObject("Persits.Upload.1")
Upload.SetMaxSize 10000000, True
Upload.OverwriteFiles = false
On Error Resume Next
count = Upload.Save
If Err.Number = 8 Then
sendBack("Billedet må ikke være større end 10 MB.")
end if
if count > 0 then
if not Upload.Form("billedKategori") = "" then
strImageDir="/grafik/henvisning/" & Upload.Form("billedKategori") & "/"
else
'skal bruges hvis der vælges fra billed-arkivet
strImageDir="/grafik/henvisning/"
end if
For Each File in Upload.Files
if File.ImageType = "JPG" or File.ImageType = "BMP" or File.ImageType = "PNG" or File.ImageType = "TGA" or File.ImageType = "PCX" then
FileName = strImageDir & replace(File.FileName, File.Ext, "")
FileName = lcase(Server.MapPath(FileName) & ".jpg")
'bliver senere formateret til jpg
else
if File.ImageType = "GIF" or File.ImageType = "WBMP" then
FileName = strImageDir & replace(File.FileName, File.Ext, "")
FileName = lcase(Server.MapPath(FileName) & File.ImageType)
else
sendBack("Billedformatet i filen" & File.OriginalFileName & " kunne ikke genkendes. Prøv med et andet billede.")
end if
end if
File.SaveAs(FileName)
'Genfind filen - det kan jo være at den har fået indsat (1)
FileName = resizeAndSave(Server.MapPath(strImageDir & File.fileName))
Next
end if
if action = "henvisning" then
Session("henvisningLink2") = Upload.Form("link2")
Session("henvisningTitel") = Upload.Form("titel")
Session("henvisningKategori") = Upload.Form("kategori")
Session("henvisningSprog") = Upload.Form("sprog")
Session("henvisningBeskrivelse") = Upload.Form("beskrivelse")
Session("henvisningDatoPublikation") = Upload.Form("datoPublikation")
'nyt billede
if Session("henvisningLink2") = "" then
If ifFileExistsClient(Server.MapPath(FileNameNewPic)) then
henvisningDelete()
FileNameRelativ = replace(FileName, "d:\home\selvetdk\www", "")
insertHenvisning (FileNameRelativ)
End if
End if
'billed-arkiv
if not Session("henvisningLink2") = "" then
FileNameBilledArkiv = strImageDir & Session("henvisningLink2")
if ifFileExistsServer (Server.MapPath(FileNameBilledArkiv)) then
henvisningDelete()
insertHenvisning (FileNameBilledArkiv)
end if
end if
end if
end if
'***************** UNDERFUNKTION - BILLED-ARKIV ***********************
function resizeAndSave(FileName)
'definer max-størrelse - skal bruges senere
'maxsize = 10000
'******************************
maxsize = 100000000
If inStr(findFileName(FileName), ".jpg") then
Set Image = Server.CreateObject("AspImage.Image")
if not Image.LoadImage(FileName) then
SendBack("Filen kunne ikke indlæses - prøv med en anden fil")
end if
Image.FileName = (FileName)
Image.ImageFormat = 1
Image.resizeR 80, 100
if not Image.SaveImage then
SendBack("Filen kunne ikke komprimeres - prøv med en anden fil")
end if
'genfind billede
Set FS = CreateObject("Scripting.FileSystemObject")
Set NewFile = FS.GetFile(FileName)
'her starter jpg-komprimeringen
Set Image = Server.CreateObject("AspImage.Image")
'skal den ikke fjernes?
Image.LoadImage(FileName)
if newfile.size > maxsize then
do until clng(newfile.size) < clng(maxsize) or Image.JPEGQuality < 10
Response.write "<br>komprimerer"
Image.LoadImage(FileName)
Image.FileName = (FileName)
Image.JPEGQuality = Image.JPEGQuality - 5
Image.SaveImage
'genfind billede
Set newfile = FS.GetFile(FileName)
loop
if Image.JPEGQuality = 5 then
picSize = getPicSize (FileName)
picSizeInKB = returnInKB(picSize)
'filsletning skal ske efter at filstørrelsen er fundet, ellers opstår der fejl
fileDelete(FileName)
sendBack("Billdet " & File.OriginalFileName & " fylder mere end 10KB - faktisk fylder det " & picSizeInKB & " KB. Prøv med et andet billede, som fylder mindre.")
end if
end if
else
picSize = getPicSize (FileName)
if picSize > maxsize then
picSizeInKB = returnInKB(picSize)
fileDelete(FileName)
sendBack("Billedet " & File.OriginalFileName & " fylder mere end 10KB - faktisk fylder det " & picSizeInKB & " KB. Hvis du vil anvende netop dette billede, kan du gøre følgende: 1) I et grafikprogram gemmer du blot filen i JPG-formatet (frem for i det allerede anvendte format). 2) Derefter indsender du filen - i dets nye format - igen. 3) Det løser problemet, da systemet automatisk komprimerer JPG-filer ned til den ønskede størrelse (hvilket det ikke kan med den anvendte format).")
end if
end if
newPicStr = FileName
newPicSize = getPicSize (newPicStr)
if inStr(1, FileName, "(") > 0 And inStr(1,FileName, ")") > 0 then
oldPicStr = replace(FileName, "(1)", "")
oldPicSize = getPicSize (oldPicStr)
if newPicSize > oldPicSize then
sizeValue = newPicSize - oldPicSize
else
sizeValue = oldPicSize - newPicSize
end if
if sizeValue < 1500 then
fileDelete(newPicStr)
resizeAndSave = oldPicStr
if sizeValue = "0" then
response.write File.OriginalFileName & " - filen er ikke blevet uploadet, da præcis den samme fil allerede findes på serveren<br><br>"
else
response.write File.OriginalFileName & " - filen er ikke blevet uploadet, da filen øjensynligt allerede findes på serveren - med filnavnet " & findFileName(oldPicStr) & "<br><br>"
end if
else
sendBack("Der findes et andet indsendt billede, som har det samme filnavn. Omdøb derfor billedet " & File.OriginalFileName & " til et unikt navn og prøv igen. Omdøbningen skal findes sted på din computer.")
end if
else
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(server.mappath("/grafik/henvisning/" & Upload.Form("billedKategori") & "/"))
Set fc = f.Files
For Each billed in fc
'vil det stadig virke, hvis man fjerne /grafik/henvisning/ ???
oldPicStr = lcase(server.mappath("/grafik/henvisning/" & Upload.Form("billedKategori") & "/" & billed.name))
if not oldPicStr = newPicStr then
oldPicSize = getPicSize (oldPicStr)
if newPicSize = oldPicSize then
fileDelete(newPicStr)
response.write File.OriginalFileName & " - filen er ikke blevet uploadet, da der allerede en fil, som har den samme filstørrelse - med filnavnet " & billed.name & "<br><br>"
resizeAndSave = oldPicStr
Exit For
end if
end if
next
if resizeAndSave = "" then
response.write File.OriginalFileName & " - filen er blevet uploadet som " & File.FileName & "<br><br>"
resizeAndSave = newPicStr
end if
end if
end function
Function fileDelete(FileName)
Set fso = CreateObject("Scripting.FileSystemObject")
On error resume next
fso.DeleteFile(FileName)
Set fso = Nothing
End Function
function findFileName(streng)
s = split(lcase(streng), "\")
for i = 0 to ubound(s)
If inStr(s(i), ".") Then
findFileName = s(i)
else
findFileName = "[ukendt filnavn]"
End If
Next
end function
function getPicSize (FileName)
Dim fso, f, filespec
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(FileName)
getPicSize = f.Size
end function
function ifFileExistsClient (FileName)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(FileName)
If f.Size = 0 then
fileDelete(FileName)
sendBack("Det angivede billede på din computer blev ikke fundet.")
else
ifFileExistsClient = true
end if
end function
Function ifFileExistsServer (FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
ifFileExistsServer = true
else
sendBack("Det angivede billede på Selvet blev ikke fundet.")
end if
end function
function returnInKB (picSize)
returnInKB = Round(picSize / 1000, 0)
end function
function sendBack (message)
if action = "henvisning" then response.redirect "henvisning3-1.asp?message=" & message
if action = "billed-arkiv" then response.redirect "upload.asp?message=" & message
end function
%>
