ASPImage - formatering af billede, gør billedet tomt

Bruger du ASPImage version 1.0 eller 2.x?

Prøv det her

Set Image = Server.CreateObject("AspImage.Image")
If Image.LoadImage(FileName) Then
  Response.Write "<h2>Failed loadning image file</h2>"
Else
  Response.Write "<h2>Image file loaded</h2>"
End If
Image.ImageFormat = 1
Image.FileName = FileName
If Image.SaveImage Then
  Response.Write "<h2>File saved</h2>"
Else
  Response.Write "<h2>Failed !</h2>"
End If

Tak for forslaget. Den siger konsekvent "Failed loadning image file" ved bmp og png filer, mens den skriver "Image file loaded" ved jpg og gil filer. Hvordan kan de være?

(Jeg anvender ASPImage v2)

Jeg ved ikke hvad dit problem skyldes. Men jeg er ved at tro at du bruger ASPImage v1.

Når scriptet skriver "Image file loaded" bliver billedets størrelsen så korrekt eller er det stadigvæk 0 KB?

>at du bruger ASPImage v1.
På min mit webhotels hjemmesider, står der v2.

>eller er det stadigvæk 0 KB?
Jeg kan jeg ikke svare på, fordi filen bliver gemt af flere omgange. Jeg smider lige hele koden. Fejlen opstår som sagt ved png og bmp-filer og den sker i følgende kode:

_________________________________________

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

_________________________________________

Her er hele koden - jeg forhøjer lige pointene til 100.

<%

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

'***************** UNDERFUNKTION - HENVISNING ***********************

Function henvisningDelete()

    Set myConn=Server.CreateObject("ADODB.Connection")
    myConn.Open ("PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE="+server.Mappath("/db/selvet.mdb"))
    strSQL="delete * FROM search WHERE url_link = '" & Session("henvisningLink") & "'"
    set rs = myConn.execute(strSQL)
    myConn.close
       
end function

