Domino 9 und frühere Versionen > ND6: Entwicklung
Bildimport scheitert an manchen JPG Dateien
Tode:
ich habe mir den Code gerade mal angeschaut...
offensichtlich ist das ganze ein Problem von LotusScript...
ALSO:
1. Anmerkung im Code:
' Read the first 32k of the image file into a buffer
' NB - this is a LotusScript limitation and 32K may not be enough
' to read a JPEG's image data but it probably will.
Redim bBuf(BUFFERSIZE)
Das heisst: Der Code durchsucht nur die ersten 32k nach einem Kennzeichen für ein JPEG- Image...findet er dort NICHT das erwartete Kennzeichen, dann bricht er ab...
2. Ausstiegs- Klausel aus der Function
Die einzige Stelle, an der die Funktion aussteigt, OHNE einen Wert zurückzuliefern ist diese Zeile:
If lPos >= BUFFERSIZE - 10 Then Exit Function
in diesem Fall ist das zurückgelieferte Array leer, und alle Versuche auf eines der Elemente zuzugreifen enden mit dem von Dir beschriebenen Fehler.
LÖSUNG:
Laut diesem Code enthält JEDES JPG- Image die folgende Zeichenkette (im Hex- Code):
FF D8 FF
(ich habe das mal überprüft: offensichtlich ist das tatsächlich der Standard für JPG- Dateien: ALLE sollten auf den ersten 3 Bytes diese Zeichen haben...)
Deine fraglichen Bilder haben diese Zeichen NICHT, oder aber sie haben die Zeichenkette ausserhalb der ersten 32k Daten (lässt sich über einen Hex- Editor klären)..
In dem Fall muss das Script so angepasst werden, dass es nach einem anderen "Merkmal" für diese speziellen JPEGs sucht...
Das ist ein ziemlicher Aufwand:
JPEGs mit Hex- Editor öffnen.
Prüfen, welches Merkmal alle gemeinsam haben...
Prüfen, wo in diesen Speziellen JPEGS die gewünschten Infos stehen (breite, höhe, Farbtiefe)
Diese Merkmale zusammenfassen und den Code erweitern...
Gegebenenfalls herausfinden, wie man auf Infos jenseits der ersten 32k innerhalb Script zugreift...
Vielleicht findet sich ja jemand hier im Forum, der Dir die Arbeit abnimmt (mich würde es durchaus reizen, aber ich bin im moment so eingespannt... ), wenn DU zwei oder drei der "Fehlerhaften" jpegs (mit unverfänglichem Inhalt) hier postest...
Gruß
Tode
P.S.: Die Biblio ist nicht komplett, es fehlt der Declarations- Part bzw. ein zusätzliche Use- Befehl in den Options, sonst sind nämlich viele Variablen/Constanten nicht gefüllt:
BUFFERSIZE, itPNG, itUNKNOWN, etc, etc...
2nd-Dimension:
super Beitrag. ;)
ok, hier 2 kostproben:
http://www.nsr125.de/sonstiges/bild01.JPG
http://www.nsr125.de/sonstiges/bild02.JPG
Wenn du mal zeitfinden solltest und ne Lösung findest kannst du gerne bescheid sagen. Werde es zwar auch versuchen, aber denke mal da fehlt mir zu viel Know-How
Tode:
Zwischenbericht:
ich hatte noch einen Exit function weiter unten übersehen, derdafür sorgt, dass das array nicht gefüllt wird...
Das ganze hängt tatsächlich damit zusammen, dass die Position, an der die Informationen in Deinen Jpgs stehen > 32k ist, und damit über den Buffer rausläuft.
Man muss also den buffer erhöhen, am besten wird es sein, über eine Mehrdimensionale Variable zu gehen, weil dann können wir 32k x 32k abarbeiten....
ich muss dazu allerdings den Code etwas anpassen, um korrekt in einem mehrdimensionalen Array arbeiten zu können...
Vielleicht komme ich heute noch dazu, ansonsten mache ich es morgen... das Ding hat mich gepackt: jetzt will ich es lösen...
Gruß
Tode
Tode:
So, habs noch hinbekommen:
Dieses Script läuft jetzt zwar minimal langsamer (weil es das komplette Bild und nicht nur die ersten 32 k einliest),
aber dafür kann es auch bei den hier angehängten Dateien die Info auslesen.
Das schafft es, indem es das bild über ein Array verteilt...
Hier also der Quellcode:
Function GetImageProperties(ImageFileName As String)
Dim filename As String
Dim idx As Integer, idy As Integer
Dim xPos As Integer, yPos As Integer
Dim xPos2 As Integer, yPos2 As Integer
filename = ImageFileName
' Set all properties to default values
m_Width = 0
m_Height = 0
m_Depth = 0
m_ImageType = itUNKNOWN
' Read 32k of the image file into a buffer
' NB - this is a LotusScript limitation and 32K may not be enough
' to read a JPEG's image data but it probably will.
' Erweiterung: Ab sofort werden JE 32k in ein Array geladen, um auch grössere JPGs bearbeiten zu können
Redim bBuf(BUFFERSIZE,0)
lpos = 0
iFN = Freefile
Open FileName For Binary As iFN
idx = 0
idy = 0
Do While Not Eof( iFN ) And idy <= BUFFERSIZE
If idx > BUFFERSIZE Then
idx = 0
idy = idy + 1
Redim Preserve bBuf( BUFFERSIZE,idy )
End If
bBuf(idx,idy) = Asc(Inputb( 1 , ifn ))
idx = idx + 1
Loop
Close iFn
If bBuf(0,0) = 127 And bBuf(1,0) = 80 And bBuf(2,0) = 78 Then
m_ImageType = itPNG ' this is a PNG file
ImageType = "PNG"
Select Case bBuf(25,0) ' get bit depth
Case 0
m_Depth = bBuf(24,0) ' greyscale
Case 2
m_Depth = bBuf(24,0) * 3 ' RGB encoded
Case 3
m_Depth = 8 ' Palette based, 8 bpp
Case 4
m_Depth = bBuf(24,0) * 2 ' greyscale with alpha
Case 6
m_Depth = bBuf(24,0) * 4 ' RGB encoded with alpha
' This value is outside of it's normal range, so we'll assume that this is not a valid file
Case Else
m_ImageType = itUNKNOWN
End Select
If m_ImageType Then ' if the image is valid then
m_Width = Mult(bBuf(19,0), bBuf(18,0)) ' get the width
m_Height = Mult(bBuf(23,0), bBuf(22,0)) ' get the height
End If
End If
If bBuf(0,0) = 71 And bBuf(1,0) = 73 And bBuf(2,0) = 70 Then ' this is a GIF file
m_ImageType = itGIF
ImageType = "GIF"
m_Width = Mult(bBuf(6,0), bBuf(7,0)) ' get the width
m_Height = Mult(bBuf(8,0), bBuf(9,0)) ' get the height
m_Depth = (bBuf(10,0) And 7) + 1 ' get bit depth
End If
If bBuf(0,0) = 66 And bBuf(1,0) = 77 Then ' this is a BMP file
m_ImageType = itBMP
ImageType = "BMP"
m_Width = Mult(bBuf(18,0), bBuf(19,0)) ' get the width
m_Height = Mult(bBuf(22,0), bBuf(23,0)) ' get the height
m_Depth = bBuf(28,0) ' get bit depth
End If
If m_ImageType = itUNKNOWN Then ' if the file is not one of the above type then check to see if it is a JPEG file
Do
' loop through looking for the byte sequence FF,D8,FF which marks the begining of a JPEG file
' lPos will be left at the postion of the start
' da diese Zeichen laut JPG- Standard IMMER an den drei ersten Stellen stehen, interessiert uns die Begrenzung hier nicht
If (bBuf(lPos,0) = &HFF And bBuf(lPos + 1,0) = &HD8 And bBuf(lPos + 2,0) = &HFF) _
Or (lPos >= BUFFERSIZE - 10) Then Exit Do
' move our pointer up
lPos = lPos + 1
Loop
lPos = lPos + 2
If lPos >= ( Cdbl( BUFFERSIZE ) * Cdbl( BUFFERSIZE ) ) - 10 Then Exit Function
Do
' loop through the markers until we find the one starting with FF,C0 which is the block containing the
' image information
Do
' loop until we find the beginning of the next marker
yPos = lPos \ BUFFERSIZE
xPos = lPos Mod BUFFERSIZE
If bBuf( xPos , yPos ) = &HFF Then
yPos = (lPos + 1) \ BUFFERSIZE
xPos = (lPos + 1) Mod BUFFERSIZE
If bBuf( xPos, yPos ) <> &HFF Then Exit Do
End If
lPos = lPos + 1
If lPos >= ( Cdbl( BUFFERSIZE ) * Cdbl( BUFFERSIZE ) ) - 10 Then Exit Function
Loop
' move pointer up
lPos = lPos + 1
yPos = lPos \ BUFFERSIZE
xPos = lPos Mod BUFFERSIZE
Select Case bBuf(xPos, yPos)
Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF
' we found the right block
Exit Do
End Select
yPos = ( lPos + 2 ) \ BUFFERSIZE
xPos = ( lPos + 2 ) Mod BUFFERSIZE
yPos2 = ( lPos + 1 ) \ BUFFERSIZE
xPos2 = ( lPos + 1 ) Mod BUFFERSIZE
lPos = lPos + Mult(bBuf(xPos, yPos), bBuf(xPos2,yPos2)) ' otherwise keep looking
If lPos >= ( Cdbl( BUFFERSIZE ) * Cdbl( BUFFERSIZE ) ) - 10 Then Exit Function
Loop
' If we've gotten this far it is a JPEG and we are ready to grab the information.
m_ImageType = itJPEG
ImageType = "JPEG"
yPos = ( lPos + 5 ) \ BUFFERSIZE
xPos = ( lPos + 5 ) Mod BUFFERSIZE
yPos2 = ( lPos + 4 ) \ BUFFERSIZE
xPos2 = ( lPos + 4 ) Mod BUFFERSIZE
m_Height = Mult(bBuf(xPos,yPos), bBuf(xPos2,yPos2)) ' get the height
yPos = ( lPos + 7 ) \ BUFFERSIZE
xPos = ( lPos + 7 ) Mod BUFFERSIZE
yPos2 = ( lPos + 6 ) \ BUFFERSIZE
xPos2 = ( lPos + 6 ) Mod BUFFERSIZE
m_Width = Mult(bBuf(xPos,yPos), bBuf(xPos2,yPos2)) ' get the width
yPos = ( lPos + 8 ) \ BUFFERSIZE
xPos = ( lPos + 8 ) Mod BUFFERSIZE
m_Depth = Mult(bBuf(xPos,yPos), bBuf(xPos2,yPos2)) * 8 ' get the color depth
End If
'GetImageProperties = ImageType+","+Cstr(m_height)+"," & Cstr(m_width)+"," & Cstr(m_depth)
ImageProps(0) = ImageType
ImageProps(1) = Cstr(m_height)
ImageProps(2) = Cstr(m_width)
ImageProps(3) = Cstr(m_depth)
getimageproperties = ImageProps
End Function
Hoffe, das hilft jemandem...
Tode
2nd-Dimension:
HAMMER !!!
scheint zu funktionieren. Also mir haste auf jedenfall geholfen und andere können sowas mit Sicherheit auch gebrauchen. Echt Super!! :)
Navigation
[0] Themen-Index
[*] Vorherige Sete
Zur normalen Ansicht wechseln