Visual Basic Shell Programming

only for RuBoard - do not distribute or recompile

13.3 The Project: FileSpider

In this chapter, we are actually going to build a very useful band object. Believe it or not, you might end up using this band object all the time. It's that cool. So what does it do?

Okay, imagine this scenario: you are surfing the Web and you come across a page that has several files you wish to download. Normally, you would have to download one file at a time. Once the file is downloaded, you click on the next file, wait, click on the next file, and so on. Of course, you would also have to wait on this page or bookmark it if you wanted to continue surfing while the files were downloading. Pretty lame, right? Well, FileSpider fixes all of that.

FileSpider "crawls" a web page and makes a list of all files that are available for downloading. You select the files you want to download, and FileSpider downloads them one at a time in the background, freeing you up to surf to your heart's content. You can also build your list of files from several pages. There are no limits here. The file list is persistent, which means that you can download the files at a later time should you wish to do so. Everything is automatically saved in the registry. All of FileSpider's commands can be accessed from a toolbar in the band window. We'll also throw in a context menu just to say we did. This should give you an idea how context menus are handled outside of context menu handlers (see Chapter 4). Figure 13.5 shows FileSpider in action.

Figure 13.5. FileSpider band object

We are ready to begin the project. We need to create a new ActiveX DLL project named FileSpider. Once this is done we need to do several things:

  1. Add a class module to project called SpiderBand.cls .

  2. Add two modules named BandObject.bas and ContextMenu.bas . Code relevant to the Band Object will go in the first module. Context menu-specific code will go in the second.

  3. Add a reference to our shell library, as well as to MSHTML.DLL (the HTML Object Model).

FileSpider will additionally contain five forms, but we'll discuss those as we get to them. For now, though, let's concentrate on getting the code together for a minimal band object.

We'll start in SpiderBand.cls by implementing the interfaces we need:

'SpiderBand.cls Implements IDeskBand Implements IInputObject Implements IObjectWithSite Implements IContextMenu

