CWindow RC06

[José Roca]

Another COM example: Embedded Explorer Browser control.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: CW_ExplorerBrowser.fbtpl
' Contents: Resizable CWindow with an embedded Explorer Browser control
' 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 _WIN32_WINNT &h0602
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "win/shlobj.bi"
#INCLUDE ONCE "Afx/CWindow.inc"

USING Afx.CWindowClass

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)

' ========================================================================================
' Window procedure
' ========================================================================================
FUNCTION WndProc (BYVAL hWnd AS HWND, BYVAL uMsg AS UINT, BYVAL wParam AS WPARAM, BYVAL lParam AS LPARAM) AS LRESULT

   DIM pWindow AS CWindow PTR, rc AS RECT
   STATIC peb AS IExplorerBrowser PTR

   SELECT CASE uMsg

      CASE WM_CREATE
         ' // Get a pointer to the CWindow class
         DIM pCreateStruct AS CREATESTRUCT PTR = CAST(CREATESTRUCT PTR, lParam)
         DIM pWindow AS CWindow PTR = CAST(CWindow PTR, pCreateStruct->lpCreateParams)
         ' // Add a button control
         IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close")
         ' // Create an instance of IExplorerBrowser
         CoCreateInstance(@CLSID_ExplorerBrowser, NULL, CLSCTX_INPROC_SERVER, @IID_IExplorerBrowser, @peb)
         IF peb = NULL THEN EXIT FUNCTION
         peb->lpVtbl->SetOptions(peb, EBO_SHOWFRAMES)
         DIM fs AS FOLDERSETTINGS
         fs.ViewMode = FVM_DETAILS
         DIM rc AS RECT
         GetClientRect hwnd, @rc
         peb->lpVtbl->Initialize(peb, hwnd, @rc, @fs)
         ' // Navigate to the Profile folder
         DIM pidlBrowse AS LPITEMIDLIST
         IF SUCCEEDED(SHGetFolderLocation(NULL, CSIDL_PROFILE, NULL, 0, @pidlBrowse)) THEN
            peb->lpVtbl->BrowseToIDList(peb, pidlBrowse, 0)
            ILFree(pidlBrowse)
         END IF
         EXIT FUNCTION

      CASE WM_COMMAND
         ' // If ESC key pressed, close the application sending an WM_CLOSE message
         SELECT CASE LOWORD(wParam)
            CASE IDCANCEL
               IF HIWORD(wParam) = BN_CLICKED THEN
                  SendMessageW hwnd, WM_CLOSE, 0, 0
                  EXIT FUNCTION
               END IF
         END SELECT

      CASE WM_SIZE
         IF wParam <> SIZE_MINIMIZED THEN
            ' // Resize the controls
            pWindow = CAST(CWindow PTR, GetWindowLongPtr(hwnd, 0))
            pWindow->MoveWindow GetDlgItem(hwnd, IDCANCEL), pWindow->ClientWidth - 90, pWindow->ClientHeight - 35, 75, 23, CTRUE
            ' // Resize the Explorer control
            GetClientRect hwnd, @rc
            rc.Right -= 210
            IF peb THEN peb->lpVtbl->SetRect(peb, NULL, rc)
         END IF

    CASE WM_DESTROY
         IF peb THEN
            ' // Destroy the browser and release the interface
            peb->lpVtbl->Release(peb)
            peb->lpVtbl->Release(peb)
         END IF
         PostQuitMessage(0)
         EXIT FUNCTION

   END SELECT

   FUNCTION = DefWindowProcW(hWnd, uMsg, wParam, lParam)

END FUNCTION
' ========================================================================================

' ========================================================================================
' 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
   AfxSetProcessDPIAware

   ' // Initialize the COM library
   CoInitialize NULL

   DIM pWindow AS CWindow
   pWindow.Create(NULL, "CWindow with an embedded Explorer Browser", @WndProc)
   pWindow.Brush = GetStockObject(WHITE_BRUSH)
   pWindow.SetClientSize(500, 320)
   pWindow.Center

   

   FUNCTION = pWindow.DoEvents(nCmdShow)

   ' // Uninitialize the COM library
   CoUninitialize

