A fellow FireFly user is having trouble unloading an OCX from memory when the application ends. The exe process continues to run and stays in memory.
The DX Studio player control can be found here: http://www.dxstudio.com/download.aspx
A sample project is attached.
Note: If the code in WM_DESTROY is executed elsewhere other than in WM_DESTROY then the control unloads and the exe does not remain in memory.
Any ideas why it won't work properly via the WM_DESTROY handler?
Thanks!
Function FORM1_WM_DESTROY ( _
hWndForm As Dword _ ' handle of Form
) As Long
Local pDispatch As IDXStudioPlayer
' Get a reference to the DXStudio control and set the properties
pDispatch = OC_GetDispatch(HWND_FORM1_OCXCONTROL1)
If IsObject(pDispatch) Then
pDispatch.ManualShutDown
pDispatch = Nothing
End If
End Function
Do error checking, i.e. check if IsObject(pDispatch) returns true and if pDispatch.ManualShutDown returns true.
There seems to be a timing issues as to when messages get processed. If I check the return value and pop up a messagebox, the ManualShutdown happens and the executable is not left in memory. If I comment out the messagebox then the executable is still left in memory.
'--------------------------------------------------------------------------------
Function FORMMOVECHESSPIECES_WM_CLOSE ( _
hWndForm As Dword _ ' handle of Form
) As Long
Local ret As Long
Local pDispatch As IDXStudioPlayer
pDispatch = OC_GetDispatch(HWND_FORMMOVECHESSPIECES_OCXCONTROL1)
If IsObject(pDispatch) Then
Call pDispatch.ManualShutdown() To ret
MsgBox "return value " + Str$(ret)
pDispatch = Nothing
End If
End Function
Will a DoEvent at the right place help?
Quote
There seems to be a timing issues as to when messages get processed.
Maybe it is slow closing and when the program finishes can't unload it because it is still busy. Try to do the shut down in WM_CLOSE instead of WM_DESTROY.
It leaves it in memory in either WM_CLOSE or WM_DESTROY. I'm trying to re-create it in straight PB and it seems to get unloaded fine from straight PB.
This is based on one of Jose' examples (Thanks, Jose') and works great. I don't even do a shutdown at all.
#DIM ALL
#DEBUG ERROR ON
#INCLUDE "win32api.inc"
%ID_OCX = 1001
%ID_NORTH = 1002
%ID_EAST = 1003
%ID_SOUTH = 1004
%ID_WEST = 1005
%ID_RESET = 1006
GLOBAL hDlg AS DWORD
GLOBAL hOcx AS DWORD
GLOBAL oOcx AS DISPATCH
' *********************************************************************************************
' ATLAPI_(BOOL) AtlAxWinInit( );
' This function initializes ATL's control hosting code by registering the "AtlAxWin7" and
' "AtlAxWinLic7" window classes plus a couple of custom window messages.
' Return Value: TRUE, if the initialization of the control hosting code was successful; otherwise FALSE.
' Remarks: This function must be called before using the ATL control hosting API. Following a
' call to this function, the "AtlAxWin" window class can be used in calls to CreateWindow or
' CreateWindowEx, as described in the Platform SDK.
' *********************************************************************************************
DECLARE FUNCTION AtlAxWinInit LIB "ATL.DLL" ALIAS "AtlAxWinInit" () AS LONG
' *********************************************************************************************
' *********************************************************************************************
' inline BOOL AtlAxWinTerm( );
' This function uninitializes ATL's control hosting code by unregistering the "AtlAxWin7" and
' "AtlAxWinLic7" window classes.
' This function simply calls UnregisterClass as described in the Platform SDK.
' Call this function to clean up after all existing host windows have been destroyed if you
' called AtlAxWinInit and you no longer need to create host windows. If you don't call this
' function, the window class will be unregistered automatically when the process terminates.
' Return Value: If the function succeeds, the return value is nonzero.
' *********************************************************************************************
DECLARE FUNCTION AtlAxWinTerm () AS LONG
' *********************************************************************************************
FUNCTION AtlAxWinTerm () AS LONG
UnregisterClass ("AtlAxWin", GetModuleHandle(BYVAL %NULL))
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' ATLAPI AtlAxGetControl (HWND h, IUNKNOWN** pp);
' Obtains a direct interface pointer to the control contained inside a specified window given its handle.
' **********************************************************************************************
DECLARE FUNCTION AtlAxGetControl LIB "ATL.DLL" ALIAS "AtlAxGetControl" _
( _
BYVAL hWnd AS DWORD, _ ' [in] A handle to the window that is hosting the control.
BYREF pp AS DWORD _ ' [out] The IUnknown of the control being hosted.
) AS DWORD
' *********************************************************************************************
' *********************************************************************************************
' Puts the address of an object in a variant and marks it as containing a dispatch variable
' *********************************************************************************************
SUB AtlMakeDispatch ( _
BYVAL lpObj AS DWORD, _ ' Address of the object instance
BYREF vObj AS VARIANT _ ' Variant to contain this address
) EXPORT
LOCAL lpvObj AS VARIANTAPI PTR ' Pointer to a VARIANTAPI structure
LET vObj = EMPTY ' Make sure is empty to avoid memory leaks
lpvObj = VARPTR(vObj) ' Get the VARIANT address
@lpvObj.vt = %VT_DISPATCH ' Mark it as containing a dispatch variable
@lpvObj.vd.pdispVal = lpObj ' Set the dispatch pointer address
END SUB
' *********************************************************************************************
' *********************************************************************************************
' Converts a Windows error code in a message string
' *********************************************************************************************
FUNCTION WinErrorMsg (BYVAL dwError AS DWORD) AS STRING
LOCAL pBuffer AS ASCIIZ PTR
LOCAL ncbBuffer AS DWORD
LOCAL sText AS STRING
ncbBuffer = FormatMessage(%FORMAT_MESSAGE_ALLOCATE_BUFFER _
OR %FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS, _
BYVAL %NULL, dwError, BYVAL MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
BYVAL VARPTR(pBuffer), 0, BYVAL %NULL)
IF ncbBuffer THEN
sText = PEEK$(pBuffer, ncbBuffer)
sText = REMOVE$ (sText, ANY CHR$(13) + CHR$(10))
LocalFree pBuffer
ELSE
sText = "Unknmown error - Code "+ HEX$(dwError, 8)
END IF
FUNCTION = sText
END FUNCTION
' *********************************************************************************************
' *********************************************************************************************
' M A I N P R O G R A M
' *********************************************************************************************
' *********************************************************************************************
' Main dialog callback
' *********************************************************************************************
CALLBACK FUNCTION MainDlgProc()
LOCAL rc AS RECT
LOCAL r AS LONG
LOCAL x AS LONG
LOCAL y AS LONG
LOCAL xx AS LONG
LOCAL yy AS LONG
SELECT CASE CBMSG
CASE %WM_SIZE
'GetClientRect CBHNDL, rc
'x = rc.nLeft : y = rc.nTop
'xx = rc.nRight - 100 'rc.nLeft
'yy = rc.nBottom - 100 'rc.nTop
'MoveWindow hOcx, x, y, xx, yy, %TRUE
CASE %WM_DESTROY
PostQuitMessage 0
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDCANCEL
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
DIALOG END CBHNDL, 0
END IF
END SELECT
END SELECT
END FUNCTION
' *********************************************************************************************
CALLBACK FUNCTION ButtonResetCallback() AS LONG
IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
'...Process the click event here
LOCAL temp AS VARIANT
temp = "scenes.scene_1.script.ResetPieces()"
OBJECT CALL oOcx.Send(temp)
FUNCTION = 1
END IF
END FUNCTION
CALLBACK FUNCTION ButtonNorthCallback() AS LONG
IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
'...Process the click event here
LOCAL temp AS VARIANT
temp = "scenes.scene_1.script.MoveNorth('BlackQueen')"
OBJECT CALL oOcx.Send(temp)
FUNCTION = 1
END IF
END FUNCTION
CALLBACK FUNCTION ButtonEastCallback() AS LONG
IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
'...Process the click event here
LOCAL temp AS VARIANT
temp = "scenes.scene_1.script.MoveEast('BlackQueen')"
OBJECT CALL oOcx.Send(temp)
FUNCTION = 1
END IF
END FUNCTION
CALLBACK FUNCTION ButtonSouthCallback() AS LONG
IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
'...Process the click event here
LOCAL temp AS VARIANT
temp = "scenes.scene_1.script.MoveSouth('BlackQueen')"
OBJECT CALL oOcx.Send(temp)
FUNCTION = 1
END IF
END FUNCTION
CALLBACK FUNCTION ButtonWestCallback() AS LONG
IF CB.MSG = %WM_COMMAND AND CB.CTLMSG = %BN_CLICKED THEN
'...Process the click event here
LOCAL temp AS VARIANT
temp = "scenes.scene_1.script.MoveWest('BlackQueen')"
OBJECT CALL oOcx.Send(temp)
FUNCTION = 1
END IF
END FUNCTION
' *********************************************************************************************
' Main
' *********************************************************************************************
FUNCTION PBMAIN
LOCAL hInst AS DWORD
LOCAL hr AS DWORD
LOCAL OcxName AS ASCIIZ * 255
LOCAL pUnk AS DWORD
LOCAL vVar AS VARIANT
LOCAL vIdx AS VARIANT
LOCAL uMsg AS tagMsg
LOCAL dwCookie AS DWORD
OcxName = "DXStudioPlayerDLL.DXStudioPlayer.1"
' OcxName must be formatted in one of the following ways:
' · A ProgID such as "MSCAL.Calendar.7"
' · A CLSID such as "{8E27C92B-1264-101C-8A2F-040224009C02}"
' · A URL such as "http://www.microsoft.com"
' · A reference to an Active document such as "file://\\Documents\MyDoc.doc"
' · A fragment of HTML such as "MSHTML:<HTML><BODY>This is a line of text</BODY></HTML>"
' Note "MSHTML:" must precede the HTML fragment so that it is designated as being an MSHTML stream.
hInst = GetModuleHandle(BYVAL %NULL)
AtlAxWinInit ' // Initializes ATL
DIALOG NEW 0, "Test DX Studio",,, 800, 600, %WS_OVERLAPPEDWINDOW, 0 TO hDlg
CONTROL ADD "AtlAxWin", hDlg, %ID_OCX, OcxName, 0, 0, 550, 550, %WS_VISIBLE OR %WS_CHILD
CONTROL ADD BUTTON, hDlg, %ID_NORTH, "North", 634, 143, 75, 25, , , CALL ButtonNorthCallback() ' Use default styles
CONTROL ADD BUTTON, hDlg, %ID_EAST, "East", 680, 196, 75, 25, , , CALL ButtonEastCallback() ' Use default styles
CONTROL ADD BUTTON, hDlg, %ID_NORTH, "South", 634, 243, 75, 25, , , CALL ButtonSouthCallback() ' Use default styles
CONTROL ADD BUTTON, hDlg, %ID_NORTH, "West", 582, 196, 75, 25, , , CALL ButtonWestCallback() ' Use default styles
CONTROL ADD BUTTON, hDlg, %ID_RESET, "Reset Pieces", 634, 327, 85, 25, , , CALL ButtonResetCallback() ' Use default styles
CONTROL HANDLE hDlg, %ID_OCX TO hOcx
AtlAxGetControl(hOcx, pUnk)
AtlMakeDispatch(pUnk, vVar)
SET oOcx = vVar
vVar = "F:\PowerBasicClassicWindows9\Chessboard.dxstudio"
OBJECT LET oOcx.src = vVar
LOCAL temp AS VARIANT
OBJECT CALL oOcx.ManualInit
temp = 0
OBJECT LET oOcx.ManualCreateAndUpdate = temp
DIALOG SHOW MODAL hDlg, CALL MainDlgProc TO hr
Terminate:
AtlAxWinTerm ' // Uninitializes ATL
SET oOcx = NOTHING
END FUNCTION
' *********************************************************************************************