- Katılım
- 31 Aralık 2005
- Mesajlar
- 4,284
- Excel Vers. ve Dili
- Office 2019 (64 bit) - Türkçe
Medya dosyalarını oynatabilmek için K-Lite Codec kurduysanız sistem menüsü üzerine eklenen "MediaInfo" menüsü aşağıdaki görselden de anlaşılacağı üzere tanıdık gelecektir.
Normalde Shell sınıfı pek çok bilgiyi verebiliyor; bu proje ona bir alternatiftir. Yakın bir zamanda Shell sınıfının index yoluyla alınan çözünürlük bilgisinin dosya türüne göre index numarasının kayabildiği yönünde bir mesaj gönderildi. Böyle bir durumda ekli kütüphaneyi kullanabilirsiniz.
Download (rar archive): MediaInfo_VBA (4.08MB)
MediaInfo.cls:
ExamplesModule.bas:
.
Normalde Shell sınıfı pek çok bilgiyi verebiliyor; bu proje ona bir alternatiftir. Yakın bir zamanda Shell sınıfının index yoluyla alınan çözünürlük bilgisinin dosya türüne göre index numarasının kayabildiği yönünde bir mesaj gönderildi. Böyle bir durumda ekli kütüphaneyi kullanabilirsiniz.
Download (rar archive): MediaInfo_VBA (4.08MB)
MediaInfo.cls:
C#:
Option Explicit
'************************************************************************'
'************************************************************************'
'************************************************************************'
'*** ***'
'*** Project: Media Info Class Object For VBA ***'
'*** Author : Zeki Gürsoy ***'
'*** Web : https://zekigursoy.blogspot.com ***'
'*** Mail : gursoyzeki@gmail.com ***'
'*** Date : 17.04.2024 / https://www.excel.web.tr ***'
'*** C Api : https://mediaarea.net/en/MediaInfo/Download/Windows ***'
'*** ***'
'************************************************************************'
'************************************************************************'
'************************************************************************'
#If Win64 Then
Private Declare PtrSafe Function strlen Lib "ntdll.dll" (ByVal pString As LongLong) As Long 'For ANSI
Private Declare PtrSafe Function strcpy Lib "ntdll.dll" (ByVal destStr As String, ByVal pSrcStr As LongLong) As LongLong 'For ANSI
Private Declare PtrSafe Function MediaInfoA_New Lib "MediaInfo.dll" () As LongLong
Private Declare PtrSafe Function MediaInfoA_Open Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal fileName As String) As Long
Private Declare PtrSafe Sub MediaInfoA_Close Lib "MediaInfo.dll" (ByVal hMedia As LongLong)
Private Declare PtrSafe Sub MediaInfoA_Delete Lib "MediaInfo.dll" (ByVal hMedia As LongLong)
Private Declare PtrSafe Function MediaInfoA_Option Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal strOption As String, ByVal strValue As String) As LongLong
Private Declare PtrSafe Function MediaInfoA_Inform Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal reserved As Long) As LongLong
Private Declare PtrSafe Function MediaInfoA_GetI Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal StreamKind As StreamKind, _
ByVal streamNumber As Long, ByVal Parameter As Long, Optional ByVal kindOfInfo As InfoKind = 3, _
Optional ByVal kindOfSearch As InfoKind = 0) As LongLong
Private Declare PtrSafe Function MediaInfoA_Get Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal stream_Kind As StreamKind, _
ByVal streamNumber As Long, ByVal Parameter As String, Optional ByVal kindOfInfo As InfoKind = 3, _
Optional ByVal kindOfSearch As InfoKind = 0) As LongLong
Private Declare PtrSafe Function MediaInfoA_Count_Get Lib "MediaInfo.dll" (ByVal hMedia As LongLong, ByVal stream_Kind As StreamKind, ByVal streamNumber As Long) As Long
Private m_hMedia As LongLong
#Else
Private Declare Function strlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal pString As Long) As Long 'For ANSI
Private Declare Function strcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal destStr As String, ByVal pSrcStr As Long) As Long 'For ANSI
Private Declare Function MediaInfoA_New Lib "MediaInfo.dll" () As Long
Private Declare Function MediaInfoA_Open Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal fileName As String) As Long
Private Declare Sub MediaInfoA_Close Lib "MediaInfo.dll" (ByVal hMedia As Long)
Private Declare Sub MediaInfoA_Delete Lib "MediaInfo.dll" (ByVal hMedia As Long)
Private Declare Function MediaInfoA_Option Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal strOption As String, ByVal strValue As String) As Long
Private Declare Function MediaInfoA_Inform Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal reserved As Long) As Long
Private Declare Function MediaInfoA_GetI Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal StreamKind As StreamKind, _
ByVal streamNumber As Long, ByVal Parameter As Long, Optional ByVal kindOfInfo As InfoKind = 3, _
Optional ByVal kindOfSearch As InfoKind = 0) As Long
Private Declare Function MediaInfoA_Get Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal stream_Kind As StreamKind, _
ByVal streamNumber As Long, ByVal Parameter As String, Optional ByVal kindOfInfo As InfoKind = 3, _
Optional ByVal kindOfSearch As InfoKind = 0) As Long
Private Declare Function MediaInfoA_Count_Get Lib "MediaInfo.dll" (ByVal hMedia As Long, ByVal stream_Kind As StreamKind, ByVal streamNumber As Long) As Long
Private m_hMedia As Long
#End If
Public Enum StreamKind
General = 0
Video = 1
Audio = 2
Text = 3
Other = 4
Image = 5
Menu = 6
End Enum
Public Enum InfoKind
Name = 0
Text = 1
Measure = 2
Options = 3
NameText = 4
MeasureText = 5
Info = 6
HowTo = 7
End Enum
Public Function OpenMedia(ByVal fileName As String) As Long
'Open a file and collect information about it (technical information and tags)
'
'Parameters
' File_Name: Full name of file to open
'
'Return values
' 0 File not opened
' 1 File opened
OpenMedia = MediaInfoA_Open(m_hMedia, fileName)
End Function
Public Sub CloseMedia()
If m_hMedia = 0 Then Exit Sub
MediaInfoA_Close m_hMedia
End Sub
Public Sub Dispose()
If m_hMedia = 0 Then Exit Sub
MediaInfoA_Delete m_hMedia
m_hMedia = 0
End Sub
Public Function OptionMedia(ByVal strOption As String, Optional ByVal strValue As String = "") As String
#If Win64 Then
Dim hInfo As LongLong
#Else
Dim hInfo As Long
#End If
'"0": Immediatly
'"1": After geting local information
'"2": When user interaction is needed, or whan Internet information is get
'"Complete": For debug, configure if MediaInfoLib::Inform() show all information (doesn't care of InfoOption_NoShow tag): shows all information if true,
' shows only useful for user information if false (No by default)
'"Complete_Get": return the state of "Complete"
'"Info_Parameters": Information about what are known unique names for parameters
'"Info_Parameters_CSV": Information about what are known unique names for parameters, in CSV format
'"Info_Codecs": Information about which codec is known
'"Info_Version": Information about the version of MediaInfoLib
'"Info_Url": Information about where to find the last version
'
Dim tmpStr As String
hInfo = MediaInfoA_Option(m_hMedia, strOption, strValue)
tmpStr = String$(strlen(hInfo), 0)
strcpy tmpStr, hInfo
OptionMedia = tmpStr
End Function
Public Function InForm() As String
'Get all details about a file in one string
'
'Parameters
' Reserved Reserved, do not use
'
'Precondition
' You can change default presentation with Inform_Set()
'
'Returns
' Text with information about the file
'
#If Win64 Then
Dim hInForm As LongLong
#Else
Dim hInForm As Long
#End If
Dim tmpStr As String
hInForm = MediaInfoA_Inform(m_hMedia, 0)
tmpStr = String$(strlen(hInForm), 0)
strcpy tmpStr, hInForm
InForm = tmpStr
End Function
Public Function GetByIndex(ByVal stream_Kind As StreamKind, ByVal streamNumber As Long, ByVal Parameter As Long, _
Optional ByVal kindOfInfo As InfoKind = InfoKind.Text, Optional ByVal kindOfSearch As InfoKind = InfoKind.Name) As String
'Get a piece of information about a file (parameter is a string)
'
'Parameters
' StreamKind: Kind of stream (general, video, audio...)
' StreamNumber: Stream number in Kind of stream (first, second...)
' Parameter: Parameter you are looking for in the stream (Codec, width, bitrate...), in integer format (first parameter, second parameter...)
' This integer is arbitarily assigned by the library, so its consistency should not be relied on, but is useful when looping through
' all the parameters
' InfoKind: Kind of information you want about the parameter (the text, the measure, the help...)
' SearchKind: Where to look for the parameter
'
'Returns
' a string about information you search
' an empty string if there is a problem
'
#If Win64 Then
Dim hInfo As LongLong
#Else
Dim hInfo As Long
#End If
Dim tmpStr As String
hInfo = MediaInfoA_GetI(m_hMedia, stream_Kind, streamNumber, Parameter, kindOfInfo, kindOfSearch)
tmpStr = String$(strlen(hInfo), 0)
strcpy tmpStr, hInfo
GetByIndex = tmpStr
End Function
Public Function GetByName(ByVal stream_Kind As StreamKind, ByVal streamNumber As Long, ByVal Parameter As String, _
Optional ByVal kindOfInfo As InfoKind = InfoKind.Text, Optional ByVal kindOfSearch As InfoKind = InfoKind.Name) As String
'Get a piece of information about a file (parameter is a string)
'
'Parameters
' StreamKind: Kind of stream (general, video, audio...)
' StreamNumber: Stream number in Kind of stream (first, second...)
' Parameter: Parameter you are looking for in the stream (Codec, width, bitrate...), in string format ("Codec", "Width"...)
' See MediaInfo: Option("Info_Parameters") to have the full list
' InfoKind: Kind of information you want about the parameter (the text, the measure, the help...)
' SearchKind: Where to look for the parameter
'
'Returns
' a string about information you search
' an empty string if there is a problem
#If Win64 Then
Dim hInfo As LongLong
#Else
Dim hInfo As Long
#End If
Dim tmpStr As String
hInfo = MediaInfoA_Get(m_hMedia, stream_Kind, streamNumber, Parameter, kindOfInfo, kindOfSearch)
tmpStr = String$(strlen(hInfo), 0)
strcpy tmpStr, hInfo
GetByName = tmpStr
End Function
Public Function Count_Get(ByVal stream_Kind As StreamKind, Optional ByVal streamNumber As Long = -1) As Long
'Count of streams of a stream kind (StreamNumber not filled), or count of piece of information in this stream.
'
'Parameters
' StreamKind: Kind of stream (general, video, audio...)
' StreamNumber: Stream number in this kind of stream (first, second...)
'
'Returns
' The count of fields for this stream kind / stream number if stream number is provided, else the count of streams for this stream kind
'
If m_hMedia = 0 Then Exit Function
Count_Get = MediaInfoA_Count_Get(m_hMedia, stream_Kind, streamNumber)
End Function
Private Sub Class_Initialize()
m_hMedia = MediaInfoA_New
End Sub
Private Sub Class_Terminate()
Me.Dispose
End SubExamplesModule.bas:
C#:
Option Explicit
'
Private Function FilePickerSingle() As String
' Zeki Gürsoy - 24.04.2024
' Ref: https://learn.microsoft.com/en-us/office/vba/api/excel.application.getopenfilename
'
Dim fd As Variant, sFilter As String, sTitle As String, bMultiSelect As Boolean, defautFilterIndex As Integer, vFile
bMultiSelect = False
sTitle = "::.. MediaInfo - Select a file ..::"
sFilter = "Audio files (*.wav;*.mp3), *.wav;*.mp3"
sFilter = sFilter & "," & "Video files (*.avi;*.mpg;*.mpeg;*.ts;*.mkv;*.mp4), *.avi;*.mpg;*.ts;*.mkv;*.mp4"
sFilter = sFilter & "," & "All files (*.*), *.*"
defautFilterIndex = 2
fd = Application.GetOpenFilename(sFilter, defautFilterIndex, sTitle, "This param for Mac", bMultiSelect)
'Returns Boolean/False if user press cancel button. If user select one or more files and when the bMultiSelect
'variable is True, returns file fullpaths as an array. Otherwise returns single file fullpath.
If VarType(fd) = vbBoolean Then Exit Function
FilePickerSingle = fd
End Function
Sub All_Of_Info_To_One_String()
Dim c As New MediaInfo, dlg As Variant
dlg = FilePickerSingle
If dlg = "" Then Exit Sub
c.OpenMedia dlg
'Syntax: First parameter must 'InForm';
'As you see returned string is fixed length per line. You can get/read all properties with line by line.
c.OptionMedia "Inform"
Debug.Print c.InForm
c.CloseMedia
c.Dispose
End Sub
Sub With_Parameter_Formatted_String()
Dim c As New MediaInfo, dlg As Variant
dlg = FilePickerSingle
If dlg = "" Then Exit Sub
c.OpenMedia dlg
'Note: The name of parameters (Width and Height) are CASE SENSITIVE !!!
' This is like 'C' notation or system variable.
'Syntax: First parameter must be 'InForm';
' Second parameter starts with StreamKind enumaration name and semicolon, then contionue parameter name(s).
'
'Getting video width and height single line...
c.OptionMedia "Inform", "Video; Video sizes: %Width% x %Height% pixels"
Debug.Print c.InForm
'Getting file size...
c.OptionMedia "Inform", "General; File size is: %FileSize/String4%"
Debug.Print c.InForm
'Getting duration...
c.OptionMedia "Inform", "General; Duration is: %Duration/String3%"
Debug.Print c.InForm
c.CloseMedia
c.Dispose
End Sub
Sub With_Parameter_Get_Piece_Specific_String_ByName()
Dim c As New MediaInfo, dlg As Variant
dlg = FilePickerSingle
If dlg = "" Then Exit Sub
c.OpenMedia dlg
'Syntax: First parameter is StreamKind enumaration;
' Second parameter is usually '0';
' Thirth parameter is string info parameter name (CASE SENSITIVE !!!)
Debug.Print "Width: "; c.GetByName(Video, 0, "Width"); " px"
Debug.Print "Height: "; c.GetByName(Video, 0, "Height"); " px"
Debug.Print "File size: "; c.GetByName(General, 0, "FileSize/String4")
Debug.Print "Duration: "; c.GetByName(General, 0, "Duration/String3")
c.CloseMedia
c.Dispose
End Sub
Son düzenleme:
