Autor Thema: Bildimport scheitert an manchen JPG Dateien  (Gelesen 5688 mal)

Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Bildimport scheitert an manchen JPG Dateien
« am: 24.08.04 - 16:10:56 »
Hi
Hab dieses Bild Import Script das hier im Forum so rumlungert mal eingebaut. Es funktioniert im großen und ganzen auch. Nur bei JPG Dateien von manchen Digitalkameras gibts einen Fehler. Wenn ich diese JPG Dateien dann in paint öffne und nochmals als JPG abspeichere klappt es auf einmal. Woran kann das liegen. Hab die Suche schon benutzt, aber nichts gefunden. Google half auch nicht weiter

hier nochmal der Code:


Code
Sub Click(Source As Button)
   Dim session As New NotesSession
   Dim db As NotesDatabase
   Dim pdoc As NotesDocument
   Dim workspace As New NotesUIWorkspace
   Dim uidoc As NotesUIDocument
   Dim doc As NotesDocument
   Dim rtitem As NotesRichTextItem
   Dim object As NotesEmbeddedObject
   Dim Filename As String
   Dim fileth As String
   Dim ImageType As String
   Dim ImageHeight As String
   Dim ImageWidth As String
   Dim ImageDepth As String
   Dim kategorie As String
   Dim auswahl(3) As Variant
   Dim kategorie2 As String
   Dim album As String
   Dim albumname As String
   Dim anzahlok As String
   Dim anzahlerr As String
   Dim dateierr As Variant
   Dim maxhoehe As String
   Dim maxbreite As String
   Dim ausgabe As String
   
   
   On Error Goto ErrorHandling
   
   Set db = session.CurrentDatabase
   Set pdoc = db.GetProfileDocument("einstellungen")
   maxhoehe = pdoc.getitemvalue("einst_maxhoehe")(0)
   maxbreite = pdoc.getitemvalue("einst_maxbreite")(0)
   anzahlok = 0
   anzahlerr = 0
   
   
   files = workspace.OpenFileDialog(True, "File List", "Supported Images|*.jpg;*.gif", "C:\")
   If Isempty(files) Then Exit Sub      ' Exit if the user selects the Cancel button
   
   kategorie = Inputbox("In welcher Galerie sollen die Bilder angelegt werden","Album benennen","")
   
   Forall FileList In files                ' Loop through the list of files selected
      Filename = Filelist            ' Get the current filename
      
      
      ' GetImageProperties returns an array of ImageType, height, width and bit-depth
      imgProps = GetImageProperties(Filename)
      ImageType = imgProps(0)      
      ImageHeight = imgProps(1)   ' Get the image height
      ImageWidth = imgProps(2)   ' Get the image width
      ImageDepth = imgProps(3)   ' Get the image bit-depth
      
      
      'Prüfen ob die maximale Höhe und Breite eingehalten wird
      If ImageHeight > maxhoehe Or ImageWidth > maxbreite Then
         dateierr = dateierr + Filename + Chr(10)
         anzahlerr = anzahlerr+1
      Else
         
         
      ' Now, we will create a new document and attach the selected image to it.
         Set doc = New NotesDocument( db )               ' Create a new Notes Doc
         Set rtitem = New NotesRichTextItem( doc, "Image" )   ' Create a new richtext item
         Set object = rtitem.EmbedObject    ( EMBED_ATTACHMENT, "", filename) ' Attach the file to it
         
         Print "Bild " & Filename & "wird importiert"
         
         doc.Form = "bilder"               ' Set the form name
         doc.kategorie = kategorie
         
         doc.HEIGHT = Cint(ImageHeight)         ' Write the height
         doc.Width = Cint(ImageWidth)         ' Write the width
         doc.colordepth = Cint(ImageDepth)      ' Write the colour depth
         doc.filesize = Filelen(filename)         ' Write the filename
         anzahlok = anzahlok + 1
         Call doc.Save( True, True )            ' Save the backend document
         
         Set uidoc = workspace.EditDocument( True, doc )   ' Open the backend doc in the UI
         Call uidoc.GotoField( "ImageView" )                  ' Make the ImageView field the focus
         
         Select Case Imagetype                           ' Select which image type this file is
         Case "GIF":
            Call uidoc.Import("GIF Image",filename)            ' Import the GIF image into the field
            Call uidoc.fieldsettext("ImageType", "GIF Image")   ' Set the Image type field
         Case "JPEG":
            Call uidoc.Import("JPEG Image",filename)         ' Import the JPEG image into the field
            Call uidoc.fieldsettext("ImageType", "JPEG Image")   ' Set the Image type field
         End Select
         
         
         Call uidoc.FieldSetText("Filename", filename)   ' Set the filename field
         
         uidoc.save               ' Save the UI Doc
         Call uidoc.close(True)         ' Close the UI Doc   
      End If
      
   End Forall         ' loop through any of the remaining files
   
   
   
   
   If dateierr = "" Then
      ausgabe = ""
   Else
      ausgabe = Chr(10) & "Die folgenden Dateien sind größer als die zulässigen Maße (" & maxbreite & "x" & maxhoehe & ") und konnten deshalb nicht importiert werden: " & Chr(10) & Chr(10) & dateierr
   End If
   
   Messagebox "Importierte Dateien: " & anzahlok & Chr(10) & "Nicht Importierte Dateien: " & anzahlerr &_
   Chr(10) & ausgabe , 64, "Importieren abgeschlossen"
   
   Exit Sub
ErrorHandling:
   Messagebox "Es ist folgender Fehler aufgetreten: " & Str(Err) & " in Zeile " & Cstr(Erl) & ": " & Error$
   Exit Sub 
End Sub

und die Biblio:

Code
Function GetImageProperties(ImageFileName As String) 
   filename = ImageFileName
   
     ' Set all properties to default values
   m_Width = 0
   m_Height = 0
   m_Depth = 0
   m_ImageType = itUNKNOWN
   
   ' 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)
   
   lpos = 0
   iFN = Freefile
   Open FileName For Binary As iFN
   idx = 0
   Do While Not Eof( iFN ) And idx < BUFFERSIZE
      bBuf(idx) = Asc(Inputb( 1 , ifn ))
      idx = idx + 1
   Loop
   Close iFn
   
   If bBuf(0) = 127 And bBuf(1) = 80 And bBuf(2) = 78 Then
      m_ImageType = itPNG         ' this is a PNG file
      ImageType = "PNG"
      Select Case bBuf(25)            ' get bit depth
      Case 0
         m_Depth = bBuf(24)         ' greyscale
      Case 2
         m_Depth = bBuf(24) * 3      ' RGB encoded
      Case 3
         m_Depth = 8               ' Palette based, 8 bpp
      Case 4
         m_Depth = bBuf(24) * 2      ' greyscale with alpha
      Case 6
         m_Depth = bBuf(24) * 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), bBuf(18))  ' get the width
         m_Height = Mult(bBuf(23), bBuf(22)) ' get the height
      End If
   End If
   
   If bBuf(0) = 71 And bBuf(1) = 73 And bBuf(2) = 70 Then    ' this is a GIF file
      m_ImageType = itGIF
      ImageType = "GIF"
      m_Width = Mult(bBuf(6), bBuf(7))      ' get the width
      m_Height = Mult(bBuf(8), bBuf(9))      ' get the height
      m_Depth = (bBuf(10) And 7) + 1         ' get bit depth
   End If
   
   If bBuf(0) = 66 And bBuf(1) = 77 Then      ' this is a BMP file
      m_ImageType = itBMP
      ImageType = "BMP"
      m_Width = Mult(bBuf(18), bBuf(19))      ' get the width
      m_Height = Mult(bBuf(22), bBuf(23))      ' get the height
      m_Depth = bBuf(28)                  ' 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
         If (bBuf(lPos) = &HFF And bBuf(lPos + 1) = &HD8 And bBuf(lPos + 2) = &HFF) _
         Or (lPos >= BUFFERSIZE - 10) Then Exit Do
                 ' move our pointer up
         lPos = lPos + 1   
      Loop
      
      lPos = lPos + 2
      If lPos >= 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
            If bBuf(lPos) = &HFF And bBuf(lPos + 1) _
            <> &HFF Then Exit Do
            lPos = lPos + 1
            If (lPos >= BUFFERSIZE - 10) Then Exit Function
         Loop
                  ' move pointer up
         lPos = lPos + 1
         
         Select Case bBuf(lPos)
         Case &HC0 To &HC3, &HC5 To &HC7, &HC9 To &HCB, &HCD To &HCF
                     ' we found the right block
            Exit Do
         End Select
         
         lPos = lPos + Mult(bBuf(lPos + 2), bBuf(lPos + 1))     ' otherwise keep looking
         If lPos >= BUFFERSIZE - 10 Then Exit Function       'check for end of buffer
      Loop
      
          ' If we've gotten this far it is a JPEG and we are ready to grab the information.
      m_ImageType = itJPEG
      ImageType = "JPEG"
      m_Height = Mult(bBuf(lPos + 5), bBuf(lPos + 4))   ' get the height
      m_Width = Mult(bBuf(lPos + 7), bBuf(lPos + 6))   ' get the width
      m_Depth = bBuf(lPos + 8) * 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