We now have some serious work ahead of us because we need to implement all of these interfaces. We'll do everything in order of familiarity . So let's start with IContextMenu (which we've known about since Chapter 4), and take it from there. To implement this interface properly, we'll need to swap out the vtable entry for QueryContextMenu , so there is a little busy work up front. Then we'll implement the method, which involves simply adding menu items using the Windows API. This is really no different from the last time we implemented it. We will also implement InvokeCommand , the method that actually carries out the menu commands, by forwarding all calls from the context menu to the band form. We do this so the context menu and the toolbar can use the same code. IContextMenu::GetCommandString is not implemented, so we'll just ignore it and pretend it doesn't exist.

13.3.1 Class_Initialize/Class_Terminate

The Initialize and Terminate events for the class should look very familiar. All we are going to use them for is to swap out vtable entries for IContextMenu::QueryContextMenu (see Chapter 4). A Private member variable named m_ pOldQueryContextMenu is added to the class to store the original function address of QueryContextMenu . The Initialize and Terminate events are shown in Example 13.3.

Example 13.3. Initialize and Terminate

Private m_pOldQueryContextMenu As Long Private Sub Class_Initialize( ) Dim pContextMenu As IContextMenu Set pContextMenu = Me m_pOldQueryContextMenu = SwapVtableEntry( _ ObjPtr(pContextMenu), _ 4, _ AddressOf QueryContextMenuX) End Sub Private Sub Class_Terminate( ) Dim pContextMenu As IContextMenu Set pContextMenu = Me m_pOldQueryContextMenu = SwapVtableEntry(_ ObjPtr(pContextMenu), _ 4, _ m_pOldQueryContextMenu) End Sub

The replacement function, QueryContextMenuX , is fairly straightforward compared to the last time we visited this function in Chapter 4. QueryContextMenuX is located in ContextMenu.bas . This function provides context menu support for the four commands that FileSpider will need: Crawl, Download, Preferences, and About. These commands will accomplish the following:

Command

Description

Crawl

Crawls a web page and makes a list of files that were found.

Download

Starts downloading (one file at time) all of the files that have been selected in the band's main window.

Preferences

Displays the Preferences dialog, which allows configuration information for the band to be entered.

About

Displays an about box.

The entire listing for this module is shown in Example 13.4.

Example 13.4. ContextMenu.bas

Public Declare Function InsertMenu Lib "user32" _ Alias "InsertMenuA" (ByVal HMENU As Long, _ ByVal nPosition As Long, ByVal wFlags As Long, _ ByVal wIDNewItem As Long, _ ByVal lpNewItem As String) As Long 'Menu Constants Public Const MF_BYPOSITION = &H400& Public Const MF_STRING = &H0& Public Const MF_SEPARATOR = &H800& Public Function QueryContextMenuX(_ ByVal This As IContextMenu, _ ByVal HMENU As Long, _ ByVal indexMenu As Long, _ ByVal idCmdFirst As Long, _ ByVal idCmdLast As Long, _ ByVal uFlags As Long) As Long Dim sMenuItem As String Dim idCmd As Long idCmd = idCmdFirst sMenuItem = "&Crawl" Call InsertMenu(HMENU, indexMenu, MF_STRING Or MF_BYPOSITION, _ idCmd, sMenuItem) idCmd = idCmd + 1 indexMenu = indexMenu + 1 sMenuItem = "&Download" Call InsertMenu(HMENU, indexMenu, MF_STRING Or MF_BYPOSITION, _ idCmd, sMenuItem) idCmd = idCmd + 1 indexMenu = indexMenu + 1 sMenuItem = "&Preferences" Call InsertMenu(HMENU, indexMenu, MF_STRING Or MF_BYPOSITION, _ idCmd, sMenuItem) idCmd = idCmd + 1 indexMenu = indexMenu + 1 sMenuItem = "&About" Call InsertMenu(HMENU, indexMenu, MF_STRING Or MF_BYPOSITION, _ idCmd, sMenuItem) idCmd = idCmd + 1 indexMenu = indexMenu + 1 'Always return number of items added to the menu 'indexMenu will equal that in this instance, but not 'others....like adding to an existing context menu QueryContextMenuX = indexMenu End Function

Just for a refresher, let's briefly discuss QueryContextMenu . This is a method of IContextMenu that adds items to the context menu. It is defined like so:

HRESULT QueryContextMenu( HMENU hmenu , UINT indexMenu , UINT idCmdFirst , UINT idCmdLast , UINT uFlags );

Its parameters are:

hmenu

[in] The handle of the context menu to which we will be adding items.

indexMenu

[in] The zero-based position at which the first menu item is to be inserted.

idCmdFirst

[in] The minimum value that can be specified as a menu identifier, or simply a number that uniquely identifies the menu item.

idCmdLast

[in] The maximum value that can be specified as a menu identifier.

uFlags

[in] This value can be ignored. For a description, see the discussion of QueryContextMenu in Chapter 4.

The parameters we are concerned with in this instance are hMenu , indexMenu , and idCmdFirst .

As you can see from the listing, each of these relevant items go hand in hand with the parameters that we need to call the InsertMenu API, which is defined like so:

Public Declare Function InsertMenu Lib "user32" _ Alias "InsertMenuA" (ByVal HMENU As Long, _ ByVal nPosition As Long, _ ByVal wFlags As Long, _ ByVal wIDNewItem As Long, _ ByVal lpNewItem As String) As Long

As each item is added to the context menu, the command ID and the menu index are both incremented. Also, it should be mentioned that the command identifier is not incremented if a separator is being added.

Next, we need to implement the InvokeCommand method. If you recall from Chapter 4, this method is called when an item is selected from a context menu. Our implementation is very simple. All we are going to do is to forward the InvokeCommand calls to the band object form. We do this because each context menu item corresponds to a toolbar item on the band form. If we put all the command code in the band form, we can keep SpiderBand.cls generic enough to use in our future band object projects. Example 13.5 details our implementation of InvokeCommand and also shows the handler that is found in our band form, frmBand.frm .

Example 13.5. InvokeCommand

'SpiderBand.cls Private Sub IContextMenu_InvokeCommand(_ ByVal lpcmi As VBShellLib.LPCMINVOKECOMMANDINFO) 'Let the band handle the menu implementation frmBand.MenuHandler lpcmi End Sub 'frmBand.frm Public Sub MenuHandler(lpcmi As Long) Dim cmi As CMINVOKECOMMANDINFO CopyMemory cmi, ByVal lpcmi, Len(cmi) Select Case cmi.lpVerb Case 0 'Crawl cmdCrawl = True Case 1 'Download cmdDL = True Case 2 'Preferences cmdPrefs = True Case 3 'About cmdAbout = True End Select End Sub

Once MenuHandler is called, CopyMemory is used to get a local instance of CMINVOKECOMMANDINFO from lpcmi , the pointer passed to the function. We can then check the lpVerb member of the structure to determine the index of the context menu item that has been selected. As you can see from the listing, we are not using a toolbar control for the band object, but rather four individual buttons . Setting a command equal to True is just like clicking on the button with the mouse. Routing the commands to one place keeps us from having to duplicate code.

13.3.2 IObjectWithSite

Our IObjectWithSite::SetSite implementation is very similar to a browser extension (see Chapter 12). Once again, we need to use IServiceProvider to get the current instance of Internet Explorer. This will be passed on to our band form and made available to the Crawl command (the command that actually crawls a web page looking for downloadable files). But there are a few additional actions that must be performed. Let's go through Example 13.6, which contains the code that implements the SetSite method, now.

Example 13.6. SetSite

Private m_pSite As IUnknownVB Private m_ContainerWnd As Long Private m_bandWnd As Long Private m_pOldQueryContextMenu As Long Private Const IID_IWebBrowserApp = _ "{0002DF05-0000-0000-C000-000000000046}" Private Const IID_IWebBrowser2 = _ "{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}" Private Sub IObjectWithSite_SetSite(ByVal pUnkSite As IUnknownVB) Dim isp As IServiceProvider Dim oleWnd As IOleWindow Dim wba As GUID 'IWebBrowserApp Dim wb2 As GUID 'IWebBrowser2 Dim dwStyle As Long If Not (pUnkSite Is Nothing) Then If Not (m_pSite Is Nothing) Then Set m_pSite = Nothing End If Set m_pSite = pUnkSite Set oleWnd = pUnkSite ' QueryInterface for IOleWindow 'QueryInterface for IServiceProvider Set isp = pUnkSite 'Query service provider to get IWebBrowser2 (InternetExplorer) CLSIDFromString StrPtr(IID_IWebBrowserApp), wba CLSIDFromString StrPtr(IID_IWebBrowser2), wb2 'Get IWebBrowser2 Set frmBand.InternetExplorer = _ isp.QueryService(VarPtr(wba), VarPtr(wb2)) Set isp = Nothing If Not (oleWnd Is Nothing) Then m_ContainerWnd = oleWnd.GetWindow m_bandWnd = frmBand.hwnd dwStyle = GetWindowLong(m_bandWnd, GWL_STYLE) dwStyle = dwStyle Or WS_CHILD Or WS_CLIPSIBLINGS SetWindowLong m_bandWnd, GWL_STYLE, dwStyle SetParent m_bandWnd, m_ContainerWnd End If Set oleWnd = Nothing Else Set m_pSite = Nothing End If End Sub

If the site pointer passed in by the shell is valid, we do two things. First, we save the site pointer in a private member variable named m_ pSite . This will be used later when we implement GetSite . As you can see, we have declared a local instance of IOleWindow . We also need to query the site pointer for IOleWindow . This will allow us to get the container window for our band object. We can also query the site pointer to get IServiceProvider . Once we have IServiceProvider , we can get IWebBrowser2 and pass this directly to our band form.

If our IOleWindow interface is valid, then we can get the container window. We are also going to store the handle of our band form in a private member variable. Instead of using VB commands like Show and Hide, we will use the API to manipulate the form through its handle.

What's all the business with GetWindowLong and SetWindowLong ? Well, our band form needs to be a child window, so we need to get the window's style information and add WS_CHILD and WS_CLIPSIBLINGS . We use GetWindowLong to reapply the style to the window. These two functions are declared like this:

Public Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long

Once we have done that, we can call SetParent to actually make our band form a child of the container window. If we did not do this extra step, the band object would still work, but Explorer would lose focus when we click on the band object. By doing this, the band object will appear to be a contiguous part of Explorer.

Our GetSite implementation is the same as always, as shown in Example 13.7.

Example 13.7. GetSite

Private Sub IObjectWithSite_GetSite(_ ByVal priid As LPGUID, _ ppvSite As LPVOID) m_pSite.QueryInterface priid, ppvSite End Sub

13.3.3 IInputObject

We only need to implement one method for IInputObject , and that is UIActivateIO . All we need to do with this method is give focus to our band form when the shell tells us. We do not need to discuss this interface in any more detail, because we are not going to use accelerators. The UIActivate implementation is shown in Example 13.8.

Example 13.8. UIActivate

Private Sub IInputObject_UIActivateIO(_ ByVal fActivate As Boolean, _ ByVal lpMsg As lpMsg) If (fActivate) Then SetFocus m_bandWnd End If End Sub

13.3.4 IDeskBand

Implementing IDeskBand is a simple and straightforward process. We already have everything we need to implement this interface in place, and most of the methods require only a line of code. Let's implement these one-liners first. We'll start with CloseDW :

Private Sub IDeskBand_CloseDW(ByVal dwReserved As Long) Unload frmBand End Sub

Could things be simpler? It should be noted that you do not even have to implement this method. We do because our band form has code in its Unload event. If we do not close the form here, Unload will not be called.

GetWindow is equally as simple:

Private Function IDeskBand_GetWindow( ) As Long IDeskBand_GetWindow = m_bandWnd End Function

That's it. All we need to do is return the handle to our band form.

ShowDW is not exactly a one-liner, but it is just as easy to implement. The shell passes in a Boolean value. If this value is True , we show the window; if not, we hide it. We will use the ShowWindow API to achieve the desired results:

Private Sub IDeskBand_ShowDW(ByVal fShow As Boolean) If (fShow) Then ShowWindow m_bandWnd, SW_SHOW Else ShowWindow m_bandWnd, SW_HIDE End If End Sub

The only method with any substance, really, is GetBandInfo . GetBandInfo is where we get a chance to tell Explorer some band-specific information, such as the minimum, maximum, and ideal size of our band, and the title of our band. This method is shown in Example 13.9.

Example 13.9. GetBandInfo

Private Sub IDeskBand_GetBandInfo(_ ByVal dwBandID As Long, _ ByVal dwViewMode As Long, _ ByVal pdbi As VBShellLib.DESKBANDINFO) Dim dbi As DESKBANDINFO If pdbi = 0 Then Exit Sub End If CopyMemory dbi, ByVal pdbi, Len(dbi) If (dbi.dwMask And DBIM_MINSIZE) Then dbi.ptMinSize.x = 10& dbi.ptMinSize.y = 50& End If If (dbi.dwMask And DBIM_MAXSIZE) Then dbi.ptMaxSize.x = -1& dbi.ptMaxSize.y = -1& End If If (dbi.dwMask And DBIM_INTEGRAL) Then dbi.ptIntegral.x = 1& dbi.ptIntegral.y = 1& End If If (dbi.dwMask And DBIM_ACTUAL) Then dbi.ptActual.x = 0& dbi.ptActual.y = 0& End If If (dbi.dwMask And DBIM_TITLE) Then Dim title( ) As Byte title = "FileSpider" & vbNullChar CopyMemory dbi.wszTitle(0), title(0), UBound(title) + 1 End If If (dbi.dwMask And DBIM_MODEFLAGS) Then dbi.dwModeFlags = DBIMF_VARIABLEHEIGHT End If If (dbi.dwMask And DBIM_BKCOLOR) Then 'Use the default background color by removing 'DBIM_BKCOLOR flag and setting crBkgnd End If CopyMemory ByVal pdbi, dbi, Len(dbi) End Sub

13.3.5 The Band Form

Now that the band object is wired up, the remainder of the action either starts or ends in the band form. The band form is shown in Figure 13.6.

Figure 13.6. Band object form

If we discuss every single line of code in frmBand and the other forms, we are going to get way off track. And besides, nothing is more lame than a computer book with a bunch of pages of GUI settings. Just look at the downloadable code provided for this chapter. We'll discuss the good stuff, but much of the code remaining involves saving settings and URL information to the registry and retrieving that information.

The code we are most interested in at this point (and the code most open for improvement by you) is the Crawl function. Let's take a look:

'frmBand.frm Private m_ie As InternetExplorer Private Sub Crawl( ) Dim i As Long Dim pDoc As IHTMLDocument2 Dim pRootWnd As IHTMLWindow2 Dim pWnd As IHTMLWindow2 Dim pFrames As IHTMLFramesCollection2 Dim nFrames As Long Set pDoc = m_ie.Document Set pWnd = pDoc.parentWindow Set pRootWnd = pWnd.top Set pFrames = pRootWnd.frames 'Get number of frames on page nFrames = pFrames.length

Here's what's going on. First, we grab the current document from our private instance of Internet Explorer. The problem is that the current document might not be the top-level document. It might be a document embedded in a frame somewhere deep in the document. So, we need to get the parent window of the document. Once we have that, we can get the top-level window. When we get the top-level window, we can get a collection of all the frames on the page. (Confused? There is a picture of the object model in Figure 12.2). This is important, because we want the Crawl function to work across frames. With the frames collection in hand, we can loop through each frame and search the corresponding document for files. If there are no frames, our job is even easier:

If (nFrames > 1) Then For i = 0 To nFrames - 1 Dim pFrameDoc As IHTMLDocument2 Dim pFrameWnd As IHTMLWindow2 Set pFrameWnd = pFrames.Item(i) Set pFrameDoc = pFrameWnd.Document Call FindFiles(pFrameDoc) Set pFrameDoc = Nothing Set pFrameWnd = Nothing Next i Else Call FindFiles(pDoc) End If Set pFrames = Nothing Set pRootWnd = Nothing Set pWnd = Nothing Set pDoc = Nothing End Sub

Crawl delegates to a function called FindFiles . It is FindFile 's job to search a document for files. How does it know which files to look for? WAV ? EXE ? JPG ? That is left entirely up to the user and is determined by the settings in the Preferences dialog. Some background information that you'll need to know when we discuss FindFiles is that there is a private variable that contains an array of types in which we are interested ( .exe , .wav , .jpg , etc.). This variable is called m_sTypes . There is also another member variable that contains the number of types, called m_nTypes .

FindFiles is quite a beast , so rather than dump a gargantuan listing on you, we'll step through it slowly:

Private Sub FindFiles(doc As IHTMLDocument2) On Error GoTo FindFiles_Err Dim i, j, nElements As Long Dim pElements As IHTMLElementCollection Dim pElement As IHTMLElement Dim nPos As Integer Dim sUrl As String 'Get all the BODY elements of the current page Set pElement = doc.body Set pElements = pElement.All 'Get number of elements on the current page nElements = pElements.length

This block of code retrieves the <BODY> element, then gets all the elements that are part of the body (which could really be quite a few). Now, we know the number of elements in the collection, so we can loop through each individual element in the collection looking for <A > tags. If we have an anchor, then we can get the href portion of the tag, which will contain the filename:

For i = 0 To nElements - 1 Dim sTag As String Set pElement = pElements.Item(i) 'Check every "anchor" for file type sTag = UCase(pElement.tagName) If sTag = "A" Then Dim pAnchor As IHTMLAnchorElement Dim sHref As String Set pAnchor = pElement sHref = LCase(pAnchor.href)

Now that we have a filename, we need to check to see if we are interested in its type. To accomplish this, we loop through the m_sTypes array, which contains all of the file extensions for which we are looking. If so, we pass the URL to a function called ParseURL . We will not discuss this function, but here is what it does: it merely separates the address portion of the URL from the filename. The URL is stored in an invisible list box on the band form, and the filename is added to the main list box. A list of filenames in the main window just looks better than the full URL, and it's easier to read:

For j = 0 To m_nTypes - 1 nPos = InStr(sHref, m_sTypes(j)) If nPos Then sUrl = ParseURL(sHref) 'Just show file name in list box, but store 'the rest of the URL in a hidden list box nPos = InStrRev(sUrl, "/") If (nPos) Then lstURL.AddItem Left(sUrl, nPos) lstFiles.AddItem Right(sUrl, Len(sUrl) - nPos) Else lstFiles.AddItem sUrl End If End If Next j Set pAnchor = Nothing End If Next i Set pElement = Nothing Set pElements = Nothing End Sub

13.3.6 The Preferences Dialog

The Preferences dialog, which is shown in Figure 13.7, is used mainly to configure the FileSpider band object. Most of the code only sets and retrieves registry settings. But there is one interesting aspect of this form that is worth discussing, and that is the directory dialog. FileSpider requires that a download directory be specified. This, of course, is the directory where FileSpider will dump all downloaded files.

Figure 13.7. Preferences dialog

To specify a directory accurately, we need a way to navigate directories. Fortunately, the shell itself provides us with a ready-made dialog that will allow us to navigate directories. This dialog is shown in Figure 13.8.

Figure 13.8. Directory browser

First things first. We need two functions from the Shell API and one from the Windows API before we can get started. They are declared as follows :

' Displays a dialog box that allows you to select a directory Private Declare Function SHBrowseForFolder Lib "shell32" _ (lpbi As BROWSEINFO) As Long ' Converts a PIDL into a readable path string Private Declare Function SHGetPathFromIDList Lib "shell32" _ (ByVal pidList As Long, ByVal lpBuffer As String) As Long ' Copies a string Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _ (ByVal lpString1 As String, ByVal lpString2 As String) As Long

As you can see, SHBrowseForFolder takes a BROWSEINFO structure, so we'll need one of those. Here's the declaration:

Private Type BROWSEINFO hWndOwner As Long ' Handle to the owner of the dialog pIDLRoot As Long ' Location of the root folder pszDisplayName As Long ' Pointer to a buffer for display name lpszTitle As Long ' Text above tree control in the dialog ulFlags As Long ' Should contain BIF_RETURNONLYFSDIRS, ' BIF_DONTGOBELOWDOMAIN lpfnCallback As Long ' Address of a callback (not needed) lParam As Long ' Value passed to callback (not needed) iImage As Long ' Image associated with selected folder End Type

Now we are ready to implement the function. In the FileSpider band, the code lies in the cmdDir_Click event, which is shown in Example 13.10. A more efficient way is to wrap this code into a class to make it more portable. But if the book did everything for you, you would have nothing to do on those lonely , rainy nights, right?

Example 13.10. The cmdDir_Click Event Procedure

Private Sub cmdDir_Click( ) Dim pidl As LPITEMIDLIST Dim tBrowseInfo As BROWSEINFO Dim sBuffer As String Dim szTitle As String szTitle = "Select Download Directory" With tBrowseInfo .hWndOwner = Me.hwnd .lpszTitle = lstrcat(szTitle, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With pidl = SHBrowseForFolder(tBrowseInfo) If (pidl) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList pidl, sBuffer sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) txtDir = sBuffer End If End Sub

We sure know what PIDLs are at this point in the game, don't we? (If not, you must have totally skipped Chapter 11 !) This function looks fairly simple. BROWSEINFO contains the handle to the parent responsible for the directory dialog and the title of the directory. When it is passed to SHBrowseForFolder , the directory dialog is displayed appropriately. When a directory is selected, we are returned a PIDL. We can pass the PIDL to SHGetPathFromIDList to get the path. With our knowledge of PIDLs, it's possible that we could write our own SHGetPathFromIDList function (if we were so inclined).

only for RuBoard - do not distribute or recompile

Категории