Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0705: Feststellen ob eine GIF-Datei ein animiertes GIF enthält

VB 5/6-Tipp 0705: Feststellen ob eine GIF-Datei ein animiertes GIF enthält

 von Frank Schüler

Schwierigkeitsgrad:

Verwendete API-Aufrufe: keine

Download: Download des Beispielprojektes [7,6 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------ Anfang Projektdatei IsAnimGIF.vbp  ------------
'--- Anfang Formular "frmIsAnimGIF" alias frmIsAnimGIF.frm  ---
' Steuerelement: Schaltfläche "cmdTest"

Option Explicit

' ------------------------------------------------------
' Funktion     : IsAnimatedGIF
' Beschreibung : Feststellen, ob es sich bei einer GIF-Datei
'                um eine animierte GIF-Datei handelt
' Übergabewert : strPath = Pfad\GIF-Datei
' Rückgabewert : True = animierte GIF-Datei
'                False = keine animierte GIF-Datei
' ------------------------------------------------------
' Autor        : Timo Kunze (TiKu)
' ------------------------------------------------------
Private Function IsAnimatedGIF(ByVal strPath As String) As Boolean

    Dim bytBlockLength As Byte
    Dim bytBlockSubType As Byte
    Dim bytBlockType As Byte
    Dim bytImageDescriptor(1 To 9) As Byte
    Dim bytLogicalScreenDescriptor(1 To 7) As Byte
    Dim bolHasGlobalColorTable As Boolean
    Dim bolHasLocalColorTable As Boolean
    Dim lngImageDescriptor As Long
    Dim lngGlobalColorTableSize As Long
    Dim lngLocalColorTableSize As Long
    Dim strSignature As String * 6
    Dim lngFNr As Long
    
    ' freie Dateinummer
    lngFNr = FreeFile
    
    ' Datei zum binären einlesen öffnen
    Open strPath For Binary Access Read Lock Write As #lngFNr
    
    ' einlesen der ersten 6 Zeichen
    Get #lngFNr, , strSignature
    
    ' ist es eine GIF-Datei
    If (strSignature = "GIF89a") Or (strSignature = "GIF87a") Then
    
        ' einlesen des LogicalScreenDescriptor-Block
        Get #lngFNr, , bytLogicalScreenDescriptor
        
        ' ermitteln, ob in der GIF die Globale Farbtabelle verwendet wird
        bolHasGlobalColorTable = bytLogicalScreenDescriptor(5) And &H80
        
        ' wenn die Globale Farbtabelle verwendet wird,
        ' dann diesen Block überspringen
        If bolHasGlobalColorTable Then
        
            ' Größe der Globale Farbtabelle berechnen
            lngGlobalColorTableSize = 3 * 2 ^ (( _
                bytLogicalScreenDescriptor(5) And &H7) + 1)
                
            ' Globale Farbtabelle überspringen
            Seek #lngFNr, Seek(lngFNr) + lngGlobalColorTableSize
                
        End If
        
        Do
        
            ' BlockType einlesen
            Get #lngFNr, , bytBlockType
            
            ' ist es ein Extension-Block
            If bytBlockType = &H21 Then
            
                ' BlockSubTyp einlesen
                Get #lngFNr, , bytBlockSubType
                
                ' Länge des Blocks einlesen
                Get #lngFNr, , bytBlockLength
                
                ' Block-Daten überspringen
                While (bytBlockLength > 0) And Not EOF(lngFNr)
                
                    Seek #lngFNr, Seek(lngFNr) + bytBlockLength

                    Get #lngFNr, , bytBlockLength
                    
                Wend
                
                ' oder ist es ein ImageDescriptor-Block
            ElseIf bytBlockType = &H2C Then
            
                ' lngImageDescriptor aufaddieren
                lngImageDescriptor = lngImageDescriptor + 1
                
                ' wenn mehr als 2 ImageDescriptor-Blocks vorhanden sind
                ' dann handelt es sich um eine animierte GIF
                If lngImageDescriptor = 2 Then
                    
                    ' Rückgabewert setzen
                    IsAnimatedGIF = True
                    
                    ' Schleife verlassen
                    Exit Do
                    
                End If
                
                ' ImageDescriptor-Block einlesen
                Get #lngFNr, , bytImageDescriptor
                
                ' ermitteln, ob in der GIF die Lokale Farbtabelle
                ' verwendet wird
                bolHasLocalColorTable = bytImageDescriptor(9) And &H80
                
                ' wenn die Lokale Farbtabelle verwendet wird,
                ' dann diesen Block überspringen
                If bolHasLocalColorTable Then
                
                    ' Größe der Lokalen Farbtabelle berechnen
                    lngLocalColorTableSize = 3 * 2 ^ (( _
                        bytImageDescriptor(9) And &H7) + 1)
                        
                    ' Lokale Farbtabelle überspringen
                    Seek #lngFNr, Seek(lngFNr) + lngLocalColorTableSize

                End If
                
                ' LZW-Codegröße überspringen
                Seek #lngFNr, Seek(lngFNr) + 1
                
                ' Größe der Imagedaten auslesen
                Get #lngFNr, , bytBlockLength
                
                ' Imagedaten überspringen
                While (bytBlockLength > 0) And Not EOF(lngFNr)
                
                    Seek #lngFNr, Seek(lngFNr) + bytBlockLength

                    Get #lngFNr, , bytBlockLength
                    
                Wend
                
                ' oder ist es der Trailer-Block
            ElseIf bytBlockType = &H3B Then
            
                ' dann Schleife verlassen
                Exit Do
                
            End If
            
            ' Schleife durchlaufen, bis das Ende der Datei erreicht ist
        Loop Until EOF(lngFNr)
        
    End If
    
    ' Datei schließen
    Close #lngFNr
    
End Function

' ------------------------------------------------------
' Funktion     : IsAnimatedGIF2
' Beschreibung : Feststellen, ob es sich bei einer GIF-Datei
'                um eine animierte GIF-Datei handelt
' Übergabewert : strPath = Pfad\GIF-Datei
' Rückgabewert : True = animierte GIF-Datei
'                False = keine animierte GIF-Datei
' ------------------------------------------------------
' Autor        : Frank Schüler
' ------------------------------------------------------
Private Function IsAnimatedGIF2(ByVal strPath As String) As Boolean

    Dim bytData() As Byte
    Dim lngFNr As Long
    Dim lngCount As Long
    Dim lngItem As Long
    Dim lngPos As Long
    Dim lngBlockCount As Long
    Dim strGifData As String
    Dim strControlBlock As String
    Dim bolRet As Boolean
    
    ' Beginn des Control-Block
    ' BlockTyp & BlockSubTyp & Blocklänge
    strControlBlock = ChrW$(33) & ChrW$(249) & ChrW$(4)
    
    ' freie Dateinummer
    lngFNr = FreeFile
    
    ' Datei komplett binär einlesen
    Open strPath For Binary Access Read Lock Write As #lngFNr
    ReDim bytData(LOF(lngFNr) - 1)
    Get #lngFNr, , bytData()
    Close #lngFNr
    
    ' bytData in einen String konvertieren
    strGifData = StrConv(bytData, vbUnicode)
    
    ' ist es eine GIF-Datei
    If Mid$(strGifData, 1, 6) = "GIF87a" Or Mid$(strGifData, 1, 6) = _
        "GIF89a" Then
        
        ' Länge des Strings
        lngCount = Len(strGifData)
        
        ' String durchsuchen
        For lngItem = 1 To lngCount
        
            ' Position des nächsten Control-Block ermitteln
            lngPos = InStr(lngItem, strGifData, strControlBlock)
            
            ' wenn ein Control-Block vorhanden ist
            If lngPos > 0 Then
            
                ' nächste Suchposition festlegen
                lngItem = lngPos + Len(strControlBlock)
                
                ' kommt nach dem Control-Block ein ImageDescriptor-Block
                ' (Beginnt mit ChrW$(44)) dann lngBlockCount aufaddieren
                If Mid$(strGifData, lngPos + Len(strControlBlock) + 5, 1) _
                    = ChrW$(44) Then lngBlockCount = lngBlockCount + 1
                    
                ' wenn mehr als 2 ImageDescriptor-Blocks vorhanden sind
                ' dann handelt es sich um eine animierte GIF
                If lngBlockCount = 2 Then
                
                    ' Rückgabewert setzen
                    bolRet = True
                    
                    ' Schleife verlassen
                    Exit For
                    
                End If
                
            Else
            
                ' kein Control-Block mehr vorhanden
                
                ' Rückgabewert setzen
                bolRet = False
                
                ' Schleife verlassen
                Exit For
                
            End If
            
            ' nächste Position
        Next lngItem
        
    Else
    
        ' keine GIF-Datei
        
        ' Rückgabewert setzen
        bolRet = False
        
    End If
    
    ' Rückgabewert an Funktion übergeben
    IsAnimatedGIF2 = bolRet
    
End Function

Private Sub cmdTest_Click()

    Dim strPath As String
    
    ' animierte GIF-Datei
    strPath = App.Path & "\test1.gif"
    
    ' keine animierte GIF-Datei
    ' strPath = App.Path & "\test2.gif"
    
    ' Test der Funktion IsAnimatedGIF
    If IsAnimatedGIF(strPath) Then
    
        MsgBox "Die Datei " & ChrW$(34) & strPath & ChrW$(34) & " ist " & _
            "eine animierte GIF-Datei.", vbOKOnly, "Funktion: " & _
            "IsAnimatedGIF"
            
    Else
    
        MsgBox "Die Datei " & ChrW$(34) & strPath & ChrW$(34) & " ist " & _
            "keine animierte GIF-Datei.", vbOKOnly, "Funktion: " & _
            "IsAnimatedGIF"
            
    End If
    
    ' Test der Funktion IsAnimatedGIF2
    If IsAnimatedGIF2(strPath) Then
    
        MsgBox "Die Datei " & ChrW$(34) & strPath & ChrW$(34) & " ist " & _
            "eine animierte GIF-Datei.", vbOKOnly, "Funktion: " & _
            "IsAnimatedGIF2"
            
    Else
    
        MsgBox "Die Datei " & ChrW$(34) & strPath & ChrW$(34) & " ist " & _
            "keine animierte GIF-Datei.", vbOKOnly, "Funktion: " & _
            "IsAnimatedGIF2"
            
    End If
    
End Sub

'--- Ende Formular "frmIsAnimGIF" alias frmIsAnimGIF.frm  ---
'------------- Ende Projektdatei IsAnimGIF.vbp  -------------