Инструменты разработчика Access. Библиотека программ, надстроек и справочного материала

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
 
Private hLibFreeImage As Long ' Экземпляр, возвращаемый при вызове LoadLibrary
 
 
Public Function LoadLib() As Boolean
    On Error Resume Next
    Dim sMsg                  As String
 
    LoadLib = False ' Не обязательно, но давайте будем последовательны
 
    If hLibFreeImage <> 0 Then ' Проверяем, загрузили ли мы библиотеку
        hLibFreeImage = FreeLibrary(hLibFreeImage)
    End If
 
    sMsg = "Не удается найти файл FreeImage.dll" & vbCrLf & _
           "Пожалуйста, скопируйте FreeImage.Поместите файл DLL в ту же папку, " _
           & "что и эта база данных Access, или в папку Windows System32."
 
    ' Попробуйте загрузить DLL, предполагая, что она находится в той же папке, что и эта база данных..
    hLibFreeImage = LoadLibrary(Application.CurrentProject.Path & "\FreeImage.dll")
 
    If hLibFreeImage = 0 Then ' Не удалось загрузить из папки с базой данных, поэтому попробуем загрузить из папки Windows System
        hLibFreeImage = LoadLibrary("FreeImage.dll")
    End If
 
    If hLibFreeImage = 0 Then ' Ничего не загружено, у нас проблема!
        MsgBox sMsg, vbOKOnly, "FreeImage.dll не удалось загрузить!"
        LoadLib = False
        Exit Function
    End If
 
    LoadLib = True ' Если мы здесь, все прошло гладко!
End Function

Public Function FreeImage_GetExif_AllTags(sFile As String) As String
    Dim dib                   As Long
    Dim Tags()                As FREE_IMAGE_TAG
    Dim i                     As Long
    Dim j                     As Long
 
    Call LoadLib    'Load the FreeImage library
    dib = FreeImage_LoadEx(sFile)    'Load the image
 
    For j = 0 To 10    'FIMD_COMMENTS to FIMD_CUSTOM - Iterate through all the Exif data
        If (FreeImage_GetAllMetadataTags(j, dib, Tags) > 0) Then
            For i = 0 To UBound(Tags)
                With Tags(i)
                    Debug.Print j, .Id, .Key, .Description, .StringValue
                End With
            Next i
        End If
    Next j
 
    Call FreeImage_UnloadEx(dib)    'Unload the image
    If dib <> 0 Then FreeImage_Unload (dib)    'Unload the FreeImage library
End Function

Call FreeImage_GetExif_AllTags("C:\Temp\Img01.jpg")

Call LoadLib

If dib <> 0 Then FreeImage_Unload (dib)