CWindow RC 17

[José Roca]

A new class. CFileSys.inc. Provides many useful methods to work with files and folders.

Code Select Expand


      DECLARE FUNCTION DriveLetters () AS CBSTR
      DECLARE FUNCTION DriveExists (BYREF cbsDrive AS CBSTR) AS BOOLEAN
      DECLARE FUNCTION FileExists (BYREF cbsFileSpec AS CBSTR) AS BOOLEAN
      DECLARE FUNCTION FolderExists (BYREF cbsFileSpec AS CBSTR) AS BOOLEAN
      DECLARE FUNCTION IsDriveReady (BYREF cbsDrive AS CBSTR) AS BOOLEAN
      DECLARE FUNCTION GetDriveName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFolderName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFileName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetExtensionName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetBaseName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetAbsolutePathName (BYREF cbsPathSpec AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetTempName () AS CBSTR
      DECLARE FUNCTION GetDriveShareName (BYREF cbsDrive AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetDriveFileSystem (BYREF cbsDrive AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetDriveType (BYREF cbsDrive AS CBSTR) AS DRIVETYPECONST
      DECLARE FUNCTION GetFolderType (BYREF cbsFolder AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFileType (BYREF cbsFile AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFileVersion (BYREF cbsFileName AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetParentFolderName (BYREF cbsFolder AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFolderShortPath (BYREF cbsFolder AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFolderShortName (BYREF cbsFolder AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFolderDriveLetter (BYREF cbsFolder AS CBSTR) AS CBSTR
      DECLARE FUNCTION SetFolderName (BYREF cbsFolder AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
      DECLARE FUNCTION BuildPath (BYREF cbsPath AS CBSTR, BYREF cbsName AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetSerialNumber (BYREF cbsDrive AS CBSTR) AS LONG
      DECLARE FUNCTION GetVolumeName (BYREF cbsDrive AS CBSTR) AS CBSTR
      DECLARE FUNCTION SetVolumeName (BYREF cbsDrive AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
      DECLARE FUNCTION GetNumDrives () AS LONG
      DECLARE FUNCTION GetNumSubFolders (BYREF cbsFolder AS CBSTR) AS LONG
      DECLARE FUNCTION GetNumFiles (BYREF cbsFolder AS CBSTR) AS LONG
      DECLARE FUNCTION IsRootFolder (BYREF cbsFolder AS CBSTR) AS BOOLEAN
      DECLARE FUNCTION GetStandardStream (BYVAL StandardStreamType AS STANDARDSTREAMTYPES, BYVAL bUnicode AS VARIANT_BOOL = FALSE) AS Afx_ITextStream PTR
      DECLARE FUNCTION GetFileSize (BYREF cbsFile AS CBSTR) AS LONG
      DECLARE FUNCTION SetFileName (BYREF cbsFile AS CBSTR, BYREF cbsName AS CBSTR) AS HRESULT
      DECLARE FUNCTION GetFileShortPath (BYREF cbsFile AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFileShortName (BYREF cbsFile AS CBSTR) AS CBSTR
      DECLARE FUNCTION GetFileAttributes (BYREF cbsFile AS CBSTR) AS FILEATTRIBUTE
      DECLARE FUNCTION SetFileAttributes (BYREF cbsFile AS CBSTR, BYVAL lAttr AS FILEATTRIBUTE) AS HRESULT
      DECLARE FUNCTION GetFileDateCreated (BYREF cbsFile AS CBSTR) AS DATE_
      DECLARE FUNCTION GetFileDateLastModified (BYREF cbsFile AS CBSTR) AS DATE_
      DECLARE FUNCTION GetFileDateLastAccessed (BYREF cbsFile AS CBSTR) AS DATE_
      DECLARE FUNCTION GetFolderSize (BYREF cbsFolder AS CBSTR) AS LONG
      DECLARE FUNCTION GetFolderAttributes (BYREF cbsFolder AS CBSTR) AS FILEATTRIBUTE
      DECLARE FUNCTION SetFolderAttributes (BYREF cbsFolder AS CBSTR, BYVAL lAttr AS FILEATTRIBUTE) AS HRESULT
      DECLARE FUNCTION GetFolderDateCreated (BYREF cbsFolder AS CBSTR) AS DATE_
      DECLARE FUNCTION GetFolderDateLastModified (BYREF cbsFolder AS CBSTR) AS DATE_
      DECLARE FUNCTION GetFolderDateLastAccessed (BYREF cbsFolder AS CBSTR) AS DATE_
      DECLARE FUNCTION GetDriveAvailableSpace (BYREF cbsDrive AS CBSTR) AS DOUBLE
      DECLARE FUNCTION GetDriveFreeSpace (BYREF cbsDrive AS CBSTR) AS DOUBLE
      DECLARE FUNCTION GetDriveTotalSize (BYREF cbsDrive AS CBSTR) AS DOUBLE
      DECLARE FUNCTION CreateFolder (BYREF cbsFolder AS CBSTR) AS Afx_IFolder PTR
      DECLARE FUNCTION DeleteFolder (BYREF cbsFolder AS CBSTR, BYVAL bForce AS VARIANT_BOOL = FALSE) AS HRESULT
      DECLARE FUNCTION MoveFolder (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR) AS HRESULT
      DECLARE FUNCTION CopyFolder (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR, BYVAL OverWriteFiles AS VARIANT_BOOL = -1) AS HRESULT
      DECLARE FUNCTION CopyFile (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR, BYVAL OverWriteFiles AS VARIANT_BOOL = -1) AS HRESULT
      DECLARE FUNCTION DeleteFile (BYREF cbsFileSpec AS CBSTR, BYVAL bForce AS VARIANT_BOOL = FALSE) AS HRESULT
      DECLARE FUNCTION MoveFile (BYREF cbsSource AS CBSTR, BYREF cbsDestination AS CBSTR) AS HRESULT


[Marc Pons]

Jose

Thanks again for sharing your code, its always very efficient and professionnal.

I've noticed something missing: in the help file you are showing COM procedures ( under AfxCOM.inc )

i wanted to use the following one

Code Select Expand

FUNCTION AfxGuid (BYVAL pwszGuidText AS WSTRING PTR = NULL) AS GUID

but did not find that .inc file , probably you prepared the help file for future adding .

I've done some modifications on your code

Code Select Expand

' ########################################################################################
' Microsoft Windows
' Contents: Embedded MonthView Calendar OCX
' 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

#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "Afx/COleCon/COleCon.inc"
USING Afx

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

private function GUID_From_Str(BYREF lpsz AS CWSTR) as GUID
   dim temp as GUID = (0 , 0 , 0 ,{0 , 0 , 0 , 0 , 0 , 0 , 0 , 0})
   if len(lpsz) <> 38 then return(temp)
   CLSIDFromString(lpsz , @temp)
   return(temp)
end function

' ========================================================================================
' Main
' ========================================================================================
FUNCTION WinMain(BYVAL hInstance AS HINSTANCE , _
         BYVAL hPrevInstance AS HINSTANCE , _
         BYVAL szCmdLine AS ZSTRING PTR , _
         BYVAL nCmdShow AS LONG) AS LONG

   'CoInitialize NULL

   ' // 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)
   pWindow.Create(NULL , "COleCon - Embedded regfree MonthView Calendar OCX" , @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(1124 , 360)
   ' // Centers the window

   'DIM wszLibName AS WSTRING * 260 = ExePath & "\MSCOMCT2.OCX"
   DIM wszLibName AS cwstr = ExePath & "\MSCOMCT2.OCX"
   'DIM CLSID_MSComCtl2_MonthView AS CLSID = (&h232E456A , &h87C3 , &h11D1 ,{&h8B , &hE3 , &h00 , &h00 , &hF8 , &h75 , &h4D , &hA1})
   DIM CLSID_MSComCtl2_MonthView AS CLSID = GUID_from_str ( "{232E456A-87C3-11D1-8BE3-0000F8754DA1}")
   'DIM IID_MSComCtl2_MonthView AS CLSID = (&h232E4565 , &h87C3 , &h11D1 ,{&h8B , &hE3 , &h00 , &h00 , &hF8 , &h75 , &h4D , &hA1})
   DIM IID_MSComCtl2_MonthView AS IID = GUID_from_str( "{232E4565-87C3-11D1-8BE3-0000F8754DA1}")
   'DIM RTLKEY_MSCOMCT2 AS WSTRING * 260 = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
   'DIM RTLKEY_MSCOMCT2 AS CWSTR = "651A8940-87C5-11d1-8BE3-0000F8754DA1"
   'DIM RTLKEY_MSCOMCT2 AS CWSTR = ""

   DIM pOleCon AS COleCon  =  COleCon(@pWindow , 1001 , wszLibName , CLSID_MSComCtl2_MonthView , _
         IID_MSComCtl2_MonthView , RTLKEY_MSCOMCT2 )

   FUNCTION = pWindow.DoEvents(nCmdShow)

   'IF pOleCon THEN Delete pOleCon
   'CoUnInitialize

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_CREATE
         ' // If you want to create controls in WM_CREATE instead of in WinMain, you can
         ' // retrieve a pointer of the class with AfxCWindowPtr(lParam). Use hwnd as the
         ' // handle of the window instead of pWindow->hWindow or omitting this parameter
         ' // because CWindow doesn't know the value of this handle until the WM_CREATE
         ' // message has been processed.
         ' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
         ' // An alternative is no pass the value of the main window handle to CWindow with
         ' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' pWindow->hWindow = hwnd
         ' IF pWindow THEN pWindow->AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
         EXIT FUNCTION

      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
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow -> MoveWindow GetDlgItem(hwnd , 1001) , _
                  0 , 0 , pWindow -> ClientWidth , pWindow -> ClientHeight , 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
' ========================================================================================

I do not like to use the Guid members directly, i think it is easier to use via strings (not evident to remember the type structure)
that is why i wanted to use AfxGuid function , so i've done an equivalent one

Code Select Expand

GUID_From_Str(BYREF lpsz AS CWSTR) as GUID

and i've also generalized the use of dynamic unicode string too.


Last point, i've noticed your code works even whith RTLKEY_MSCOMCT2 ="", even if MSCOMCT2.OCX is not registered

Marc

[José Roca]

I have not included AfxCom.inc because it just contais a few functions. I still don't know what I will do with the variants and propvariants. There is an essential library, propvarutil, that is missing in the FB headers.

[José Roca]

> Last point, i've noticed your code works even whith RTLKEY_MSCOMCT2 ="", even if MSCOMCT2.OCX is not registered

Maybe this control doesn't care about it. I think that what the VB6 ide used was a design-time license key, but I never have used VB6, so I don't know all the details. Essentially, without that design-time license key the OCX will run when the application created an instance of it in a non-licensed computer, but you could not create an instance of it in the VB ide. There were third-party OCXs that required the use of a license key at runtime, besides having a design-time license key to work with the VB6 ide.

In fact, I'm not interested in OCXs, except the WebBrowser control. I even thought to make a lightweight container tailored for it, which requires the implementation of only a few interfaces and adds less bloat. Maybe I will make some code conditional if an use web browser define is used.

[José Roca]

> and i've also generalized the use of dynamic unicode string too.

In a function like that, it doesn't matter, but avoid to use CWSTR or WSTRING with COM methods that expect a BSTR. Use CBSTR instead.

[José Roca]

A good thing of my framework is that it is written in pure FB code, without resorting to C++ or third party libraries. This provides good learning stuff and demonstrates that FB is a capable compiler.

[José Roca]

I have added Advise and Unadvise methods to the OLE Container to connect events.

[Marc Pons]

thank's for the AfxCOM.inc

avoid to use CWSTR or WSTRING with COM methods that expect a BSTR. Use CBSTR instead.

yes, understood ,  my only concern is avoiding as much as possible the use of Wstring *,  to cwstr as general unicode string

I have added Advise and Unadvise methods to the OLE Container to connect events.

nice !  could you post your code , i will test it immediatly.

one question, what's the advantage/difference of using your ole container compared with atl container ?
I understand it is not necessary to have atl.dll but that dll (or other version) is always part of windows system.

[Marc Pons]

Jose

   " I have added Advise and Unadvise methods to the OLE Container to connect events."

i wanted to say: could you post a sample usage of that methods

[José Roca]

one question, what's the advantage/difference of using your ole container compared with atl container ?
I understand it is not necessary to have atl.dll but that dll (or other version) is always part of windows system.

The one that comes pre-installed is very old and does not work very well. Version 80 works better (probably other versions too, but this is the one that I have tested), but you have to make sure that the user has the version that you're using installed.

There is also the question of being able to do it using FB alone without the usual workaround of using another language or a third party control. After all, I'm doing it to see what I can do with this compiler.

[José Roca]

This is a preliminary test to connect to the events fired by the WebBrowser control. Next I want to implement the IDocHostUIHandler interface to make the embedded browser DPI aware by returning the DOCHOSTUIFLAG_DPI_AWARE flag in the GetHostInfo method.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' 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
#INCLUDE ONCE "Afx/CWindow.inc"
#INCLUDE ONCE "win/exdisp.bi"
#INCLUDE ONCE "Afx/AfxCtl.inc"
#INCLUDE ONCE "Afx/AfxCom.inc"
#INCLUDE ONCE "Afx/COleCon/COleCon.inc"
USING Afx

' TODO: A class template, CWebBrowser, that will create the OLE Container with an
' embedded browser and connect events.
' If is DPI aware and the caller doesn't tell that he is going to implement a custom
' IDocHostUIHandler interface, create an instance of our own.
' Address to pass the Invoke messages

'extern DIID_DWebBrowserEvents2 as const IID
TYPE CWebBrowserEventsImpl EXTENDS Afx_IDispatch
   DECLARE VIRTUAL FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION AddRef () AS ULONG
   DECLARE VIRTUAL FUNCTION Release () AS ULONG
   DECLARE VIRTUAL FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   DECLARE VIRTUAL FUNCTION Invoke (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
   DECLARE CONSTRUCTOR
   DECLARE DESTRUCTOR
   m_pIDocHostUIHandler AS ANY PTR
END TYPE

' ========================================================================================
CONSTRUCTOR CWebBrowserEventsImpl
   ' Create an instance of the IDocHostUIHandler class
'   m_pIDocHostUIHandler = NEW CIDocHostUIHandler
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
DESTRUCTOR CWebBrowserEventsImpl
   ' Delete the IDocHostUIHandler class
'   IF m_pIDocHostUIHandler THEN Delete m_pIDocHostUIHandler
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObj AS LPVOID PTR) AS HRESULT
   OC_DP("CWebBrowserEventsImpl QueryInterface")
   IF ppvObj = NULL THEN RETURN E_INVALIDARG
   IF IsEqualIID(riid, @DIID_DWebBrowserEvents2) THEN
      *ppvObj = @this
      ' // Not really needed, since this is not a COM object
      cast(Afx_IUnknown PTR, *ppvObj)->AddRef
   END IF
   RETURN S_OK
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.AddRef () AS ULONG
   OC_DP("CWebBrowserEventsImpl AddRef")
   RETURN 1
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.Release () AS DWORD
   OC_DP("CWebBrowserEventsImpl Release")
   RETURN 1
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetTypeInfoCount (BYVAL pctInfo AS UINT PTR) AS HRESULT
   OC_DP("CWebBrowserEventsImpl GetTypeInfoCount")
   *pctInfo = 0
   RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   OC_DP("CWebBrowserEventsImpl GetTypeInfo")
   RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   OC_DP("CWebBrowserEventsImpl GetIDsOfNames")
   RETURN E_NOTIMPL
END FUNCTION
' ========================================================================================

' ========================================================================================
FUNCTION CWebBrowserEventsImpl.Invoke (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
   OC_DP("CWebBrowserEventsImpl Invoke dispid = " & WSTR(dispIdMember))

   ' DISPID 102 - StatusTextChange
   ' DISPID 104 - DownloadComplete
   ' DISPID 105 - CommandStateChange
   ' DISPID 106 - DownloadBegin
   ' DISPID 108 - ProgressChange
   ' DISPID 112 - PropertyChange
   ' DISPID 113 - TitleChange
   ' DISPID 225 - PrintTemplateInstantiation
   ' DISPID 226 - PrintTemplateTeardown
   ' DISPID 227 - UpdatePageStatus (not implemented)
   ' DISPID 250 - BeforeNavigate2
   ' DISPID 251 - NewWindow2
   ' DISPID 252 - NavigateComplete2
   ' DISPID 253 - OnQuit
   ' DISPID 254 - OnVisible
   ' DISPID 255 - OnToolBar
   ' DISPID 256 - OnMenuBar
   ' DISPID 257 - OnStatusBar
   ' DISPID 258 - OnFullScreen
   ' DISPID 260 - OnTheaterMode
   ' DISPID 262 - WindowSetResizable
   ' DISPID 264 - WindowSetLeft
   ' DISPID 265 - WindowSetTop
   ' DISPID 266 - WindowSetWidth
   ' DISPID 267 - WindowSetHeight
   ' DISPID 263 - WindowClosing
   ' DISPID 268 - ClientToHostWindow
   ' DISPID 269 - SetSecureLockIcon
   ' DISPID 270 - FileDownload
   ' DISPID 271 - NavigateError
   ' DISPID 272 - PrivacyImpactedStateChange
   ' DISPID 273 - NewWindow3
   ' DISPID 282 - SetPhishingFilterStatus
   ' DISPID 283 - WindowStateChanged

   ' =====================================================================================
   ' DISPID 259 - DocumentComplete
   ' Fires when a document is completely loaded and initialized.
   ' =====================================================================================
   ' METHOD DocumentComplete <259> (BYVAL pDisp AS IDispatch, BYREF vURL AS VARIANT)

   SELECT CASE dispIdMember
      CASE 259   ' // DocumentComplete

      ' // 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.
'DIM pIWebBrowser2 AS IWebBrowser2 PTR = cast(IWebBrowser2 PTR, pDisp)

      ' // Get a reference to the active document
'DIM pIHTMLDocument2 AS IHTMLDocument2 PTR
'pIWebBrowser2->get_Document(@pIHTMLDocument2)

      ' // Get a reference to the CustomDoc interface
'      pICustomDoc = pIHTMLDocument2
'      IF ISNOTHING(pICustomDoc) THEN EXIT METHOD
'DIM pICustomDoc AS ICustomDoc PTR
'pIHTMLDocument2->QueryInterface(@IID_ICustomDoc, @pICustomDoc)
''pIHTMLDocument2->QueryInterface(cast(IID PTR, @IID_ICustomDoc), @pICustomDoc)

      ' // Set our IDocHostUIHandler interface for MSHTML
      ' // MSHTML will release its previous IDocHostUIHandler interface
      ' // (if one is present) and call pDocHostUIHandler's AddRef method.
' Create an instance of the Afx_IDocHostUIHandler class in the constructor method
' of the WebBrowser events class and destroy it in the destructor method.
'IF pIDocHostUIHandler THEN pICustomDoc->SetUIHandler(pIDocHostUIHandler)

   END SELECT

   RETURN S_OK

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

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

' ========================================================================================
' 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)
   pWindow.Create(NULL, "COleCon - Embedded WebBrowser control", @WndProc)
   ' // Sizes it by setting the wanted width and height of its client area
   pWindow.SetClientSize(700, 450)
   ' // Centers the window
   pWindow.Center

   ' // Add a status bar
   DIM hStatusbar AS HWND = pWindow.AddControl("Statusbar", , 1002)
   ' // Set the parts
   DIM rgParts(1 TO 2) AS LONG = {pWindow.ScaleX(160), -1}
   IF StatusBar_SetParts(hStatusBar, 2, @rgParts(1)) THEN
      StatusBar_Simple(hStatusBar, FALSE)
   END IF

   DIM pOleCon AS COleCon PTR = NEW COleCon(@pWindow, 1001, "Shell.Explorer", _
       0, 0, pWindow.ClientWidth, pWindow.ClientHeight - 20)
   DIM pEvtObj AS CWebBrowserEventsImpl PTR = NEW CWebBrowserEventsImpl
   pOleCon->Advise(pEvtObj, DIID_DWebBrowserEvents2)

   DIM pWb AS IWebBrowser2 PTR = cast(IWebBrowser2 PTR, pOleCon->OcxDispPtr)
   IF pWb THEN
      DIM vUrl AS VARIANT
      vUrl.vt = VT_BSTR
'      vUrl.bstrVal = SysAllocString("https://forum.powerbasic.com/")
'      vUrl.bstrVal = SysAllocString("http://www.freebasic.net/forum/")
      vUrl.bstrVal = SysAllocString("http://www.planetsquires.com/protect/forum/index.php")
      DIM hr AS HRESULT = pWb->lpvtbl->Navigate2(pWb, @vUrl, NULL, NULL, NULL, NULL)
      VariantClear @vurl
   END IF

   SetFocus GetDlgItem(pWindow.hWindow, 1001)

   ' // Displays the window and dispatches the Windows messages
   FUNCTION = pWindow.DoEvents(nCmdShow)

   pOleCon->Unadvise   ' // Call it before deleting the events class
   IF pEvtObj THEN Delete pEvtObj
   IF pOleCon THEN Delete pOleCon

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_CREATE
         ' // If you want to create controls in WM_CREATE instead of in WinMain, you can
         ' // retrieve a pointer of the class with AfxCWindowPtr(lParam). Use hwnd as the
         ' // handle of the window instead of pWindow->hWindow or omitting this parameter
         ' // because CWindow doesn't know the value of this handle until the WM_CREATE
         ' // message has been processed.
         ' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' IF pWindow THEN pWindow->AddControl("Button", hwnd, IDCANCEL, "&Close", 350, 250, 75, 23)
         ' // An alternative is no pass the value of the main window handle to CWindow with
         ' DIM pWindow AS CWindow PTR = AfxCWindowPtr(lParam)
         ' pWindow->hWindow = hwnd
         ' IF pWindow THEN pWindow->AddControl("Button", , IDCANCEL, "&Close", 350, 250, 75, 23)
         EXIT FUNCTION

      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
            ' // Retrieve a pointer to the CWindow class
            DIM pWindow AS CWindow PTR = AfxCWindowPtr(hwnd)
            ' // Move the position of the button
            IF pWindow THEN pWindow->MoveWindow GetDlgItem(hwnd, 1001), _
               0, 0, pWindow->ClientWidth, pWindow->ClientHeight - 20, 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
' ========================================================================================


[José Roca]

GUID_From_Str(BYREF lpsz AS CWSTR) as GUID
and i've also generalized the use of dynamic unicode string too.

I prefer to no force anybody to use my code exclusively unless needed.

IF you change you function to

Code Select Expand


GUID_From_Str(BYREF lpsz AS WSTRING) as GUID


it will work both with WSTRINGs and CWSTRs.

Code Select Expand


DIM cws AS CWSTR = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(cws)


Code Select Expand


DIM wsz AS WSTRING * 40 = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(wsz)


and also with CBSTR

Code Select Expand


DIM cws AS CWSTR = "{232E456A-87C3-11D1-8BE3-0000F8754DA1}"
DIM g AS GUID = GUID_From_Str(cws)


It will also work as you have declared it, but doing so you're forcing the inclusion of the CWSTR class.

[José Roca]

I finally have managed to tame the beast: WebBrowser events and implementation of the IDocHostUIHandler interface. Another bug in the FB libraries has driven me crazy. The linker failed and you don't have the means of knowing why. It happens that extern IID_ICustomDoc is broken.

[José Roca]

I have modified the COleCon.Forward message. Now we can navigate through the elements of a web page using the TAB key.

The linker fails when compiling it with the 64-bit compiler. Probably yet another bug in the FB Windows libraries.

[José Roca]

Can't find were the problem is. Does anybody know if there are problems with virtual functions in 64-bit?