Late Bound Windows Media Player going out of scope

[Jaafar Tribak]

Hi,

This works:

Dim oMPlayer As Object

Sub test1()
    Set oMPlayer = CreateObject("New:{6BF52A52-394A-11D3-B153-00C04F79FAA6}")
    With oMPlayer
        .URL = "C:\test\Alarm02.wav"
         Debug.Print .currentMedia.Name
    End With
End Sub

This doesn't work as it doesn't store the media player in a module level variable.

Sub test2()
    With CreateObject("New:{6BF52A52-394A-11D3-B153-00C04F79FAA6}")
        .URL = "C:\test\Alarm02.wav"
         Debug.Print .currentMedia.Name
    End With
End Sub

.OpenPlayer "C:\test\Alarm02.wav" Method works but it shows the media player window unlike the URL Property... This is similar to what happens when opening a new excel instance (late bound) without setting the Visible Property to TRUE.

Is there some MPlayer Method or Property that can be set (or some other workaround) to make the test2 macro work - ie:= w/o storing the MPlayer instance in a module level variable and w/o making it visible ?

Regards.

 

[Dan_W]

This is the magic api function called CoLockObjectExternal exported by the ole32.dll... Nice & short !

Option Explicit

'HRESULT CoLockObjectExternal(
'  [in] LPUNKNOWN pUnk,
'  [in] BOOL      fLock,
'  [in] BOOL      fLastUnlockReleases
');

