/ Forside / Teknologi / Udvikling / ASP / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
ASP
#NavnPoint
smorch 9259
Harlekin 1866
molokyle 1040
Steffanst.. 758
gandalf 657
smilly 564
gibson 560
cumano 530
MouseKeep.. 480
10  Random 410
Få jpg-description uden brug af komponent
Fra : Thomas Smedebøl


Dato : 21-08-02 22:26

Jeg har brug for at kunne få description ud ved en masse jpeg-billeder, men
ønsker ikke at bruge komponenter.

Jeg anvender følgende til at tage højde og bredde, men kan ikke regne ud
hvorledes jeg implementerer mulighed for at få beskrivelsen som er vedhæftet
hvert enkelt billede. Så vidt jeg kan regne ud må det handle om at vide hvor
informationen ligger, og hvordan den skal behandles.

På forhånd tak for hjælpen, Thomas

<%
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This routine will attempt to identify any filespec passed :::
'::: as a graphic file (regardless of the extension). This will :::
'::: work with BMP, GIF, JPG and PNG files. :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Based on ideas presented by David Crowell :::
'::: (credit where due) :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah Copyright *c* MM, Mike Shaffer blah blah :::
'::: blah blah ALL RIGHTS RESERVED WORLDWIDE blah blah :::
'::: blah blah Permission is granted to use this code blah blah :::
'::: blah blah in your projects, as long as this blah blah :::
'::: blah blah copyright notice is included blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
'::: blah blah blah blah blah blah blah blah blah blah blah blah :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This function gets a specified number of bytes from any :::
'::: file, starting at the offset (base 1) :::
'::: :::
'::: Passed: :::
'::: flnm => Filespec of file to read :::
'::: offset => Offset at which to start reading :::
'::: bytes => How many bytes to read :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: Functions to convert two bytes to a numeric value (long) :::
'::: (both little-endian and big-endian) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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


':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This function does most of the real work. It will attempt :::
'::: to read any file, regardless of the extension, and will :::
'::: identify if it is a graphical image. :::
'::: :::
'::: Passed: :::
'::: flnm => Filespec of file to read :::
'::: width => width of image :::
'::: height => height of image :::
'::: depth => color depth (in number of colors) :::
'::: strImageType=> type of image (e.g. GIF, BMP, etc.) :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
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



':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: Test Harness :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

' To test, we'll just try to show all files with a .GIF extension in the
root of C:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objF = objFSO.GetFolder("D:\Pics\Jpg\New Folder")
Set objFC = objF.Files

response.write "<table border=""0"" cellpadding=""5"">"

For Each f1 in objFC
if instr(ucase(f1.Name), ".JPG") then
response.write "<tr><td>" & f1.name & "</td><td>" & f1.DateCreated &
"</td><td>" & f1.Size & "</td><td>"

if gfxSpex(f1.Path, w, h, c, strType) = true then
response.write w & " x " & h & " " & c & " colors"
else
response.write "&nbsp;"
end if

response.write "</td></tr>"

end if

Next

response.write "</table>"

set objFC = nothing
set objF = nothing
set objFSO = nothing


%>




 
 
Thomas Smedebøl (23-08-2002)
Kommentar
Fra : Thomas Smedebøl


Dato : 23-08-02 16:36

Hæ - det var nok for hårdt for jer alligevel hva'! Nogen der har et
forslag til hvor jeg kan stille spørgsmålet og forvente at få et brugbart
svar?

Mvh Thomas



Søg
Reklame
Statistik
Spørgsmål : 177554
Tips : 31968
Nyheder : 719565
Indlæg : 6408852
Brugere : 218888

Månedens bedste
Årets bedste
Sidste års bedste