Fehlermeldung die bei manchen JPG kommt ist:

Fehler 183 in Line 50 Variant does not Contain a Variant

Das wäre diese Zeile:

If bBuf(0) = 71 And bBuf(1) = 73 And bBuf(2) = 70 Then    ' this is a GIF file


Hat jemand ne Ahnung warum es manchmal geht und manchmal nicht?

Offline Semeaphoros

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.152
  • Geschlecht: Männlich
  • ho semeaphoros - agr.: der Notesträger
    • LIGONET GmbH
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #1 am: 24.08.04 - 16:14:13 »
Hast Du schon mit dem Debugger geschaut, obs wirklich die Zeile ist? Wahrscheinlich nämlich nicht, die Zeilenzählung ist manchmal etwas anders, als wirs erwarten. Und dann lässt sich auch gleich überprüfen, welche Variable da leer ist.
Jens-B. Augustiny

Beratung und Unterstützung für Notes und Domino Infrastruktur und Anwendungen

Homepage: http://www.ligonet.ch

IBM Certified Advanced Application Developer - Lotus Notes and Domino 7 und 6
IBM Certified Advanced System Administrator - Lotus Notes and Domino 7 und 6

Driri

  • Gast
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #2 am: 24.08.04 - 16:52:30 »
Es gibt verschiedene JPEG-Formate, könnte also gut sein, daß bei den Problemfällen das JPEG nicht als solches erkannt wird.
Das wird eigentlich durch deine Aussage mit dem Neuspeichern in Paint bestätigt. Beim Speichern wird dann ein "Notes-konformes" JPEG erzeugt.

Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #3 am: 24.08.04 - 17:10:23 »
hab mal den Debugger durchlaufen lassen