END FUNCTION
' ========================================================================================


[Paul Squires]

The more satisfactory method is the CBStr class that I wrote, although can't be used to create temporary BSTRs on the fly because of memory leaks.

Hi Jose, I am at work right now so I am only reading your posts and can't do much with them at the moment. Question: Couldn't the CBStr class simply clean up any allocated memory (from SysAllocString?) in the class's DESTRUCTOR. When the class goes out of scope the Destructor should be called and then the allocated memory freed?

[James Fuller]

I don't know if this is feasable but BCX,bc9 use a circular buffer for temporary strings:

Code Select Expand


#ifndef BCXTmpStrSize
#define BCXTmpStrSize  2048
#endif
char *BCX_TmpStr (size_t Bites, size_t  iPad, int iAlloc)
{
    static int   StrCnt;
    static char *StrFunc[BCXTmpStrSize];
    StrCnt = (StrCnt + 1) & (BCXTmpStrSize - 1);
    if(StrFunc[StrCnt]) {
        free (StrFunc[StrCnt]);
        StrFunc[StrCnt] = NULL;
    }
#if defined BCX_MAX_VAR_SIZE
    if(Bites * sizeof(char) > BCX_MAX_VAR_SIZE)
    {
        printf("Buffer Overflow caught in BCX_TmpStr - requested space of %d EXCEEDS %d\n", (int)(Bites * sizeof(char)), BCX_MAX_VAR_SIZE);
        abort();
    }
#endif
    if(iAlloc) StrFunc[StrCnt] = (char*)calloc(Bites + iPad + 1, sizeof(char));
    return StrFunc[StrCnt];
}



Called from the internal LEFT$ function like this:

Code Select Expand


char *left (const char *S, int length)
{
    register int tmplen = strlen(S);
    if(length < 1) return BCX_TmpStr(1, 0, 1);
    if(length < tmplen) tmplen = length;
    char *strtmp = BCX_TmpStr(tmplen, 1, 1);
    return (char*)memcpy(strtmp, S, tmplen);
}



James

[aloberr]

Speaking about COM code  with the abstract interfaces, I do what you do today of then more than Two years, your reputation will make perhaps change the things. 
So that that things goes more quickly , looks at what I did in FREEBASIC forum , inside COM with feebasic, other share I have tons of code for this purpose. 
Considering what you did with POWERBASIC, it is an honor which you makes it with FREEBASIC, I same already translated your comBrowsher into Freebasic.

[aloberr]

your web container don't work for me
look at this small api code:

Code Select Expand

#include Once "windows.bi"
#include Once "win/ole2.bi"
#Include Once "win/ExDisp.bi"

Extern "windows" lib "atl" 
Declare Function AtlAxAttachControl(As IUnknown Ptr, As HWND,As IUnknown Ptr Ptr) As HRESULT
End Extern



Dim Shared As HWND hconteneur ' Déclaration du HWND de notre conteneur en global:


Function WndProc(hWnd As HWND ,msg As UINT ,wParam As WPARAM ,lParam As LPARAM  )As LRESULT

Select Case(msg)

case WM_SIZE:
' Redimensionnement du conteneur quand la taille de la fenêtre change:
MoveWindow(hconteneur,0,0,LOWORD(lParam), HIWORD(lParam),1)


case WM_CLOSE:
DestroyWindow(hWnd)


case WM_DESTROY:
PostQuitMessage(0)
Return 0

Case Else:
return DefWindowProc(hWnd, msg, wParam, lParam)
End Select
return 0
End Function



Function WinMain(hInst As HINSTANCE ,hPreInst As HINSTANCE ,lpszCmdLine As LPSTR , nCmdShow As Integer )As Integer

' Déclarer notre classe de fenêtre et définir ses membres:
Dim As WNDCLASS wc
Dim As ZString ptr NomClasse     = @"Conteneur"
wc.lpszClassName = NomClasse
wc.hInstance = hInst
wc.lpfnWndProc = @WndProc
wc.hCursor = LoadCursor( 0, IDC_ARROW )
wc.hIcon = LoadIcon( 0, IDI_APPLICATION )
wc.lpszMenuName     = 0
wc.hbrBackground = 0
wc.style = 0
wc.cbClsExtra = 0
wc.cbWndExtra = 0
' Enregistrer la classe de notre fenêtre:
if (0=RegisterClass(@wc))Then return 0

