Gem fil og komprimer igen

Prøver igen :-)

function setSize(strNavn)

    Set FS = CreateObject("Scripting.FileSystemObject")
    FileName = Server.MapPath (strNavn)

    Set Image = Server.CreateObject("AspImage.Image")
    Image.LoadImage(FileName)
    'resize for at at teste om scriptet overhovedet kan komprimere
    Image.resize 500, 1000
    Image.FileName = (FileName)
    Image.SaveImage
 
    Set Image = Server.CreateObject("AspImage.Image")
    Set newfile = FS.GetFile(FileName)
    fsize = newfile.size

    If inStr(strNavn, ".jpg") or inStr(strNavn, ".jpeg") then
        do while fsize > 10000
            response.write "str = " &  fsize & "<br>"
            response.write "<br>størrelse: " & newfile.size
            Image.JPEGQuality = 80
            Image.FileName = (FileName)
            Image.SaveImage
   
            set newfile = nothing   



    nsize = fsize

    ' loop intil filstr er ændret
            do until nsize <> fsize
                doevents
        sleep 50

                set tempfile = nothing   
                Set tempfile = FS.GetFile(FileName)
                nsize =tempfile.size


        response.write "<br>Venter, så filen gemmes helt færdig inden næste komprimering..."
            loop

            Set newfile = FS.GetFile(FileName)
            fsize = newfile.size
        loop
            response.write "<br>er færdigkomprimeret " & fsize
    else
        sendBack("Billedet var for stort og kunne ikke gøres mindre, da der ikke er tale om en JPG-fil")
    end if

Set Image = nothing
         
end function

//akj

Hverken "doevents" eller "sleep 50" virker. Browseren stopper bare og kommer ikke videre ved begge linier.

Jeg kan simpelt hen ikke få det til at virke lige meget, hvad jeg gør:

str = 95061
størrelse: 95061
Tid: 02-05-2003 12:46:41
Tid(2): 02-05-2003 12:47:31
Venter, så filen gemmes helt færdig inden næste komprimering...
er færdigkomprimeret 0
____________________________________________________________________

function setSize(strNavn)

    Set FS = CreateObject("Scripting.FileSystemObject")
    FileName = Server.MapPath (strNavn)

    Set Image = Server.CreateObject("AspImage.Image")
    Image.LoadImage(FileName)
    'resize for at at teste om scriptet overhovedet kan komprimere
    Image.resize 500, 1000
    Image.FileName = (FileName)
    Image.SaveImage
 
    Set Image = Server.CreateObject("AspImage.Image")
    Set newfile = FS.GetFile(FileName)
    fsize = newfile.size

    If inStr(strNavn, ".jpg") or inStr(strNavn, ".jpeg") then
        do while fsize > 10000
            response.write "<br>str = " &  fsize
            response.write "<br>størrelse: " & newfile.size
            Image.JPEGQuality = 80
            Image.FileName = (FileName)
            Image.SaveImage
           
            set newfile = nothing   
            nsize = fsize

            ' loop intil filstr er ændret
            do until nsize <> fsize
             
                Nu = Now
                  Response.Write("<br>Tid: " & Nu)
                do while (DateDiff("s", Nu, Now) < 50)
                    ' Bliver her i 50 sek
                  loop
                  Response.Write("<br>Tid(2): " & Now & "")
               
                set tempfile = nothing   
                Set tempfile = FS.GetFile(FileName)
                nsize = tempfile.size
                response.write "<br>Venter, så filen gemmes helt færdig inden næste komprimering..."
            loop

            Set newfile = FS.GetFile(FileName)
            fsize = newfile.size
        loop
            response.write "<br>er færdigkomprimeret " & fsize
    else
        sendBack("Billedet var for stort og kunne ikke gøres mindre, da der ikke er tale om en JPG-fil")
    end if

    Set Image = nothing
         
end function

Både sleep og doevents skal være i scriptet-

Prøv evt denne komponent.
http://www.serverobjects.com/products.htm#free

Den hedder Wait For.

//akj

>Både sleep og doevents skal være i scriptet-
Men hverken sleep eller doevents virker... browseren stopper bare og der sker ikke mere... jeg har ladet den så i lang tid og den kom ikke videre.

>Prøv evt denne komponent.
Jeg her ikke egen server

Hvad skal jeg så gøre?

Jeg prøver lige at lave et helt nyt script hvis det er iorden ??

//akj

Så er der et testet script :-)

maxsize = 400000  ' angiver den maximale størrelse
step = 5  ' angiver hvor meget kvaliteten skal  køres ned med i hvert loop
          ' jo lavere værdi du angiver jo tættere kommer du på target (maxsize) men det tager også længere tid.


//akj

function setSize(strNavn)


    maxsize = 400000
    step = 5

    FileName = Server.MapPath (strNavn)

    Set FS = CreateObject("Scripting.FileSystemObject")
    Set Image = Server.CreateObject("AspImage.Image")
   
    Set newfile = FS.GetFile(FileName)

    fsize = newfile.size   

    Image.LoadImage(FileName)
    ratio = Image.JPEGQuality
   
    if fsize > maxsize then
       
        do until clng(fsize) < clng(maxsize)
       
            ratio = ratio - step
       
            Image.LoadImage(FileName)
           
            Image.JPEGQuality = ratio
           
            response.write "ny kvali: " & Image.JPEGQuality & "<br>"
           
            Image.FileName = (FileName)
            Image.SaveImage
            Set newfile = FS.GetFile(FileName)
   
            fsize = newfile.size   
            response.write "ny størrelse: " & fsize & "<br>"
   
        loop
    end if
end function

Nu virker det - mange, mange tak for hjælpen :-)

Den endelige kode blev:

function setSize(strNavn)

    Set FS = CreateObject("Scripting.FileSystemObject")
    FileName = Server.MapPath (strNavn)
    Set Image = Server.CreateObject("AspImage.Image")
    Image.LoadImage(FileName)
    Image.resize 80, 100
    Image.FileName = (FileName)
    Image.SaveImage

    'genfind billede
    Set newfile = FS.GetFile(FileName)

      'difiner max-størrelse - skal bruges senere
    maxsize = 10000
   
  'her starter jpg-komprimering 
    If inStr(findFileName(strNavn), ".jpg") or inStr(findFileName(strNavn), ".jpeg") then
   
        Set Image = Server.CreateObject("AspImage.Image")
        Image.LoadImage(FileName)
   
        if newfile.size > maxsize then
            do until clng(newfile.size) < clng(maxsize) or Image.JPEGQuality < 10   
                Image.LoadImage(FileName)
                  Image.FileName = (FileName)
                Image.JPEGQuality = Image.JPEGQuality - 5
                Image.SaveImage
               
                  'genfind billede
                Set newfile = FS.GetFile(FileName)
              loop
        end if
    end if
   
      if newfile.size > maxsize then
          fileDelete(strNAVN)
          sendBack("Billedet fylder for meget. Prøv med et andet billede, som fylder mindre.")
      end if

end function

Selvtak. Fint at du lige sender den endelige kode hvis nogen skulle få brug for det samme.

//akj

Det virker fint uden nogle former for "wait", så det er jo bare godt :-)