function insertHenvisning (strNAVN)

    On error resume next
   
    Set myConn=Server.CreateObject("ADODB.Connection")
    myConn.Open ("PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE="+server.Mappath("/db/selvet.mdb"))
   
    strSQL1 = "Select Max(CInt(url_samle)) AS MyUrlSamle from Search WHERE isNumeric(url_samle)"
    set rs1 = myConn.execute(strSQL1)
    taeller = rs1("MyUrlSamle") + 1
    grafik = "<IMG SRC=" & strNAVN & " BORDER=1 width=80 height=100 ALIGN=LEFT VALIGN=TOP>"
    samle = "<A CLASS=Link2 HREF=/dbsite/default.asp?id=58&samle=" & taeller & "&type=artikel_web>"
   
    strSQL2 = "INSERT INTO search (bruger_id, email_sent, url_link, overskrift, url_title, hovedpost_samle, url_samle, artikeltype, grafik, linkType, url_hovedgruppe, url_undergruppe, url_description, datopublish, url_datoopret, url_sprog, url_prioritet, link_samle) VALUES (" & Session("ID") & ", 'false', '" & Session("henvisningLink") & "','" & Session("henvisningTitel") & "','" & Session("henvisningTitel") & "'," & taeller & ", " & taeller & ", 'artikel_web' ,'" & grafik & "','" & Session("henvisningLinkType") & "', '" & Session("henvisningHjemmesideType") & "', '" & Session("henvisningKategori") & "', '" & Session("henvisningBeskrivelse") & "', '" & Session("henvisningDatoPublikation") & "', #" & Year(date) & "-" & month(date) & "-" & Day(date) & "#, '" & Session("henvisningSprog") & "', 'aab', '" & samle & "')"
    set rs2 = myConn.execute(strSQL2)
     
    myConn.close
   
      If (myConn.Errors.Count > 0) Then
        For Each Error In myConn.Errors
              ErrorCode = vbcrlf & "Fejlnummer : " & Error.Number & vbcrlf & "Fejlbeskrivelse: " & Error.Description & vbcrlf & "Fejlkilde: " & Error.Source & vbcrlf & "Indfoedt fejl: " & Error.NativeError & vbcrlf & "SQL fejlkode: " & Error.SQLState & vbcrlf & "SQL streng: " & strSQL2
        Next
    else
        ErrorCode = "Ingen fejl"
    End If

    if not Session("henvisningHjemmesideType") = "" then
        if Session("henvisningHjemmesideType") = "hjemmesider" then
            linkTilSelvet = "Muligheden er fravalgt af brugeren."
        else
            linkTilSelvet = Session("henvisningLinkTilSelvet")
        end if
    else
          Session("henvisningHjemmesideType") = "artikler"
        linkTilSelvet = "Ikke muligt, da der ikke er tale om en hjemmeside."
    end if
   
    Set JMail          = Server.CreateObject("JMail.SMTPMail")
    JMail.ServerAddress = "websmtp.selvet.dk"
      JMail.Sender        = "admin@selvet.dk"
      JMail.Subject      = "Selvet.dk - " & Session("henvisningTitel") & " (" & Session("henvisningLinkType") & ")"
      JMail.AddRecipient       "webmaster@selvet.dk"
      JMail.AddRecipientBCC "shannon@selvet.dk"
      JMail.Priority      = 3
      JMail.AddHeader      "Originating-IP", Request.ServerVariables("REMOTE_ADDR")
      JMail.Body             = "Til Selvets redaktører/administratorer" & vbcrlf & vbcrlf & "Navn: " & Session("navn") & vbcrlf & "Email adresse: " & Session("email") & vbcrlf & "Titel: " & Session("henvisningTitel") & vbcrlf & "Kategori: " & Session("henvisningKategori") & vbcrlf & "Hjemmesidetype: " & Session("henvisningHjemmesideType") & vbcrlf & "Link til Selvet: " & linkTilSelvet & vbcrlf & "Sprog: " & Session("henvisningSprog") & vbcrlf & "Beskrivelse: " & Session("henvisningBeskrivelse") & vbcrlf & "Forside-henvisnig: " & Session("henvisningDatoPublikation") & vbcrlf & "Oprettelse: " & date() & vbcrlf & "Henvisningsnr.: " & taeller & vbcrlf & "Link: " & Session("henvisningLink") & vbcrlf & "Grafik: " & grafik & vbcrlf & "Samle: "& samle & vbcrlf & ErrorCode
      JMail.Execute
      Set JMail = Nothing
     
    countRecords()   
    Response.Cookies("accessCountdown") = "true"
    Response.Cookies("accessCountdown").expires = Date + 60
           
    response.redirect("henvisning5-1.asp")
       
end function

function countRecords()

    set myConn=Server.CreateObject("ADODB.Connection")
    Set rs = Server.CreateObject("ADODB.Recordset")
    myConn.Open ("PROVIDER=Microsoft.Jet.OLEDB.4.0;DATA SOURCE=" & server.Mappath("/db/selvet.mdb"))

    strSQL = "Select * from Search"
    rs.Open strSQL, myConn, 1, 3
    antalLinks = rs.recordcount

    myConn.close
   
    strFile=Server.MapPath("/db/links_sum.txt")
    Set objFS=Server.CreateObject("Scripting.FileSystemObject")
    Set objTextS = objFS.OpenTextFile(strFile, 2, True, 0)
    objTextS.WriteLine strSUM
    objTextS.Close
    Set objTextS = Nothing
    Set objFS = Nothing

end function

'***************** UNDERFUNKTION - FÆLLES ***********************

function sendBack (message)
   
    'Session("message") = 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

%>

Hej somaliomar

Da jeg skal bruge et hurtigt svar, bliver jeg nødt til at lukke dette spørgsmål, men da du ikke har trykket svar, kan jeg ikke give dig nogle points. Men dem kan ud altid få senere :-)

Se http://www.eksperten.dk/spm/359662