' Créer notre fenêtre principale:
Dim As HWND hWnd = CreateWindow( NomClasse,"Conteneur Activex",WS_OVERLAPPEDWINDOW,0,0,800,575, 0, 0, hInst,0)
' Montrer la fenêtre:
ShowWindow(hWnd, nCmdShow )
UpdateWindow( hWnd )


' Obtenir les dimensions de notre fenêtre:
Dim As RECT rect
GetClientRect(hWnd,@rect)
' Créer l'EDIT qui servira de conteneur Activex:
hconteneur=CreateWindowEx(WS_EX_CLIENTEDGE,"EDIT","",WS_CHILD Or WS_VISIBLE,0,0,rect.right,rect.bottom,hWnd,0,0,0)
' Initialiser la librairie COM pour notre programme:
CoInitialize(0)
' Déclarer un pointeur sur l'interface IWebBrowser2:
Dim As IWebBrowser2   Ptr pIwb
' Créer une instance de l'objet WebBrowser et de l'interface IWebBrowser2:
CoCreateInstance(@CLSID_WebBrowser,0,CLSCTX_ALL,@IID_IWebBrowser2,cast(lpvoid Ptr,@pIwb))
' Attacher l'objet WebBrowser à notre EDIT conteneur:
AtlAxAttachControl(pIwb,hconteneur,0)
' Lancer la page de démarrage:
pIwb->lpvtbl->GoHome(pIwb)

' Boucle des messages:
Dim As MSG Msg
while( GetMessage(@Msg, 0, 0, 0))
TranslateMessage( @Msg )
DispatchMessage( @Msg )
Wend

' Libérer l'interface IWebBrowser2:
pIwb->lpvtbl->Release(pIwb)
' Fermer la librairie COM pour notre programme:
    CoUninitialize()

' Quitter le programme:
return  Msg.wParam
End Function
End WinMain(getmodulehandle(0),NULL,Command,SW_SHOW)

[José Roca]

If you did it more that two years ago, they should have used it in the translated headers and explained it in the help file.

Looking at the C++ headers, we can see that they have declaratons for C++, ansi C and macros:

Code Select Expand


EXTERN_C const IID IID_IMalloc;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("00000002-0000-0000-C000-000000000046")
    IMalloc : public IUnknown
    {
    public:
        virtual void *STDMETHODCALLTYPE Alloc(
            /* [annotation][in] */
            __in  SIZE_T cb) = 0;

        virtual void *STDMETHODCALLTYPE Realloc(
            /* [annotation][in] */
            __in_opt  void *pv,
            /* [annotation][in] */
            __in  SIZE_T cb) = 0;

        virtual void STDMETHODCALLTYPE Free(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual SIZE_T STDMETHODCALLTYPE GetSize(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual int STDMETHODCALLTYPE DidAlloc(
            /* [annotation][in] */
            __in_opt  void *pv) = 0;

        virtual void STDMETHODCALLTYPE HeapMinimize( void) = 0;

    };

#else /* C style interface */

    typedef struct IMallocVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE *QueryInterface )(
            IMalloc * This,
            /* [in] */ REFIID riid,
            /* [annotation][iid_is][out] */
            __RPC__deref_out  void **ppvObject);

        ULONG ( STDMETHODCALLTYPE *AddRef )(
            IMalloc * This);

        ULONG ( STDMETHODCALLTYPE *Release )(
            IMalloc * This);

        void *( STDMETHODCALLTYPE *Alloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in  SIZE_T cb);

        void *( STDMETHODCALLTYPE *Realloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv,
            /* [annotation][in] */
            __in  SIZE_T cb);

        void ( STDMETHODCALLTYPE *Free )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        SIZE_T ( STDMETHODCALLTYPE *GetSize )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        int ( STDMETHODCALLTYPE *DidAlloc )(
            IMalloc * This,
            /* [annotation][in] */
            __in_opt  void *pv);

        void ( STDMETHODCALLTYPE *HeapMinimize )(
            IMalloc * This);

        END_INTERFACE
    } IMallocVtbl;

    interface IMalloc
    {
        CONST_VTBL struct IMallocVtbl *lpVtbl;
    };



