Aflæse billed-størrelser?

Det kan du ikke gøre alene med fso, du skal også bruge en billede-komponent. der kan læse i billederne, hvilken host ligger du hos

Dette projekt bor pt. hos Surftown :)

Det er kun Advanced og Pro på Win-platform, der har en billedkomponent installeret. Og det er Dimac w3Image 2.0. Du kan prøve med følgende:


Set IMA = Server.CreateObject("w3Image.Image")
Set FSO = Server.CreateObject(Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\Projects\www\w3Image\Demo\images")
Billeder = Array(2, 1)

For Each File In Folder.Files
    IMA.LoadImage "C:\Projects\www\w3Image\Demo\images\" & File.Name
    UBnd = UBound(Billeder, 2)
    Billeder(0, UBnd) = File.Name
    Billeder(1, UBnd) = IMA.width
    Billeder(2, UBnd) = IMA.height
    Redim Preserve Billeder(2, UBnd + 1)
Next

Set IMA = Nothing
Set FSO = Nothing
Set Folder = Nothing

Sæt disse funktioner ind øverst på dit dokument, eller smid det i en seperat fil og include det:

<%
function picSize(sti,billede)
   
    call gfxSpex(server.MapPath(sti & billede), X, Y, d, t)
   
    picSize = X & "," & Y
   
end function

  function gfxSpex(flnm, width, height, depth, strImageType)

    dim strPNG
    dim strGIF
    dim strBMP
    dim strType
    strType = ""
    strImageType = "(unknown)"

    gfxSpex = False

    strPNG = chr(137) & chr(80) & chr(78)
    strGIF = "GIF"
    strBMP = chr(66) & chr(77)

    strType = GetBytes(flnm, 0, 3)

    if strType = strGIF then                ' is GIF

        strImageType = "GIF"
        Width = lngConvert(GetBytes(flnm, 7, 2))
        Height = lngConvert(GetBytes(flnm, 9, 2))
        Depth = 2 ^ ((asc(GetBytes(flnm, 11, 1)) and 7) + 1)
        gfxSpex = True

    elseif left(strType, 2) = strBMP then        ' is BMP

        strImageType = "BMP"
        Width = lngConvert(GetBytes(flnm, 19, 2))
        Height = lngConvert(GetBytes(flnm, 23, 2))
        Depth = 2 ^ (asc(GetBytes(flnm, 29, 1)))
        gfxSpex = True

    elseif strType = strPNG then            ' Is PNG

        strImageType = "PNG"
        Width = lngConvert2(GetBytes(flnm, 19, 2))
        Height = lngConvert2(GetBytes(flnm, 23, 2))
        Depth = getBytes(flnm, 25, 2)

        select case asc(right(Depth,1))
          case 0
              Depth = 2 ^ (asc(left(Depth, 1)))
              gfxSpex = True
          case 2
              Depth = 2 ^ (asc(left(Depth, 1)) * 3)
              gfxSpex = True
          case 3
              Depth = 2 ^ (asc(left(Depth, 1)))  '8
              gfxSpex = True
          case 4
              Depth = 2 ^ (asc(left(Depth, 1)) * 2)
              gfxSpex = True
          case 6
              Depth = 2 ^ (asc(left(Depth, 1)) * 4)
              gfxSpex = True
          case else
              Depth = -1
        end select


    else

        strBuff = GetBytes(flnm, 0, -1)        ' Get all bytes from file
        lngSize = len(strBuff)
        flgFound = 0

        strTarget = chr(255) & chr(216) & chr(255)
        flgFound = instr(strBuff, strTarget)

        if flgFound = 0 then
          exit function
        end if

        strImageType = "JPG"
        lngPos = flgFound + 2
        ExitLoop = false

        do while ExitLoop = False and lngPos < lngSize

          do while asc(mid(strBuff, lngPos, 1)) = 255 and lngPos < lngSize
              lngPos = lngPos + 1
          loop

          if asc(mid(strBuff, lngPos, 1)) < 192 or asc(mid(strBuff, lngPos, 1)) > 195 then
              lngMarkerSize = lngConvert2(mid(strBuff, lngPos + 1, 2))
              lngPos = lngPos + lngMarkerSize  + 1
          else
              ExitLoop = True
          end if

      loop
      '
      if ExitLoop = False then

          Width = -1
          Height = -1
          Depth = -1

      else

          Height = lngConvert2(mid(strBuff, lngPos + 4, 2))
          Width = lngConvert2(mid(strBuff, lngPos + 6, 2))
          Depth = 2 ^ (asc(mid(strBuff, lngPos + 8, 1)) * 8)
          gfxSpex = True

      end if
                 
    end if

  end function
 
 
  function GetBytes(flnm, offset, bytes)

    Dim objFSO
    Dim objFTemp
    Dim objTextStream
    Dim lngSize

    on error resume next

    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    ' First, we get the filesize
    Set objFTemp = objFSO.GetFile(flnm)
    lngSize = objFTemp.Size
    set objFTemp = nothing

    fsoForReading = 1
    Set objTextStream = objFSO.OpenTextFile(flnm, fsoForReading)

    if offset > 0 then
        strBuff = objTextStream.Read(offset - 1)
    end if

    if bytes = -1 then        ' Get All!

        GetBytes = objTextStream.Read(lngSize)  'ReadAll

    else

        GetBytes = objTextStream.Read(bytes)

    end if

    objTextStream.Close
    set objTextStream = nothing
    set objFSO = nothing

  end function


  function lngConvert(strTemp)
    lngConvert = clng(asc(left(strTemp, 1)) + ((asc(right(strTemp, 1)) * 256)))
  end function

  function lngConvert2(strTemp)
    lngConvert2 = clng(asc(right(strTemp, 1)) + ((asc(left(strTemp, 1)) * 256)))
  end function
%>

...her smider jeg det i et array, og udskriver arrayet:
<%
directoryname="\billeder\"

Set fso = CreateObject("Scripting.FileSystemObject")
set mainfolder=fso.GetFolder(server.MapPath(directoryname))
Set filecollection = mainfolder.Files

Dim myArray()

i = 0

For Each file In filecollection

  billedeXY = picSize(directoryname,file.Name)
  strAry = split(billedeXY,",")

  ReDim Preserve myArray(2,i)
  myArray(0,i) = file.Name
  myArray(1,i) = strAry(0)
  myArray(2,i) = strAry(1)
   
    i = i + 1
Next

For i = 0 to UBound(myArray,2)
  Response.Write "Filnavn: " & myArray(0,i) & "<br>"
  Response.Write "Height: " & myArray(1,i) & "px<br>"
  Response.Write "Width: " & myArray(2,i) & "px<br><br>"
Next
%>

... så skulle den være i vinkel ;o)

musicchart.dk> DET lyder sgu lovende ... nu er mine billeder godt nok jpg ;-) men jeg kan eventuelt konvertere dem ... jeg prøver din løsning i løbet af torsdagen.

Hvis du har en image-komponent installeret, kan du jo ligeså godt benytte dig af den. Men det er op til dig.

netro> Der er ingen image-komponent ..

Musicchart.dk> Yes! Det virker upåklageligt! Takker .... (og glem lige min kommentar om JPG's ... scriptet håndtere selvfølgelig også JPG's. Kommentaren er skrevet alt for sent på natten ;-)

Det var så lidt :o) og tak for point

Ja, så er der ingen anden udvej end at benytte FSO.