#If VBA7 Then
    Declare PtrSafe Function CoLockObjectExternal Lib "ole32.dll" (ByVal pUnk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#Else
    Declare Function CoLockObjectExternal Lib "ole32.dll" (ByVal pUnk As IUnknown, ByVal fLock As Boolean, Optional ByVal fLastUnlockReleases As Boolean) As Long
#End If

Sub test2()
    Const S_OK = 0&
    Dim oMPlayer As Object
    Set oMPlayer = CreateObject("New:{6BF52A52-394A-11D3-B153-00C04F79FAA6}")
    'Call CoLockObjectExternal to lock the MPlayer object to ensure that it stays in memory.
    If CoLockObjectExternal(oMPlayer, True) = S_OK Then
        With oMPlayer
            .URL = "C:\test\Alarm02.wav"
            Debug.Print .currentMedia.Name
        End With
    End If
End Sub

In theory and according to the documentation, the lock should be released which I am not doing here since it will defeat the purpose so I am not sure if that's ok. I have carried out a few tests w/o any issues so far ... The same goes with the previous IUnKnown::AddRef method which in theory should be followed by IUnKnown::Release when done.

Thanks everyone for their help.

Works perfectly for me - I've not come across this API before so am excited to read up more about it.

 

[Jaafar Tribak]

Is this the same issue as with losing the connection with the Ribbon - and couldn't the method used by RoryA to save/retrieve the pointer from a Name work here too?

Hi Dan_W,
No. It is not the same issue. The Ribbon stays in memory, it is only its memory pointer (stored in a variable) that is lost when a state loss happens.

Works perfectly for me - I've not come across this API before so am excited to read up more about it.

If I remember correctly, I came accross this CoLockObjectExternal api long time ago but never used it .

 

[Jaafar Tribak]

Just for the record, here is a slight correction of the IUnKnown::AddRef() code in post#8. I just got rid of the IIDFromString call which was unnecessary and performed a cast from the IDIspatch interface to the IUnKnown interface using the Set statement prior to calling the AddRef function.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare PtrSafe Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare Function DispCallFunc Lib "oleAut32.dll" (ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
    Private Declare Sub SetLastError Lib "kernel32.dll" (ByVal dwErrCode As Long)
#End If

Sub test2()

    #If Win64 Then
        Const PTR_LEN = 8&
    #Else
        Const PTR_LEN = 4&
    #End If
    Const CC_STDCALL As Long = 4&
    Dim oIUnK As IUnknown, oMPlayer As Object
    
    Set oMPlayer = CreateObject("New:{6BF52A52-394A-11D3-B153-00C04F79FAA6}")
    'Cast IDispatch to IUnKnown
    Set oIUnK = oMPlayer
    'Call IUKnown::AddRef (VTable Offset = 4 bytes in x32 Processes and 8bytes in x64 Processes)
    If vtblCall(ObjPtr(oIUnK), PTR_LEN, vbLong, CC_STDCALL) > 1& Then
        With oMPlayer
            .URL = "C:\test\Alarm02.wav"
            Debug.Print .currentMedia.Name
        End With
    End If
    
End Sub

Private Function vtblCall( _
    ByVal InterfacePointer As LongPtr, _
    ByVal VTableOffset As Long, _
    ByVal FunctionReturnType As Long, _
    ByVal CallConvention As Long, _
    ParamArray FunctionParameters() As Variant _
) As Variant

    Dim vParamPtr() As LongPtr

    If InterfacePointer = 0& Or VTableOffset < 0& Then Exit Function
    If Not (FunctionReturnType And &HFFFF0000) = 0& Then Exit Function

    Dim pIndex As Long, pCount As Long
    Dim vParamType() As Integer
    Dim vRtn As Variant, vParams() As Variant

    vParams() = FunctionParameters()
    pCount = Abs(UBound(vParams) - LBound(vParams) + 1&)
    If pCount = 0& Then
        ReDim vParamPtr(0 To 0)
        ReDim vParamType(0 To 0)
    Else
        ReDim vParamPtr(0 To pCount - 1&)
        ReDim vParamType(0 To pCount - 1&)
        For pIndex = 0& To pCount - 1&
            vParamPtr(pIndex) = VarPtr(vParams(pIndex))
            vParamType(pIndex) = VarType(vParams(pIndex))
        Next
    End If

    pIndex = DispCallFunc(InterfacePointer, VTableOffset, CallConvention, FunctionReturnType, pCount, _
    vParamType(0), vParamPtr(0), vRtn)
    If pIndex = 0& Then
        vtblCall = vRtn
    Else
        SetLastError pIndex
    End If

End Function

 

[sancarn]

On a related note, @Jaafar Tribak don't suppose you know how to get a pointer to the object on the With stack?

Private c as new collection
Sub t()
  With new Something
    .whatever = something
    Call c.add(getWithStackObject())
  End With
End Sub

 

[Jaafar Tribak]

Is this what you mean ?

Add this new Method to the SomeThing Class:

Public Function ThisInstance() As Something
    Set ThisInstance = Me
End Function

Then get the pointer to the newly created object like this :

Private c As New Collection
Sub t()
  With New Something
    ' whatever '= Something
    Call c.Add(.ThisInstance)
    Debug.Print "This *" & TypeName(c.Item(1&)) & "* Instance's pointer is : " & ObjPtr(.ThisInstance)
  End With
End Sub

 

[sancarn]

Is this what you mean ?

Private c As New Collection
Sub t()
  With New Something
    ' whatever '= Something
    Call c.Add(.ThisInstance)
    Debug.Print "This *" & TypeName(c.Item(1&)) & "* Instance's pointer is : " & ObjPtr(.ThisInstance)
  End With
End Sub

Kinda yeah, but directly instead of having to implement a function in all classes (as sometimes that's not possible). It's my expectation that there is a With stack where you should be able to obtain all pointers to all objects/structs where we are currently in a With block. The P-Code has StartWithExpr and MemStWith operations, so I imagine it's possible to get a pointer to the stack directly, and find the object there.

 

[Jaafar Tribak]

Kinda yeah, but directly instead of having to implement a function in all classes (as sometimes that's not possible). It's my expectation that there is a With stack where you should be able to obtain all pointers to all objects/structs where we are currently in a With block. The P-Code has StartWithExpr and MemStWith operations, so I imagine it's possible to get a pointer to the stack directly, and find the object there.

Sorry. I don't know the answer to that. Have you tried asking maybe @ VBForums? You are more likely to get an answer there.

 

[sancarn]

Sorry. I don't know the answer to that. Have you tried asking maybe @ VBForums? You are more likely to get an answer there.

Yeah no worries, was mainly curious if you'd come across it