#ifdef COBJMACROS


#define IMalloc_QueryInterface(This,riid,ppvObject) \
    ( (This)->lpVtbl -> QueryInterface(This,riid,ppvObject) )

#define IMalloc_AddRef(This) \
    ( (This)->lpVtbl -> AddRef(This) )

#define IMalloc_Release(This) \
    ( (This)->lpVtbl -> Release(This) )


#define IMalloc_Alloc(This,cb) \
    ( (This)->lpVtbl -> Alloc(This,cb) )

#define IMalloc_Realloc(This,pv,cb) \
    ( (This)->lpVtbl -> Realloc(This,pv,cb) )

#define IMalloc_Free(This,pv) \
    ( (This)->lpVtbl -> Free(This,pv) )

#define IMalloc_GetSize(This,pv) \
    ( (This)->lpVtbl -> GetSize(This,pv) )

#define IMalloc_DidAlloc(This,pv) \
    ( (This)->lpVtbl -> DidAlloc(This,pv) )

#define IMalloc_HeapMinimize(This) \
    ( (This)->lpVtbl -> HeapMinimize(This) )

#endif /* COBJMACROS */


#endif /* C style interface */


But in FB the headers, only the ansi C interface and the macros are translated, so I first thought that the C++ way was not possible. Then I saw a post in wich you were using DECLARE ABSTRACT FUNCTION and began to investigate and try...

Frankly, it does not make sense to translate the C interfaces and macros and skip the C++ way, which makes its use easier.

[José Roca]

> your web container don't work for me

If you mean the YouTube example, it works fine in my computer, but the old ATL.DLL that comes as a system DLL with Windows does not work very well. I plan to adapt my OLE container later...

[José Roca]

> Question: Couldn't the CBStr class simply clean up any allocated memory (from SysAllocString?) in the class's DESTRUCTOR. When the class goes out of scope the Destructor should be called and then the allocated memory freed?

It does it, of course. But there are situations which only native support from the compiler could solve.

If I have two BSTRs, a and b, and want to concatenate them with an overloaded & operator...

It will work if I assign the resulting new string to another instance of the CBStr class, e.g. cb = a & b.

It also will work if I assign the result to another new BSTR, e.g. c = a & b, and later I free c with SysFreeString, but if c already has contents, I will get a memory leak unless I first free it.

I will also get memory leaks if I intend to pass the new resulting string to a function without first assigning it to another BSTR and passing this third string, e.g.

c = a & b
Foo(c)

will work

but using Foo (a & b) will leak.

> I don't know if this is feasable but BCX,bc9 use a circular buffer for temporary strings:

The compiler can know if the resulting string is temporary, i.e. it is not assigned to another variable, or not and free it, but the class doesn't know how it is going to be used.

To call COM API functions and methods we only need SysAllocString and SysFreeString. Without support of the compiler, it will be not be a good choice for those that need unicode.

[Paul Squires]

I will also get memory leaks if I intend to pass the new resulting string to a function without first assigning it to another BSTR and passing this third string, e.g.

c = a & b
Foo(c)

will work

but using Foo (a & b) will leak.

I haven't created a test case yet but in my mind I am not seeing why that case described above would leak memory. Wouldn't the logic be something like this:

- Create "a" CBSTR.
- Create "b" CBSTR
- Pass "a + b" to function Foo. Foo accepts the concatenation and stores it in object "c". At this point, memory is being held for "a", "b" and "c".
- Foo() does whatever it needs to do and eventually returns from that function call. "c" goes out of scope at that point and is automatically destroyed/freed.
- "a" and "b" are now freed when they go out of scope (ie. the program ends or the function that "a" and "b" may be in is eventually exited.

Code Select Expand


Function MySub() As Long

   Dim a As CBStr = "A String"
   Dim b As CBStr = "B String"

   Foo( a & b ) 

   '<--- "a" and "b" are freed as MySub() ends
End Function


Function Foo( c As CBSTR ) As Long

   ' <--- "c" is freed when function returns
End Function



[José Roca]

> ' <--- "c" is freed when function returns

I don't think so, and much less if you are passing a & b to an API function.

[José Roca]

Attached is a version of CBStr.inc in which I have changed the BSTR type for AFX_BSTR; otherwise, it won't work with the latest FB headers.

This code demonstrates the leak problem.

Code Select Expand


SUB Foo (BYVAL b AS AFX_BSTR)
   PRINT *b
END SUB


If I assign the result of concatenating two BSTRs (in the example both bs1 and bs2 are of the type CBStr, but they can be other types or even literals)

Code Select Expand


DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & bs2
Foo *bs3


then it works fine because the resulting new BSTR is assigned to a variable of the type CBStr that will free the memory when it goes out of scope.

But if I use

Code Select Expand


Foo bs1 & bs2


The resulting new BSTR is never freed.

Also, if I use

Code Select Expand


DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & " " & bs2
Foo *bs3


there is also a leak because the operation generates two new temporary BSTRs, the first one by bs1 & " " and the second one by the result of bs1 & " " and <result> & bs2, but only the second is assigned to bs3 and, therefore, the temporary string generated by bs1 & " " will be never freed.

To avoid the leak, I will have to use

Code Select Expand


DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = bs1 & " "
DIM bs4 AS CBStr = bs3 & bs2
Foo *bs3



The other problem is to known if when you assign a pointer to a variable of type CBStr, this pointer if to a real BSTR or not. I'm using a trick.

Code Select Expand


' ========================================================================================
OPERATOR CBStr.Let (BYREF bstrHandle AS AFX_BSTR)
   IF bstrHandle = NULL THEN EXIT OPERATOR
   ' Free the current OLE string
   IF m_bstr THEN SysFreeString(m_bstr)
   ' Detect if the passed handle is an OLE string
   ' If it is an OLE string it must have a descriptor; otherwise, don't
   ' Get the length looking at the descriptor
   DIM res AS INTEGER = PEEK(DWORD, CAST(ANY PTR, bstrHandle) - 4) \ 2
   ' If the retrieved length if the same that the returned by LEN, then it must be an OLE string
   IF res = .LEN(*bstrHandle) THEN
      ' Attach the passed handle to the class
      m_bstr = bstrHandle
   ELSE
      ' Allocate an OLE string with the contents of the string pointer by bstrHandle
      m_bstr = SysAllocString(*bstrHandle)
   END IF
END OPERATOR
' ========================================================================================


[Paul Squires]

Thanks Jose, I just downloaded the new class and I am now working through your code in your post above in order to understand the points of the memory leak. I will post again when I am fully knowledgeable.

[José Roca]

The ones that can generate memory leaks are these that return a BSTR, i.e. the & and + overloaded operators.

[José Roca]

The only way is to remove the Concat function and the & and + operators.

We can still do string concatenation this way:

Code Select Expand


SUB Foo (BYVAL b AS AFX_BSTR)
   PRINT *b
END SUB

DIM bs1 AS CBStr = "Text"
DIM bs2 AS CBStr = "string"
DIM bs3 AS CBStr = **bs1 & " " & **bs2
Foo *bs3


[Paul Squires]

The ones that can generate memory leaks are these that return a BSTR, i.e. the & and + overloaded operators.

Yes, it FINALLY clicked in for me once I wrote some test code and followed the logic through.

You are passing two OBJECTS to Foo and concatenating their strings via the & operator. The concatenation function returns an AFX_BSTR (basically a wstring ptr with manually allocated memory via SysAllocStringLen). The problem then is that the AFX_BSTR will never be freed because it is never tracked nor is it an object that can have a Destructor called).

It does seem like this is a situation where the compiler needs to handle the tracking of the creation and deleting of the BSTR. That is, the same way the compiler tracks allocated internal FBSTRING types. I doubt that will be added to the compiler anytime soon.

I can't think of a solution around this(?)