CWindow Release Candidate 21
Incorporates some minor changes and a few functions more.
The novelty is the new CWebBrowser class. It allows to embed instances of the WebBrowser control using COleCon.
It also provides methods to connect and disconnect to the events fired by the WebBrowser control, set event handlers (pointers to callback procedures) for both the DWebBrowser2 and IDocHostUIHandler2 interfaces, a method to navigate to a URL, and function to get references to the OLE Container class and the IWebBrowser2 interface.
The file AfxExDisp.bi provides declarations to call the methods of the WebBrowser interfaces using abstract methods.
The WebBrowser events sink class is provided in the file CWebBrowserEventsImpl.inc, and the DocHostUIHandler events sink class is provided in the file CDocHostUIHandler2Impl.inc.
In a similar way to Visual Basic, it allows to subscribe only to the events in which you're interested, e.g.
' // Add a WebBrowser control
DIM pwb AS CWebBrowser = CWebBrowser(@pWindow, IDC_WEBBROWSER, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Connect events
pwb.Advise
' // Set event callback procedures
pwb.SetEventProc("StatusTextChange", @WebBrowser_StatusTextChangeProc)
pwb.SetEventProc("DocumentComplete", @WebBrowser_DocumentCompleteProc)
' // Set the IDocHostUIHandler interface
pwb.SetUIHandler
' // Set event callback procedures
pwb.SetUIEventProc("ShowContextMenu", @DocHostUI_ShowContextMenuProc)
pwb.SetUIEventProc("GetHostInfo", @DocHostUI_GetHostInfo)
pwb.SetUIEventProc("TranslateAccelerator", @DocHostUI_TranslateAccelerator)
' // Navigate to a URL
pwb.Navigate("http://com.it-berater.org/")
The help file provides prototypes for all the WebBrowser and IDocHostUIHandler events in the SetEventProc and SetUIEventProc topics.
And last, but not the least, it is High DPI aware.
Update 12 Sep 2016:
AfxOpenFileDialog: Returned filename had a trailing comma (file AfxWin.inc).
TreeView_ItemExists: Was causing memory corruption (file AfxCtl.inc).
An small example:
' ########################################################################################
' Microsoft Windows
' Contents: WebBrowser customization test
' Compiler: FreeBasic 32 & 64 bit
' Copyright (c) 2016 Jose Roca. Freeware. Use at your own risk.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################
#define UNICODE
'#define _OC_DEBUG_ 1
'#define _CWB_DEBUG_ 1
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "Afx/CWebBrowser/CWebBrowser.inc"
USING Afx
CONST IDC_WEBBROWSER = 1001
CONST IDC_SATUSBAR = 1002
DECLARE FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
END WinMain(GetModuleHandleW(NULL), NULL, COMMAND(), SW_NORMAL)
DECLARE FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
' // Forward declarations
DECLARE SUB WebBrowser_StatusTextChangeProc (BYVAL this AS CWebBrowserEventsImpl PTR, BYVAL pwszText AS WSTRING PTR)
DECLARE SUB WebBrowser_DocumentCompleteProc (BYVAL this AS CWebBrowserEventsImpl PTR, BYVAL pdisp AS IDispatch PTR, BYVAL vUrl AS VARIANT PTR)
DECLARE FUNCTION DocHostUI_ShowContextMenuProc (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL dwID AS DWORD, BYVAL ppt AS POINT PTR, BYVAL pcmdtReserved AS IUnknown PTR, BYVAL pdispReserved AS IDispatch PTR) AS HRESULT
DECLARE FUNCTION DocHostUI_GetHostInfo (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL pInfo AS DOCHOSTUIINFO PTR) AS HRESULT
DECLARE FUNCTION DocHostUI_TranslateAccelerator (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL lpMsg AS LPMSG, BYVAL pguidCmdGroup AS const GUID PTR, BYVAL nCmdID AS DWORD) AS HRESULT
' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain (BYVAL hInstance AS HINSTANCE, _
BYVAL hPrevInstance AS HINSTANCE, _
BYVAL szCmdLine AS ZSTRING PTR, _
BYVAL nCmdShow AS LONG) AS LONG
' // Set process DPI aware
' // The recommended way is to use a manifest file
AfxSetProcessDPIAware
' // Creates the main window
DIM pWindow AS CWindow
' -or- DIM pWindow AS CWindow = "MyClassName" (use the name that you wish)
DIM hwndMain AS HWND = pWindow.Create(NULL, "Embedded WebBrowser control with events and customization", @WndProc)
' // Sizes it by setting the wanted width and height of its client area
pWindow.SetClientSize(750, 450)
' // Centers the window
pWindow.Center
' // Add a status bar
DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", , IDC_SATUSBAR)
' // Add a WebBrowser control
DIM pwb AS CWebBrowser = CWebBrowser(@pWindow, IDC_WEBBROWSER, 0, 0, pWindow.ClientWidth, pWindow.ClientHeight)
' // Connect events
pwb.Advise
' // Set event callback procedures
pwb.SetEventProc("StatusTextChange", @WebBrowser_StatusTextChangeProc)
pwb.SetEventProc("DocumentComplete", @WebBrowser_DocumentCompleteProc)
' // Set the IDocHostUIHandler interface
pwb.SetUIHandler
' // Set event callback procedures
pwb.SetUIEventProc("ShowContextMenu", @DocHostUI_ShowContextMenuProc)
pwb.SetUIEventProc("GetHostInfo", @DocHostUI_GetHostInfo)
pwb.SetUIEventProc("TranslateAccelerator", @DocHostUI_TranslateAccelerator)
' // Navigate to a URL
pwb.Navigate("http://com.it-berater.org/")
' // Display the window
ShowWindow(hWndMain, nCmdShow)
UpdateWindow(hWndMain)
' // Dispatch Windows messages
DIM uMsg AS MSG
WHILE (GetMessageW(@uMsg, NULL, 0, 0) <> FALSE)
IF AfxForwardMessage(GetFocus, @uMsg) = FALSE THEN
IF IsDialogMessageW(hWndMain, @uMsg) = 0 THEN
TranslateMessage(@uMsg)
DispatchMessageW(@uMsg)
END IF
END IF
WEND
FUNCTION = uMsg.wParam
END FUNCTION
' ========================================================================================
' ========================================================================================
' Main window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hwnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT
SELECT CASE uMsg
CASE WM_COMMAND
SELECT CASE LOWORD(wParam)
CASE IDCANCEL
' // If ESC key pressed, close the application by sending an WM_CLOSE message
IF HIWORD(wParam) = BN_CLICKED THEN
SendMessageW hwnd, WM_CLOSE, 0, 0
EXIT FUNCTION
END IF
END SELECT
CASE WM_SIZE
' // Optional resizing code
IF wParam <> SIZE_MINIMIZED THEN
' // Resize the toolbar
DIM hStatusBar AS HWND = GetDlgItem(hwnd, IDC_SATUSBAR)
SendMessage hStatusBar, uMsg, wParam, lParam
' // Calculate the size of the status bar
DIM StatusBarHeight AS DWORD, rc AS RECT
GetWindowRect hStatusBar, @rc
StatusBarHeight = rc.Bottom - rc.Top
' // Retrieve a pointer to the CWindow class
DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
' // Move the position of the control
IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, IDC_WEBBROWSER), _
0, 0, pWindow->ClientWidth, pWindow->ClientHeight - StatusBarHeight / pWindow->ryRatio, CTRUE
END IF
CASE WM_DESTROY
' // Ends the application by sending a WM_QUIT message
PostQuitMessage(0)
EXIT FUNCTION
END SELECT
' // Default processing of Windows messages
FUNCTION = DefWindowProcW(hwnd, uMsg, wParam, lParam)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Process the WebBrowser StatusTextChange event.
' ========================================================================================
SUB WebBrowser_StatusTextChangeProc (BYVAL this AS CWebBrowserEventsImpl PTR, BYVAL bstrText AS AFX_BSTR)
IF bstrText THEN StatusBar_SetText(GetDlgItem(GetParent(this->m_hwndContainer), IDC_SATUSBAR), 0, *bstrText)
END SUB
' ========================================================================================
' ========================================================================================
' Process the WebBrowser DocumentComplete event.
' ========================================================================================
SUB WebBrowser_DocumentCompleteProc (BYVAL this AS CWebBrowserEventsImpl PTR, BYVAL pdisp AS IDispatch PTR, BYVAL vUrl AS VARIANT PTR)
' // The vUrl parameter is a VT_BYREF OR VT_BSTR variant
DIM varUrl AS VARIANT
VariantCopyInd(@varUrl, vUrl)
DIM bstrUrl AS AFX_BSTR = varUrl.bstrVal
IF bstrUrl THEN StatusBar_SetText(GetDlgItem(GetParent(this->m_hwndContainer), IDC_SATUSBAR), 0, "Document complete: " & *bstrUrl)
VariantClear(@varUrl)
END SUB
' ========================================================================================
' ========================================================================================
' Process the IDocHostUIHandler ShowContextMenu event.
' ========================================================================================
FUNCTION DocHostUI_ShowContextMenuProc (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL dwID AS DWORD, BYVAL ppt AS POINT PTR, BYVAL pcmdtReserved AS IUnknown PTR, BYVAL pdispReserved AS IDispatch PTR) AS HRESULT
' // This event notifies that the user has clicked the right mouse button to show the
' // context menu. We can anulate it returning %S_OK and show our context menu.
' // Do not allow to show the context menu
AfxMsg "Sorry! Context menu disabled"
RETURN S_OK
' // Host did not display its UI. MSHTML will display its UI.
RETURN S_FALSE
END FUNCTION
' ========================================================================================
' ========================================================================================
' Process the IDocHostUIHandler GetHostInfo event.
' ========================================================================================
PRIVATE FUNCTION DocHostUI_GetHostInfo (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL pInfo AS DOCHOSTUIINFO PTR) AS HRESULT
IF pInfo THEN
pInfo->cbSize = SIZEOF(DOCHOSTUIINFO)
pInfo->dwFlags = DOCHOSTUIFLAG_NO3DBORDER OR DOCHOSTUIFLAG_THEME OR DOCHOSTUIFLAG_DPI_AWARE
pInfo->dwDoubleClick = DOCHOSTUIDBLCLK_DEFAULT
pInfo->pchHostCss = NULL
pInfo->pchHostNS = NULL
END IF
RETURN S_OK
END FUNCTION
' ========================================================================================
' ========================================================================================
' Process the IDocHostUIHandler TranslateAccelerator event.
' ========================================================================================
PRIVATE FUNCTION DocHostUI_TranslateAccelerator (BYVAL this AS CDocHostUIHandler2Impl PTR, BYVAL lpMsg AS LPMSG, BYVAL pguidCmdGroup AS const GUID PTR, BYVAL nCmdID AS DWORD) AS HRESULT
' // When you use accelerator keys such as TAB, you may need to override the
' // default host behavior. The example shows how to do this.
IF lpMsg->message = WM_KEYDOWN AND lpMsg->wParam = VK_TAB THEN
RETURN S_FALSE ' S_OK to disable tab navigation
END IF
' // Return S_FALSE if you don't process the message
RETURN S_FALSE
END FUNCTION
' ========================================================================================
Update 12 Sep 2016:
AfxOpenFileDialog: Returned filename had a trailing comma (file AfxWin.inc).
TreeView_ItemExists: Was causing memory corruption (file AfxCtl.inc).
By "popular" demand (James and Marc), I have started to work in a TypeLib Browser for Free Basic.
The attached file contains the source code, the resources and an 64-bit executable.
The only part missing is the code generation. Maybe I will do it parsing the information displayed in the treeview instead of messing the convoluted typelib parsing code that I have managed to keep clean.
Sorting
Click the wanted ListView header column.
Expand
Expands all the nodes in the TreeView.
Collapse
Collapses all the nodes in the TreeView.
Size
The main window is resizable. The size and placement are saved in the .ini file.
ListView
The width of the columns can be changed with the mouse and the order of the columns can be changed by dragging and dropping the column header with the mouse.
Options
Currently, only the "Use Automation View" option has been implemented.
After changing this option, you must reparse the typelib by double clicking it again in the ListView.
The browser supports two kinds of views, the default VTable view and the Automation view, aka Visual Basic view.
The VTable view lists only the methods and properties that belongs to an interface. It is the more suitable for making interface declarations that use abstract methods.
The Automation view, lists all the methods and properties, including these belonging to the inherited interfaces. It is the more suitable for making interface declarations and object macros like the ones provided in the FB official headers. A minor quirk is that, as it was designed for Automation lnguages like VB6, in which the name of right side parameter of the properties is not needed, only the result type, it does not return the name. The browser uses RHS (Right Hand Side) as the name of these parameters.
Load
You can load unregistered type libraries, either stand alone ones (.TLB) or attached in .OCX, .DLL and .EXE files as a resource.
For those interested, I have posted an small tutorial about the making of the typelib browser. As I don't have talent for writing, I have heavily illustrated it with code. It is easier to me to write code than to explain what it does...
See: http://www.planetsquires.com/protect/forum/index.php?topic=3933.0
Found a little bug in the CParseTypeLib.GetFunctions method (TLB_ParseLib.inc).
Instead of
IF UCASE$(cbstrName) = "QUERYINTERFACE" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "ADDREF" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "RELEASE" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETTYPEINFOCOUNT" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETTYPEINFO" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETIDSOFNAMES" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
IF UCASE$(cbstrName) = "INVOKE" AND pFuncdesc->oVft > 24 THEN cbstrName += "_"
We should use
DIM vtOffset AS LONG
#ifdef __FB_64BIT__
vtOffset = 48
#else
vtOffset = 24
#endif
IF UCASE$(cbstrName) = "QUERYINTERFACE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "ADDREF" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "RELEASE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETTYPEINFOCOUNT" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETTYPEINFO" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "GETIDSOFNAMES" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
IF UCASE$(cbstrName) = "INVOKE" AND pFuncdesc->oVft > vtOffset THEN cbstrName += "_"
Because pointers are 8 bytes in 64-bit and 4 bytes in 32 bits.
Another little bug, this time in CParseTypeLib.GetParameters.
Instead of
IF cbstrTypeKind = "TKIND_UNKNOWN" THEN cbstrFBKeyword = "IUnknown PTR"
IF cbstrTypeKind = "TKIND_DISPATCH" THEN cbstrFBKeyword = "IDispatch PTR"
should be
IF cbstrTypeKind = "TKIND_UNKNOWN" THEN cbstrFBKeyword = "IUnknown"
IF cbstrTypeKind = "TKIND_DISPATCH" THEN cbstrFBKeyword = "IDispatch"
I expect there will be some more minor bugs lithe this one. When code generation will be added, they will become self evident, since the compiler will detect many of the mistakes.
Not a bug, but additional parsing.
In CParseTypeLib.GetConstants, change
SELECT CASE pVarDesc->elemdescVar.tdesc.vt
CASE VT_I1, VT_UI1, VT_I2, VT_UI2, VT_INT, VT_UINT
cbstrValue = **cbstrValue & " (&h" & HEX(VAL(**cbstrValue), 8) & ")"
END SELECT
to
SELECT CASE pVarDesc->elemdescVar.tdesc.vt
CASE VT_I1, VT_UI1, VT_I2, VT_UI2, VT_INT, VT_UINT
cbstrValue = **cbstrValue & " (&h" & HEX(VAL(**cbstrValue), 8) & ")"
CASE VT_BSTR, VT_LPSTR, VT_LPWSTR
' // cdosys.dll contains VT_BSTR constants
cbstrValue = CHR(34) & **cbstrValue & CHR(34)
CASE VT_PTR
ptdesc = pVarDesc->elemdescVar.tdesc.lptdesc
IF ptdesc THEN
' WORD PTR (null terminated unicode string)
' hxds.dll contains a module with these kind of constants.
IF ptdesc->vt = VT_UI2 THEN cbstrValue = CHR(34) & **cbstrValue & CHR(34)
END IF
' // Other types can be VT_CARRAY and VT_USERDEFINED, but don't have a typelib to test
END SELECT
Some details can't be checked unless I have an appropriate typelib.
Another little correction, in CParseTypeLib.GetParameters
After
CASE "VT_LPSTR"
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS ZSTRING PTR"
CASE "VT_LPWSTR"
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS WSTRING PTR"
add
CASE "VT_BSTR"
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS BSTR"
Will need some help to find mistakes, specially with parameters.
In CParseTypeLib.GetParameters, change
CASE "VT_UNKNOWN"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IUnknown PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IUnknown PTR"
END IF
CASE "VT_DISPATCH"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IDispatch PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IDispatch PTR"
END IF
to
CASE "VT_UNKNOWN"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IUnknown PTR PTR"
ELSE
IF (wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IUnknown PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IUnknown PTR"
END IF
END IF
CASE "VT_DISPATCH"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IDispatch PTR PTR"
ELSE
IF (wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT THEN
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IDispatch PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & cbstrParamName & " AS IDispatch PTR"
END IF
END IF
The use by FB of PTR PTR is somewhat problematic. Probably I will have to do more changes.
Jose
Thanks another time to your huge job.
The tutorial is very, very interresting...
As you could imagine, i tried it immediatly , but the exe is 64bits so not working for me
I'd complied it , no problem to compile but nothing when executing...
why? because i'm in xp sp3 and you put
#define _WIN32_WINNT &h0602
wich is not true for me, changing it by :
#define _WIN32_WINNT &h0502
error in
SendMessageW(hHeader, HDM_SETFOCUSEDITEM, 0, ColumnToSort)
so simply commented that line ( and after put #if(_WIN32_WINNT > &h0602) ) was enougth to get it working !
made also your evolutions, seems working well
You know, i was digging on the variant types and i noticed something :
about the INT_ and UINT_ types
theses types are in fact typedef for long and ulong types : 32bit ( x86 or 64)
but normally they are
VT_INT A signed machine integer.
VT_UINT An unsigned machine integer.
I think it would be better to use
for VT_INT Integer
VT_UINT UInteger
wich are 32 or 64 depending the os
do you agree ?
last update : remark on BOOL , probably better to use BOOLEAN
CASE 11 : s = "BOOLEAN" '"BOOL" ' VT_BOOL
And if needed 2 ocx samples if needed for your tests of code
outgoing2.ocx: with only ole automation interface (and events ole automation interface)
gauge32.ocx: with only dispach interface (and events dispach interface)
Quote
about the INT_ and UINT_ types
theses types are in fact typedef for long and ulong types : 32bit ( x86 or 64)
but normally they are
VT_INT A signed machine integer.
VT_UINT An unsigned machine integer.
I think it would be better to use
for VT_INT Integer
VT_UINT UInteger
wich are 32 or 64 depending the os
do you agree ?
No, I don't. In COM 64 bit, these values continue being 32 bit. Using Integer and UInteger fails in 64 bit (I have tested it).
Quote
last update : remark on BOOL , probably better to use BOOLEAN
A C++ BOOL is not the same that FB BOOLEAN. A BOOL uses 0 for FALSE and 1 for TRUE, not 0 and -1. In COM, the equivalent to FB's BOOLEAN is VARIANT_BOOL.
Thanks very much for the files. I will test them.
I have made the corrections for XP. Hope the next version will compile without problems. I already had used the AfxOpenFileDialog instead of the COM version.
I have fixed some typos in the tutorial and modified reply #2, in which I had repeated the code for the interface definition instead of the code to load the typelib.
> gauge32.ocx: with only ole automation interface (and events ole automation interface)
Can be loaded with a 32 bit of the browser. With 64 bit, it gives error TYPE_E_UNSUPFORMAT, that means that it has an older format not supported.
It has been usful to test the code that retrieves the alias names and the data members. Only very old VB6 OCXs use data members. If I remember well, these are shared (global) variables that can be retrieved directly using Automation, not vtable calls. Many years ago, Microsoft modified some of his OCXs adding properties to return these values and deprecated and advised against the use of data members.
> outgoing2.ocx: with only dispach interface (and events dispach interface)
Seems to work fine.
What I have to revise carefully is the code that decides if the parameter has to be passed by value (no problem) of by reference (something PTR or PTR PTR). Checking the indirection level and if it is an out parameter should be the way, but some buggy type libraries don't have the PARAMFLAG_FOUT set, and checking by name is only useful for IUnknown and IDispatch.
There are many buggy type libraries that don't have some flags set, I also found one that did not returned the return type of some properties, etc. In these cases, we can only make a guess.
Not sure if we may need an option to add a prefix. This was needed with PowerBASIC because it does not support leading underscores in the names. Maybe we can use a namespace instead, to avoid possible name conflicts.
Jose
help to compile:i imagine that comment in your code :
' $FB_RESPATH = "Resources/FBTLBRES.rc"is your own option to indicate in your adapted CSED editor where is the rc file
I've done the same with my own version using
_:[CSED_COMPIL_RC]: ./Resources/FBTLBRES.rc ' with ou without double quotes ! but i can imagine if someone is trying to compile the code, it will be a problem (with different ide)
the complete command line i use is the following :
Quote"c:\FreeBasic\FreeBASIC-1.05.0-win32\fbc.exe" -x "c:\FreeBasic\TLB_100\TLB_100.exe" -s gui -v TLB_100.bas "c:\FreeBasic\TLB_100\Resources\FBTLBRES.rc" > TLB_100.log 2>&1
replacing "c:\FreeBasic\FreeBASIC-1.05.0-win32\fbc.exe" by the full path to fbc.exe
and c:\FreeBasic\TLB_100\ by the path where is located the tlb project
can solve the problem (if any)
It was only a quick hack for using my partially adapted editor with FB. I'm using it until Paul will finish his WinFBE editor.
I don't want to make more editors. Too time consuming.
Jose
QuoteNot sure if we may need an option to add a prefix.
it is only depending on how you intend to provide the code:
if it will be a class with all in it ( methods/propreties/events...) and some flag to identify wich id/hwnd is used
when more than 1 of same object is used the prefix is not necessery but if it is not as complete , prefix is helpfull.
Maybe we can use a namespace insteadyou know i do not like namespace ;) , i know it is more professionnal but ...
make the decision, what you will choose , will be good (i am so happy , you are doing that job)
> you know i do not like namespace
Don't understand why. It is like adding a prefix. And it's easy to add it, change it or remove it. You don't know how many times I missed it in PowerBASIC.
> if it will be a class with all in it ( methods/propreties/events...) and some flag to identify wich id/hwnd is used
In the browser, I will add a class to parse the TreeView, that contains all the information extracted from the typelib. How the code will be geneated is not yet decided. Using the automation view to generate interface definitions and/or object macros like the ones provided in the FB headers is the less problematic way. Using abstract methods is problematic because the FB headers don't provide support for it.
There are also the problems of duplicates (this is why I want to use namespaces) and forward references (it is a one-pass compiler).
If you want you can start to generate code in the way that you like. All the information that you need is in the treeview, and it is much easier to parse a treeview than a typelib.
Added code to retrieve the default value of optional aprameters:
' // See if it has a default value
IF (pParam[y].paramdesc.wParamFlags AND PARAMFLAG_FHASDEFAULT) = PARAMFLAG_FHASDEFAULT THEN
DIM pex AS PARAMDESCEX PTR = pParam[y].paramdesc.pparamdescex
DIM cbsDefaultValue AS CBSTR = AfxVarToBstr(@pex->vardefaultvalue)
IF pex->vardefaultvalue.vt = VT_BSTR THEN
TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & CHR(34) & **cbsDefaultValue & CHR(34))
' cbstrFBSyntax += " = " & CHR(34) & **cbsDefaultValue & CHR(34)
ELSE
TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & cbsDefaultValue)
cbstrFBSyntax += " = " & cbsDefaultValue
END IF
END IF
The AfxVarToStr wrapper saves a lot of work. It avoids to have to check for the vartype and add code to extract the value for every type.
I have changed the code that sets the parameter name, data type and indirection to:
' // Parameter name, type and indirection
SELECT CASE **cbstrTypeKind
CASE "TKIND_INTERFACE", "TKIND_DISPATCH", "TKIND_COCLASS"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"
END IF
CASE "TKIND_RECORD", "TKIND_UNION", "TKIND_ENUM"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType
END IF
CASE ELSE
IF LEFT(**cbstrTypeKind, 11) = "TKIND_ALIAS" THEN
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType & " PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrVarType
END IF
ELSE
SELECT CASE **cbstrVarType
CASE "VT_UNKNOWN"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR"
END IF
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IUnknown PTR"
END IF
CASE "VT_DISPATCH"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR"
END IF
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS IDispatch PTR"
END IF
CASE "VT_VOID"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
IF ((wFlags AND PARAMFLAG_FOUT) = PARAMFLAG_FOUT) OR ((wFlags AND PARAMFLAG_FRETVAL) = PARAMFLAG_FRETVAL) THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR"
END IF
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ANY PTR"
END IF
CASE "VT_LPSTR"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ZSTRING PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS ZSTRING PTR"
END IF
CASE "VT_LPWSTR"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS WSTRING PTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS WSTRING PTR"
END IF
CASE "VT_BSTR"
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS BSTR"
END IF
CASE ELSE
IF wIndirectionLevel = 2 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword & " PTR PTR"
ELSEIF wIndirectionLevel = 1 THEN
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword & " PTR"
ELSE
cbstrFBSyntax = "BYVAL " & **cbstrParamName & " AS " & **cbstrFBKeyword
END IF
END SELECT
END IF
END SELECT
Hopefully it will work correctly.
TypeLib Browser Beta 02
Incorporates all the changes previously discussed and other small changes.
the beta 02 works perfectly !!!
continuing checking with the ocx/dll in my machine comparing with axsuite3 and with your tlb_501( pb version)
found one (where ? what? ) wich crashs your tlb_501
when option get run time key is on, but ok when get run time key is off
with the fb beta 02 works corectly but "get run time key" is not activated
so i've done the test whith the following modified code for fb (from your sleeping code)
' ========================================================================================
' Retrieves the license key for licensed controls.
' Note: As CoGetClassObject creates an unitialized instance of the server to access the
' IClassFactory2 interface, it can take some time with remote servers such as WSCRIPT.EXE.
' ========================================================================================
FUNCTION TLB_GetRuntimeLicenseKey (BYREF sInfo AS WSTRING) AS CWSTR
DIM hr AS HRESULT ' // HRESULT
DIM pIClassFactory2 AS IClassFactory2 PTR ' // IClassFactory2 interface
DIM ClassClsid AS CLSID ' // CLSID
DIM tLicInfo AS LICINFO ' // LICINFO structure
DIM cbstrLicKey AS CBSTR ' // License key
function = ""
' // Retrieve the CLSID from the PROGID or from the CLSID string of the component
IF INSTR(sInfo, "{") THEN CLSIDFromString(sInfo, @ClassClsid) ELSE CLSIDFromProgID(sInfo, @ClassClsid)
?sInfo
' // Get a pointer to the IClassFactory2 interface
'hr = CoGetClassObject(@ClassClsid, CLSCTX_SERVER, NULL, @IID_IClassFactory2, @pIClassFactory2)
hr = CoGetClassObject(@ClassClsid, CLSCTX_ALL, NULL, @IID_IClassFactory2, @pIClassFactory2)
'hr = CoGetClassObject(@ClassClsid, CLSCTX_INPROC_SERVER, NULL, @IID_IClassFactory2, @pIClassFactory2)
IF hr <> S_OK THEN exit function
?"step1 " & cast(integer,pIClassFactory2)
if cast(integer,pIClassFactory2)< 10000000 THEN
? "pIClassFactory2 = " & cast(integer,pIClassFactory2) : print "Quit TLB_GetRuntimeLicenseKey"
exit function
END IF
' // Fill the LICINFO structure
tLicInfo.cbLicInfo = SIZEOF(tLicInfo)
?"step2 " & SIZEOF(tLicInfo)
hr = IClassFactory2_GetLicInfo(pIClassFactory2, @tLicInfo)
?"step3"
' // If there is a runtime key available retrieve it
IF hr = S_OK THEN
IF tLicInfo.fRuntimeKeyAvail THEN
IClassFactory2_RequestLicKey(pIClassFactory2, 0, @cbstrLicKey)
?"cbstrLicKey = " & cbstrLicKey
if len(cbstrLicKey)= 36 THEN function = cbstrLicKey
END IF
END IF
?"last"
' // Release the interface
IClassFactory2_Release(pIClassFactory2)
END FUNCTION
' ========================================================================================
the function gets correctly the run time key on "good candidates" ,
i've reproduced the crash on the fb version too,
and noticed the pIClassFactory2 is the key point it is why i block it if cast(integer,pIClassFactory2)< 10000000
when it works the value is always bigger than 10000000 , problably something wrong on memory ?
last update : when uregistering an registering again the cast(integer,pIClassFactory2) value changed and now that filter is not ok
I'm not going to implement this feature. I had many problems with it, as you are experiencing, and it is not too useful because if you are a licensed user you already should have the license key.
Also be aware that some type libraries are buggy or corrupted. For example, bined.dll fails to retrieve an instance of the TYPEATTR structure with some members. It is not a bug in the browser: the same happens when you use OleView.exe.
TLB_100 Beta 03
Changed Prefix to Namespace.
Removed the "Code" toolbar button. Code is generated at the same time that the information is displayed in the TreeView. Therefore, you only need to click the "Code" tab to see it.
Added code generation (work in progress). Need to add code to retrieve the parameters.
Note: I have reuploaded the file because there was a duplicate line in the code that generates the code for enums. This caused to generate the "ENUM xxxx" line twice.
Added some changes to correctly identify the type of the parameters and a preliminary pass to identify the events interfaces and insert the data in the Events interfaces node.
What can't be detected are the vtable events interfaces. This .tlb stuff was designed by the VB6 team and, as VB6 can't use these kind of events, they didn't bother.
I'm thinking in doing the following...
If the "Automation view" option is checked, the interface definitions will use the syntax used in the FB headers, that is, no inheritance and listing all and every one of the methods, and using the BSTR and VARIANt data types.
If it is not checked, they will use unheritance and abstract methods, and instead of BSTR and VARIANT, CBSTR and CVARIANT. Using CBSTR instead of BSTR or AFX_BSTR allows to pass literal strings directly, instead of having to pass a variable, and even to use default string values in optional parameters. Of course, this means that my include files have to be used, but the FB headers don't provide support for abstract methods anyway.
Any thoughts?
To allow that, I have made an small change in a CBSTR constructor and LET operator that accept ansi strings (I had to do it anway) and added a new constructor to CVARIANT that accepts a variant passed by value:
' ========================================================================================
' Initializes the variant from a VARIANT.
' This consstructor allows a syntax like:
' DIM cv AS CVARIANT = TYPE<VARIANT>(VT_ERROR,0,0,0,DISP_E_PARAMNOTFOUND)
' ========================================================================================
PRIVATE CONSTRUCTOR CVariant (BYVAL v AS VARIANT)
CVARIANT_DP("CVARIANT CONSTRUCTOR - BYVAL VARIANT")
' // Load the PopsSys.DLL
psLib = DyLibLoad("propsys.dll")
' // Initialize the variant
VariantCopy(@vd, @v)
END CONSTRUCTOR
' ========================================================================================
This allows the use of temporary types for optional variant parameters, e.g.
SUB Foo (BYVAL cv AS CVARIANT = TYPE<VARIANT>(VT_ERROR,0,0,0,DISP_E_PARAMNOTFOUND))
and also have optional BSTR parameters
SUB Foo (BYVAL cbs AS CBSTR = "")
The only problem would be if the called method returns an array of BSTRs or VARIANTs. Still, we could use CBSTR and CVARIANT for all the other cases. I will first use BSTR and VARIANT and do tests to see if CBSTR and CVARIANT can be safely used.
Jose
some remarks :
on the
"abstract view" using IAnimation as example, to be coherent with the forward declaration
TYPE IAnimation AS IAnimation_ IAnimationVTbl shoud be IAnimation_
#ifndef __IAnimation_INTERFACE_DEFINED__
#define __IAnimation_INTERFACE_DEFINED__
TYPE IAnimationVTbl EXTENDS Afx_IDispatch ' should be : TYPE IAnimation_ EXTENDS Afx_IDispatch
DECLARE ABSTRACT FUNCTION put_AutoPlay () AS HRESULT
DECLARE ABSTRACT FUNCTION get_AutoPlay () AS HRESULT
...
END TYPEon the
"Automation view" using IMonthView as example,
we could simplify by using
Quoteextends IDispatchVtbl
the 7 functions are already defined on the fb headers, so we can avoid to add them
#ifndef __IMonthView_INTERFACE_DEFINED__
#define __IMonthView_INTERFACE_DEFINED__
TYPE IMonthViewVTbl extends IDispatchVtbl
'QueryInterface AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObj AS ANY PTR PTR) AS HRESULT
'AddRef AS FUNCTION (BYVAL this AS IMonthView PTR) AS ULONG
'Release AS FUNCTION (BYVAL this AS IMonthView PTR) AS ULONG
'GetTypeInfoCount AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL pctinfo AS UINT PTR) AS HRESULT
'GetTypeInfo AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
'GetIDsOfNames AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
'Invoke AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
get_Appearance AS FUNCTION (BYVAL pthis AS ANY PTR, BYVAL penumAppearances As AppearanceConstants Ptr) AS HRESULT
put_Appearance AS FUNCTION (BYVAL pthis AS AS ANY PTR, BYVAL penumAppearances As AppearanceConstants ) AS HRESULT
...
get_Year AS FUNCTION (BYVAL pthis AS ANY PTR, ByVal psYear As Short Ptr) AS HRESULT
put_Year AS FUNCTION (BYVAL pthis AS ANY PTR, ByVal sYear As Short) AS HRESULT
AboutBox AS FUNCTION (BYVAL pthis AS ANY PTR, ByVal DummyVAR As Byte = 0) AS HRESULT ' adding DummyVAR variable
...
END TYPEwe can also use ANY PTR , every where to replace the IMonthView PTR ( in that case)
we can also avoid the long list of #define ...
as :
#define IMonthView_put_Week(this) (this)->lpVtbl->put_Week(this)
#define IMonthView_get_Year(this, pYear) (this)->lpVtbl->get_Year(this, pYear)
#define IMonthView_put_Year(this, Year) (this)->lpVtbl->put_Year(this, Year)
#define IMonthView_AboutBox(this) (this)->lpVtbl->AboutBox(this)just by putting only 1 (for all classes) generic variadic define like the following
#Define Ax_Vt(a, b, arg...) a->lpvtbl->b(a,arg) ' easiest way to adress vtable function with argumentit works every where except when arg is empty ( that's the case here on AboutBox)
for these cases when no argument : it is simply to add a dummy variable like the following in the class\type
AboutBox AS FUNCTION (BYVAL pthis AS ANY PTR, ByVal DummyVAR As Byte = 0) AS HRESULT ' adding DummyVAR variablethat dummy argument as no effect, but the variadic function will always work fine with that workarround!
so usage example :
'using vtable interface
DIM pMV2 AS IMonthView ptr = cast(any PTR , MyOleCon2.OcxDispPtr)
DIM year AS short
IF pMV2 THEN
'pMV2->lpvtbl->Refresh(pMV2)
'pMV2->lpvtbl->AboutBox(pMV2)
'pMV2->lpvtbl->put_Year(pMV2 , 1985)
'pMV2->lpvtbl->put_Month(pMV2 , 4)
'pMV2->lpvtbl->put_Day(pMV2 , 21)
'pMV2->lpvtbl->Get_Year(pMV2 , @year)
Ax_Vt(pMV2, AboutBox)
Ax_Vt(pMV2, Refresh)
Ax_Vt(pMV2, put_Year, 1985)
Ax_Vt(pMV2, put_Month, 4)
Ax_Vt(pMV2, put_Day, 21)
Ax_Vt(pMV2, get_Year, @year)
end ifjust to avoid the pMV2->lpvtbl->put_Year(pMV2 , 1985) complex form
remarks on parameters
taking the previous sample usage 'using vtable interface
DIM pMV2 AS IMonthView ptr = cast(any PTR , MyOleCon2.OcxDispPtr)
DIM year AS short
IF pMV2 THEN
'pMV2->lpvtbl->Refresh(pMV2)
'pMV2->lpvtbl->AboutBox(pMV2)
'pMV2->lpvtbl->put_Year(pMV2 , 1985)
'pMV2->lpvtbl->put_Month(pMV2 , 4)
'pMV2->lpvtbl->put_Day(pMV2 , 21)
'pMV2->lpvtbl->Get_Year(pMV2 , @year)
Ax_Vt(pMV2, AboutBox)
Ax_Vt(pMV2, Refresh)
Ax_Vt(pMV2, put_Year, 1985)
Ax_Vt(pMV2, put_Month, 4)
Ax_Vt(pMV2, put_Day, 21)
Ax_Vt(pMV2, get_Year, @year)
end if
what surprise me, is works in input using direct values (without variable)
and more surprising, on ouput, just giving the pointer of the variable to get the result
I was thinking the exchange as to be throught Variant, is it some implicit cast to work directly ?
it even could be simplyfied if on the type\class we use as : with byref on the out parameter
get_Year AS FUNCTION (BYVAL pthis AS ANY PTR, ByRef sYear As Short) AS HRESULT
in that the usage could be just
'pMV2->lpvtbl->Get_Year(pMV2 , year)
Ax_Vt(pMV2, get_Year, year)
and it works !
on the "Automation view" using IMonthView as example,
we could simplify by using
extends IDispatchVtbl
the 7 functions are already defined on the fb headers, so we can avoid to add them
We can't do that. If we use extends, we have to use abstract methods. Choose the VTable option by unchecking the Automation view.
Quote
we can also avoid the long list of #define ...
just by putting only 1 (for all classes) generic variadic define like the following
Variadic functions don't work in FB 64-bit. Bad news for the variadic "aficionados" still working with XP. Sorry.
> and it works !
Of course it works, but we aware that if you use an initialized CBSTR or CVARIANT type, you must clear them first with <CBSTR name>.Clear / <CVARIANT>.Clear before passing the address to an OUT parameter or you will get a memory leak. I have exaplained it in another thread.
And I mean calling .Clear, not setting it to empy with <CBSTR Name> = "".
<CBSTR name>.Clear frees the underlying BSTR and sets the pointer to null, whereas <CBSTR Name> = "" creates an empty but valid BSTR. Empty BSTRs are needed with some COM methods that require it instead of a null pointer.
<CVARIANT>.Clear calls VariantClear.
I have almost finished the code to retrieve the parameters. There are still a few mistakes. There are also some problems with reserved words like Property and Delete.
Jose you said
QuoteWhat can't be detected are the vtable events interfaces.
in the treeview you see them on CoClasses : checked with outgoing2.ocx on my previous post
so it can be deployed if needed, with a specific treatment , i can imagine,
what i don't know is firing that vtables events interfaces.
The code button : good choice
may I ask for an little evolution :
when changing the "Ole Automation view" option, it could be nice, the tree info and the code be regenerated
QuoteVariadic functions don't work in FB 64-bit. Bad news for the variadic "aficionados" still working with XP. Sorry.
i agree with functions, its seems because of gen c option , but is it the same with variadic define ?
I have done previously some c coding on a 64 machine and variadic define were working well...
if you are right, i am happy to be with xp :D
> I have done previously some c coding on a 64 machine and variadic define were working well...
C works, but FB not.
> if you are right, i am happy to be with xp :D
But your code won't be useful to 64 bit users.
> in the treeview you see them on CoClasses : checked with outgoing2.ocx on my previous post
Only the default events interfaces can be detected, but not other additional events interfaces.
For example, ADO has two dispatch events interfaces, ConnectionEvents and RecordsetEvents, but also two VTable events interfaces, ConnectionEventsVt and RecordsetEventsVt. As VB6 can't use the VTable ones, they haven't bothered to flag the others as event interfaces. They could have done it, but they don't care.
> what i don't know is firing that vtables events interfaces.
In the webbrowser examples that I have posted there is a vtable events interface, IDocHostUiHandler.
Connecting events with these interfaces depends on the way chosen by the programmer of the COM server or OCX. Sometimes using a connetion point, but most of the times calling and ad hoc method provided by one interface.
In the case of the WebBrowser control...
' ========================================================================================
' Sets our implementation of the IDocHostUIHandler interface to customize the WebBrowser.
' ========================================================================================
PRIVATE FUNCTION CWebBrowser.SetUIHandler () AS HRESULT
CWB_DP("-BEGIN CWebBrowser.SetUIHandler")
' // After the MSHTML document has been loaded, we retrieve a reference to its
' // ICustomDoc interface and give him a pointer to our IDocHostUIHandler interface
' // to allow for customization.
IF m_pWebBrowser = NULL THEN RETURN E_POINTER
' // Get a reference to the active document
DIM pIHTMLDocument2 AS IHTMLDocument2 PTR
DIM pDispatch AS IDispatch PTR
m_pWebBrowser->get_Document(@pDispatch)
pIHTMLDocument2 = cast(IHTMLDocument2 PTR, pDispatch)
IF pIHTMLDocument2 = NULL THEN EXIT FUNCTION
' // Get a reference to the CustomDoc interface
DIM pICustomDoc AS ICustomDoc PTR
' extern IID_ICustomDoc is broken and causes the linker to fail
' IID_ICustomDoc = "{3050F3F0-98B5-11CF-BB82-00AA00BDCE0B}"
DIM IID_ICustomDoc_ AS GUID = (&h3050F3F0, &h98B5, &h11CF, {&hBB, &h82, &h00, &hAA, &h00, &hBD, &hCE, &h0B})
pIHTMLDocument2->lpvtbl->QueryInterface(pIHTMLDocument2, @IID_ICustomDoc_, @pICustomDoc)
IUnknown_Release(pIHTMLDocument2)
IF pICustomDoc = NULL THEN EXIT FUNCTION
' // Create an instance of the IDocHostUIHandler class
IF m_pIDocHostUIHandler = NULL THEN m_pIDocHostUIHandler = NEW CDocHostUIHandler2Impl
' // Set our IDocHostUIHandler interface for MSHTML
' // MSHTML will release its previous IDocHostUIHandler interface
' // (if one is present) and call pDocHostUIHandler's AddRef method.
IF m_pIDocHostUIHandler THEN pICustomDoc->lpvtbl->SetUIHandler(pICustomDoc, _
cast(IDocHostUIHandler PTR, cast(ULONG_PTR, m_pIDocHostUIHandler)))
IUnknown_Release(pICustomDoc)
CWB_DP("-END CWebBrowser.SetUIHandler")
END FUNCTION
' ========================================================================================
So, if you were thinking in something consistent, like Advise / Unadvise, you will be disappointed.
VB6 imposed a series of strict rules for events interfaces in OCXs, like inheriting from IDispatch, using a connection point and a default events interface. This way, its IDE could know which interface to use and how to use it. Low-level COM is another world.
> The code button : good choice
It runs so fast that not code or stop buttons are needed, and I like GUIs simple.
> may I ask for an little evolution :
> when changing the "Ole Automation view" option, it could be nice, the tree info and the code be regenerated
Done.
BTW. How look the toolbar icons in your XP?
QuoteOnly the default events interfaces can be detected, but not other additional events interfaces.
For example, ADO has two dispatch events interfaces, ConnectionEvents and RecordsetEvents, but also two VTable events interfaces, ConnectionEventsVt and RecordsetEventsVt. As VB6 can't use the VTable ones,
yes i can see them, to mark them as event interface in tlb, it could be a specific treatment
as most case the name is something....events... , it could be possible to check the name to correctly affect them
but in most case if you already have the dispach ones is enougth.
Thanks also for the sample, how to fire the vtable events , i have to study it more deeply
( i must definively admit my knowledge on COM is just at the surface )
as requested
my toolbar in xp
may i insist in the
extends IDispatchVtblTYPE IMonthViewVTbl extends IDispatchVtbl
'QueryInterface AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObj AS ANY PTR PTR) AS HRESULT
'AddRef AS FUNCTION (BYVAL this AS IMonthView PTR) AS ULONG
'Release AS FUNCTION (BYVAL this AS IMonthView PTR) AS ULONG
'GetTypeInfoCount AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL pctinfo AS UINT PTR) AS HRESULT
'GetTypeInfo AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
'GetIDsOfNames AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
'Invoke AS FUNCTION (BYVAL this AS IMonthView PTR, BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
get_Appearance AS FUNCTION (BYVAL pthis AS ANY PTR, BYVAL penumAppearances As AppearanceConstants Ptr) AS HRESULT
put_Appearance AS FUNCTION (BYVAL pthis AS AS ANY PTR, BYVAL penumAppearances As AppearanceConstants ) AS HRESULT
...chm help file info extractQuote
Extends declares typename to be derived from base_typename. The derived user-defined type, typename, inherits fields and methods of the base_typename base type. typename objects may be used in place of base_typename objects. Fields and methods inherited from base_typename will be implicitly accessible like regular members of typename.
However, a regular member will shadow an inherited member if they have the same identifier. The Base (Member Access) keyword can be used to explicitly access members of the base type shadowed by local members.
User-defined types that extend another type will include the base type structure at their beginning,
for abstract/virtual methods the class must inherit from
Object , but here we don't need to inherit from Object
just inherit from IDispatchVtbl is enougth because we don't use abstract/virtual way. but it can save 7 lines on each class
You can experience it with the sample file, i've sent to you directly ( olecon_test3 with 2 calendars...)
It doesn't matter. We don't have to type them. Besides, I'm not going to use it. I prefer to use abstract methods.
Completed the code generation.
Current problems: Possible conflicts with interface names and FB keywords.
Some interface declarations, structures, etc. may need to me moved because it is a one-pass compiler.
Quote from: Marc Pons on September 17, 2016, 10:20:23 AM
QuoteOnly the default events interfaces can be detected, but not other additional events interfaces.
For example, ADO has two dispatch events interfaces, ConnectionEvents and RecordsetEvents, but also two VTable events interfaces, ConnectionEventsVt and RecordsetEventsVt. As VB6 can't use the VTable ones,
yes i can see them, to mark them as event interface in tlb, it could be a specific treatment
as most case the name is something....events... , it could be possible to check the name to correctly affect them
but in most case if you already have the dispach ones is enougth.
Thanks also for the sample, how to fire the vtable events , i have to study it more deeply
( i must definively admit my knowledge on COM is just at the surface )
In the CoClass for the ADO connection interface they have used
coclass Connection {
[default] interface _Connection;
[default, source] dispinterface ConnectionEvents;
};
If they had used
coclass Connection {
[default] interface _Connection;
[default, source] dispinterface ConnectionEvents;
[source] interface ConnectionEventsVt;
};
Both will be retrievable. The dispatch one as the default to satisfy VB6 and other Automation tools.
2 more ocx/dll i've tested ( coming from autocad)
i noticed, failing finding parameters / interfaces
they work correctly with your tlb_501 and my axsuite3
Quote> may I ask for an little evolution :
> when changing the "Ole Automation view" option, it could be nice, the tree info and the code be regenerated
Done.
it's true but if opened a file from disk, if you change the option,
you loose the reference to the opened file and you regenerate the tree and code for the typelib pointed on the typelib list
Yes, I don't like to mess the code using globals. I will see if I can do something about it.
Quote from: Marc Pons on September 17, 2016, 12:46:18 PM
2 more ocx/dll i've tested ( coming from autocad)
i noticed, failing finding parameters / interfaces
they work correctly with your tlb_501 and my axsuite3
There is missing code. I will revise it later, after I sleep a little.
TypeLib Browser 1.0, Beta 06
Lets see if this one works fine.
TypeLib Browser, Beta 07
> it's true but if opened a file from disk, if you change the option, you loose the reference to the opened file and you regenerate the tree and code for the typelib pointed on the typelib list
With this version, when you load a type library from disk, it is added temporalily to the ListView, allowing to change views.
I also have implemented the save code option.
in beta 7
in tlb_100.bas line 152 missing & ")" at the end of line
DIM wszDesc AS WSTRING * MAX_PATH = pParseLib->m_LibHelpString & " (Ver" & WSTR(pParseLib->m_LibMajorVersion) & "." & WSTR(pParseLib->m_LibMinorVersion)& ")"
in tlb_parselib.inc
on "#defines ...
lines 2023;2024;2025 & 2164;2165;2166 missing at the end of line & chr(13,10)
for tlb_100.bas , i'm proposing
' // Save generated code to disk
CASE IDM_SAVE
DIM wszFile AS WSTRING * 260 = "*.BI"' "*.INC"
DIM wszInitialDir AS STRING * 260 = CURDIR
'DIM wszFilter AS WSTRING * 260 = "FB code files (*.BAS,*.INC,*.BI)|*.BAS,*.INC,*.BI|" & "Text files (*.TXT)|*.TXT|" & "All Files (*.*)|*.*|"
DIM wszFilter AS WSTRING * 260 = "FB code files (*.BI,*.INC,*.BAS)|*.BI,*.INC,*.BAS|" & "Text files (*.TXT)|*.TXT|" & "All Files (*.*)|*.*|"
DIM dwFlags AS DWORD = OFN_EXPLORER OR OFN_FILEMUSTEXIST OR OFN_HIDEREADONLY OR OFN_OVERWRITEPROMPT
DIM cwsFile AS CWSTR = AfxSaveFileDialog(hwnd, "", wszFile, wszInitialDir, wszFilter, "BI", @dwFlags) ' INC
in that case is more a .bi file and if the user give the name without extension the bi will be default
code generation issue
using the AdDynHelp1.ocx (see on the previous rar )
still missing code interface on both views ,
the tree view shows the interface but the normally 2 methods have the same offest 0 in both views
Quote
code generation issue
using the AdDynHelp1.ocx (see on the previous rar )
still missing code interface on both views ,
the tree view shows the interface but the normally 2 methods have the same offest 0 in both views
There is nothing to generate. It is a dispatch only interface and can only be called using Invoke.
Made an small change in the GetParameters function of TLB_ParseLib.inc.
IF pex->vardefaultvalue.vt = VT_BSTR THEN
TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & CHR(34) & **cbsDefaultValue & CHR(34))
' cbstrFBSyntax += " = " & CHR(34) & **cbsDefaultValue & CHR(34)
ELSE
TreeView_AddItem(hTreeView, hParamNameNode, NULL, "Default value = " & cbsDefaultValue)
' // Some typelibs have unprintable default values, e.g. wbemdisp.tlb,
' // that has unprintable IDispatch PTR values.
IF LEN(cbsDefaultValue) THEN cbstrFBSyntax += " = " & cbsDefaultValue
END IF
In the GetFunctions method, the line
TreeView_AddItem(hTreeView, hSubNode2, NULL, "DispID = " & WSTR(@pFuncDesc->memid) & " [&h" & HEX(pFuncDesc->memid, 8) & "]")
should be
TreeView_AddItem(hTreeView, hSubNode2, NULL, "DispID = " & WSTR(pFuncDesc->memid) & " [&h" & HEX(pFuncDesc->memid, 8) & "]")
New class: CDispInvoke
Allows to call methods and properties of dispatch or dual interfaces through IDispatch.Invoke. Not tested extensively yet.
In the example of the MonthView calendar, we can use:
DIM pdisp AS CDispInvoke = pOleCon->OcxDispPtr
pdisp.Put("Year", 1985)
pdisp.Put("Month", 4)
pdisp.Put("Day", 21)
DIM year AS LONG = pdisp.Get("Year")
print year
DIM month AS LONG = pdisp.Get("Month")
print month
DIM day AS LONG = pdisp.Get(&h1) ' // Using the dispid instead of the name
print day
I'm using overloaded methods with a different number of parameters because variadic functions don't work with the 64-bit compiler.
See update in reply #62.
Added additional constructors, methods and operators to the CDispInvoke class.
A few additional changes. Usage will tell if more additional changes are needed.
My proposal evolution of your CDispInvolke class
just changed :
m_varResult AS CVARIANT
DECLARE FUNCTION GetVarResult () AS CVARIANT
PRIVATE FUNCTION CDispInvoke.GetVarResult () AS CVARIANT
RETURN m_varResult
END FUNCTION
the idea is because the CVARIANT class is more flexible:
with implicit cast in input and implicit cast in ouput
it would be better to use CVARIANT instead of VARIANT
if VARIANT is needed , CVARIANT will implicitly cast to it
it will simplify the code
My evolution of the TLB_100 Beta 9.1
added the helper functions to ease when dispatch interface only
only the File: TLB_ParseLib.inc is changed, and notice the generated include is now :
'cwsCode += "#include once " & CHR(34) & "Afx/AfxCOM.inc" & CHR(34) & CHR(13, 10) & CHR(13, 10)
cwsCode += "#include once " & CHR(34) & "Afx/CDispInvoke.inc" & CHR(34) & CHR(13, 10) & CHR(13, 10)
because CDispInvoke.inc includes AfxCOM.inc
and i took advantage of the modified CDispInvoke.inc as posted on last post to avoid explicit cast
plus that line on save code in TLB_100.bas
DIM wszFilter AS WSTRING * 260 = "FB code files (*.bas,*.inc,*.bi)|*.bi;*.inc;*.bas|" & "Text files (*.txt)|*.txt|" & "All Files (*.*)|*.*|"
the order is now: .bi;*.inc;*.bas
to insure .bi extension default, when the user do not put the extension
to test the dispatch wrapper sub/functions it is included an ocx to test the generation : AcCtrls.ocx
Quote from: Marc Pons on September 22, 2016, 02:44:55 PM
My proposal evolution of your CDispInvolke class
just changed :
m_varResult AS CVARIANT
DECLARE FUNCTION GetVarResult () AS CVARIANT
PRIVATE FUNCTION CDispInvoke.GetVarResult () AS CVARIANT
RETURN m_varResult
END FUNCTION
the idea is because the CVARIANT class is more flexible:
with implicit cast in input and implicit cast in ouput
it would be better to use CVARIANT instead of VARIANT
if VARIANT is needed , CVARIANT will implicitly cast to it
it will simplify the code
[it will simplify the code] at the cost of more overhead. Returning it as a CVARIANT implies to copy the data twice, since the compiler has to create a temporary copy.
I avoid to use the new class-based data types in the internal code of a wrapper function as much as possible because they add overhead.
And it doesn't offer any advantage in this case, because you just can do DIM cv AS CVARIANT = pInvoke.GetVarResult. But returning it as a VARIANT is more efficient.
> added the helper functions to ease when dispatch interface only
Sorry, but I don't understand the convenience of it.
Why to generate a wrapper like
Private Function _DDoubleUnitEdit_Get_UnitWidth(BYREF Disp AS CDispInvoke) AS LONG
Disp.DispInvoke(DISPATCH_PROPERTYGET, "UnitWidth", NULL, 0, LOCALE_USER_DEFAULT)
return disp.m_varResult
End Function
When we can simply use
DIM x AS LONG = pDisp.Get("UnitWidth")
There is not need for declarations or wrappers to use CDispInvoke. Just call the methods Get, Put, PutRef or Invoke (I would have liked to name it Call, but it is a reserved word). In fact, Get isn't needed, because Invoke can be used instead of it. CDispInvoke can be used both with dispatch only interfaces an dual interfaces (useful if you don't have declares; if you have declares, direct vtable calls are faster).
Quote from: Jose Roca on September 22, 2016, 05:14:10 PM
When we can simply use
DIM x AS LONG = pDisp.Get("UnitWidth")
i aggree with you , generally speaking it is not needed , but its convenient at least in one sens:
you will have the list of all param/methods and also what number and kind of types you need .
if you don't generate something , in fact you do not see, the params /methods /types outside of the tree view wich it is very complete, but quite difficult to read.
the advantage of the generated code is : simply use what you need
that can help the non-experts on COM( as i consider to be)
it is the same idea as the list of #define ... you provide with vtable view
not really needed but helpfull , and as you said , the user will not write it , it is done by the tlb browser.
I was generating these on the generic form ( no using : get or put , just invoke) , also as guide to your CDispInvolke class
when you said, for dispatch only interface " nothing to generate"
i was thinking, it is too short ( ok for experts ) : at least the list of params , methods with types is needed !
when exploring it , i think the extra lines generated are not a big load, not too long to produce
and in place of the list of params/methods with types it is more convenient to get subs/functions immediatly usable
I have not considered the creation of a class collecting everything, just to avoid more extra lines... and because in fact
the usage is just like that (using the same generated sample)
DIM x AS LONG = _DDoubleUnitEdit_Get_UnitWidth(Disp)anyhow , that generation code is done ...
note : you also noticed the dual interfaces can also use the invoke, i've decided to not generate that part , the vtable or abstract methods are enougth , the dispatch only interface is a different story.
Quote from: Jose Roca on September 22, 2016, 04:29:49 PM
[it will simplify the code] at the cost of more overhead. Returning it as a CVARIANT implies to copy the data twice, since the compiler has to create a temporary copy.
I avoid to use the new class-based data types in the internal code of a wrapper function as much as possible because they add overhead.
And it doesn't offer any advantage in this case, because you just can do DIM cv AS CVARIANT = pInvoke.GetVarResult. But returning it as a VARIANT is more efficient.
ok no problem :
if it not a copy inside the class it will be a copy outside the class, the class will not suffer of overhead but the resulting information will need to be casted explicitly , or converted externally for all types except variant.
Quote
if it not a copy inside the class it will be a copy outside the class, the class will not suffer of overhead but the resulting information will need to be casted explicitly , or converted externally for all types except variant.
The Get and Invoke methods of the class already return it as a CVARIANT. You don't need to use GetVarResult for anything. I simply have added it for completeness. In case of need, it is faster to access m_VarResult directly. If it is important to you, I can change the return type to CVARIANT: I don't care, since I will never use it. What I'm not going to change is m_VarResult to a CVARIANT. It will add unneeded overhead.
With the exception of CWSTR, using class-based data types like CBSTR or CVARIANT inside wrapper functions is very inneficient. For each change, they have to copy all the data.
Therefore, in a wrapper like this
PRIVATE PROPERTY CAdoRecordset.Source () AS CVARIANT
DIM vSource AS VARIANT
IF m_pRecordset THEN SetResult(m_pRecordset->get_Source(@vSource))
PROPERTY = vSource
VariantClear(@vSource)
END PROPERTY
although I return a CVARIANT, internally I use a variant.
If I use
PRIVATE PROPERTY CAdoRecordset.Source () AS CVARIANT
DIM cvSource AS CVARIANT
IF m_pRecordset THEN SetResult(m_pRecordset->get_Source(@cvSource))
PROPERTY = cvSource
END PROPERTY
the compiler has to create a temporary copy of cvSource to return it.
If it is important to you, I can change the return type to CVARIANT
no, please let as it is, i completly accept your choice, if needed it will be easy to cast outside
Quote
if you don't generate something , in fact you do not see, the params /methods /types outside of the tree view wich it is very complete, but quite difficult to read.
the advantage of the generated code is : simply use what you need
that can help the non-experts on COM( as i consider to be)
I don't think that a list of parameters will suddenly enlighten you about how to use an object. You will have to read the documentation for that, no matter if you generate useless wrappers or not.
Quote
it is the same idea as the list of #define ... you provide with vtable view
not really needed but helpfull , and as you said , the user will not write it , it is done by the tlb browser.
These are only generated when using the Automation view, to emulate the ones available in the FB headers. I will use only abstract methods.
Quote from: Marc Pons on September 23, 2016, 03:38:48 PM
If it is important to you, I can change the return type to CVARIANT
no, please let as it is, i completly accept your choice, if needed it will be easy to cast outside
I will change it. I only have to add a "C" and, as I said, I don't care, because I will never use it.
Done.