aber viel Erfolg hatte ich nicht. In Der Biblio wird ewig die Loop Schleife durchlaufen. Hab es dann nach 1000 mal klicken übersprungen. Dann springt der Debugger zurück zum Normalen Script und nach der Zeile:

ImageType = imgProps(0)  

springt er dann zum Fehlercode

Offline koehlerbv

  • Moderator
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 20.460
  • Geschlecht: Männlich
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #4 am: 24.08.04 - 17:13:40 »
Das bestätigt dann Driris Aussage - die ImageProps entsprechen bei den betreffenden "JPEGs" nicht dem erwarteten Standard.

Bernhard

Offline Semeaphoros

  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 8.152
  • Geschlecht: Männlich
  • ho semeaphoros - agr.: der Notesträger
    • LIGONET GmbH
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #5 am: 24.08.04 - 17:17:09 »
Kommentiere mal diese Zeile aus:

On Error Goto ErrorHandling


Und dann lass es noch einmal im Debugger laufen, nicht Single Step, Du kannst ruhig "Continue" machen. Der Debugger wird Dir dann a) die original-Fehlermeldung bringen und b) auf der Problemzeile (nach seiner Meinung) stehen bleiben.
Jens-B. Augustiny

Beratung und Unterstützung für Notes und Domino Infrastruktur und Anwendungen

Homepage: http://www.ligonet.ch

IBM Certified Advanced Application Developer - Lotus Notes and Domino 7 und 6
IBM Certified Advanced System Administrator - Lotus Notes and Domino 7 und 6

Offline TMC

  • Freund des Hauses!
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 3.660
  • Geschlecht: Männlich
  • meden agan
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #6 am: 24.08.04 - 19:57:03 »
Was ich jetzt beim überfliegen nicht gesehen habe:

Hast Du mal manuell versucht, so ein "problematisches" JPEG-Bild über File / Import in ein Richtextfeld zu setzen? Klappt das da?

Denn dann könnte man es schön eingrenzen, und braucht sich nicht mit dem Code auseinandersetzen, wenn es so auf die manuelle Art auch nicht geht  ;)
Matthias

A good programmer is someone who looks both ways before crossing a one-way street.


Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #7 am: 31.08.04 - 10:56:53 »
Sorry, war ein paar Tage unterwegs.

ok, das mit dem Bild-Import auf manuellem Weg habe ich probiert. Das klappt mit diesen Bildern.

Die Fehlerzeile habe ich rausgenommen. Bleibt an der selben Stelle stehen wie vorher. Da wo er den ImageType definiert....

Weiß jemand weiter? Das ganze muß an der Script Biblio liegen, da drin komm ich aber nicht weiter. Da habe ich zu wenig Wissen
« Letzte Änderung: 31.08.04 - 11:06:42 von 2nd-Dimension »

klaussal

  • Gast
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #8 am: 31.08.04 - 11:14:39 »
.. es ist tatsächlich so, dass JPEG nicht gleich JPEG ist. Hab das gleiche Problem mit meiner Digi-Camera.

Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #9 am: 31.08.04 - 11:19:12 »
ja, ganz genau. Dort gibt es anscheinend schöne Unterschiede. Hab von einer Firmen Feier Bilder von 3 verschiedenen Digi Cameras.

Die Bilder von der einen Digital Camera sind die, wo dieses Problem verursachen. Die Bilder von den anderen 2 gehen alle wunderbar. ???

Offline Tode

  • Moderatoren
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 6.885
  • Geschlecht: Männlich
  • Geht nicht, gibt's (fast) nicht... *g*
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #10 am: 31.08.04 - 12:19:14 »
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...

« Letzte Änderung: 31.08.04 - 12:25:18 von Tode »
Gruss
Torsten (Tode)

P.S.: Da mein Nickname immer mal wieder für Verwirrung sorgt: Tode hat NICHTS mit Tod zu tun. So klingt es einfach, wenn ein 2- Jähriger versucht "Torsten" zu sagen... das klingt dann so: "Tooode" (langes O, das r, s und n werden verschluckt, das t wird zum badischen d)

Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #11 am: 31.08.04 - 15:26:37 »
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

Offline Tode

  • Moderatoren
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 6.885
  • Geschlecht: Männlich
  • Geht nicht, gibt's (fast) nicht... *g*
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #12 am: 31.08.04 - 18:16:05 »
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
Gruss
Torsten (Tode)

P.S.: Da mein Nickname immer mal wieder für Verwirrung sorgt: Tode hat NICHTS mit Tod zu tun. So klingt es einfach, wenn ein 2- Jähriger versucht "Torsten" zu sagen... das klingt dann so: "Tooode" (langes O, das r, s und n werden verschluckt, das t wird zum badischen d)

Offline Tode

  • Moderatoren
  • Gold Platin u.s.w. member:)
  • *****
  • Beiträge: 6.885
  • Geschlecht: Männlich
  • Geht nicht, gibt's (fast) nicht... *g*
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #13 am: 31.08.04 - 19:15:52 »
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
Gruss
Torsten (Tode)

P.S.: Da mein Nickname immer mal wieder für Verwirrung sorgt: Tode hat NICHTS mit Tod zu tun. So klingt es einfach, wenn ein 2- Jähriger versucht "Torsten" zu sagen... das klingt dann so: "Tooode" (langes O, das r, s und n werden verschluckt, das t wird zum badischen d)

Offline 2nd-Dimension

  • Junior Mitglied
  • **
  • Beiträge: 51
  • Noch wahnsinnig werd...
    • 2nd-Dimension
Re:Bildimport scheitert an manchen JPG Dateien
« Antwort #14 am: 01.09.04 - 11:53:42 »
HAMMER !!!

scheint zu funktionieren. Also mir haste auf jedenfall geholfen und andere können sowas mit Sicherheit auch gebrauchen. Echt Super!! :)

 

Impressum Atnotes.de  -  Powered by Syslords Solutions  -  Datenschutz