[VB6] Using Structured Queries to conduct a Windows Search by any property

[fafalone]

Structured Queries (ICondition) and the SearchFolderItemFactory

---

IMPORTANT: You need an updated version of oleexp.tlb, v4.61 (released on October 3rd, 2019) or higher to run this project.

---

So I was looking through some old SDK examples and found a whole new way of automatically conducting very powerful searches through Structured Query objects. This creates a temporary folder of search results you can view in a file browser (like my ucShellBrowse, I'm upgrading that and spun this off as a separate demo) or, as in this demo project, show in an Open File Dialog.

This search is done by Windows, so if you have search indexing on it will be faster, but I don't and it seems very fast anyway. The primary advantage of this search method is the structured query system allows search by various criteria among any PROPERTYKEY. The Demo shows that basics, name (PKEY_ItemNameDisplay), size (PKEY_Size), date modified (PKEY_DateModified), kind (PKEY_Kind), and attributes (PKEY_FileAttributes).
Comparing dates with PKEY_DateModified necessitates using the VT_FILETIME type, so this demo shows how to create a PROPVARIANT from a VB User Type. You can use similar techniques for other PROPVARIANT types not well supported in VB.

One other neat thing in the demo; the file types listed as possible values for 'Kind' vary among Windows versions, so I've created a function to enumerate the ones on the current platform, using IPropertyEnumTypeList.

Requirements
Windows 7 or newer
oleexp.tlb 4.61 or higher (Released 03 Oct 2019).
oleexp addons mIID.bas and mPKEY.bas: These modules are included in the main oleexp download; add them to your project (and the demo project, they're referenced but not included).

Code Overview
Here's the main function:

Private Function ExecFileSearchEx(pLocation As IShellItem, pConditions As ICondition) As IShellItem
Dim pObjects As IObjectCollection
Dim ppia As IShellItemArray
Dim psiSearch As IShellItem

Dim pSearchFact As ISearchFolderItemFactory
Set pSearchFact = New SearchFolderItemFactory

If CreateSearchLibrary(pObjects) = S_OK Then
    pObjects.AddObject ByVal ObjPtr(pLocation)
    Set ppia = pObjects
    pSearchFact.SetScope ppia
    pSearchFact.SetDisplayName StrPtr("Search Results")
    Dim pCond As ICondition
    If (pConditions Is Nothing) = False Then
        pSearchFact.SetCondition pConditions
        pSearchFact.GetShellItem IID_IShellItem, psiSearch
        If (psiSearch Is Nothing) = False Then
            Set ExecFileSearchEx = psiSearch
        Else
            Debug.Print "ExecFileSearchEx->Failed to get IShellItem from search factory"
        End If
        Set pCond = Nothing
    Else
        Debug.Print "ExecFileSearchEx->Failed to get ICondition"
    End If
    Set ppia = Nothing
End If
End Function

The first thing created is the SearchFolderItemFactory object, which creates the results folder for us.
The search scope (starting location) is defined by an IShellItemArray, and getting one of those from a single location is a bit tricky... we create an empty IShellLibrary object (like the Documents, Video libraries you see in Explorer), ask for an object collection from that, and add our item; here's the CreateSearchLibrary function referenced above:

Private Function CreateSearchLibrary(pObC As IObjectCollection) As Long
Set pObC = Nothing
Dim pLib As IShellLibrary
Set pLib = New ShellLibrary
If (pLib Is Nothing) = False Then
    CreateSearchLibrary = pLib.GetFolders(LFF_ALLITEMS, IID_IObjectCollection, pObC)
Else
    Debug.Print "CreateSearchLibrary->Failed to create ShellLibrary"
End If
End Function

The most difficult part is creating that ICondition object that's passed to ExecFileSearchEx. You create an ICondition object for each search condition (file name contains, size is less than, etc), then merge them into one ICondition object. Here's what that looks like:

Private Function SetConditions(ppCondition As ICondition) As Long
'Translates the Search settings into an ICondition object
Set ppCondition = Nothing
SetConditions = -1
Dim pFact As IConditionFactory2
Set pFact = New ConditionFactory

'Conditions demonstrated here:
Dim pKind As ICondition
Dim pSize As ICondition
Dim pName As ICondition
Dim pDate1 As ICondition
Dim pAttrib As ICondition

Dim aCds() As ICondition
ReDim aCds(0)
Dim nCds As Long

If (pFact Is Nothing) = False Then
    Dim nCOP As CONDITION_OPERATION
    
    'First, set Name
    If Check2.Value = vbChecked Then
        Dim sText As String
        sText = Text1.Text
        If (sText <> "") And (sText <> "*.*") And (sText <> "*") Then 'Only create a condition if it's not 'All Files'
            If InStr(sText, "*") Or InStr(sText, "?") Then
                nCOP = COP_DOSWILDCARDS
            Else
                nCOP = COP_VALUE_CONTAINS
            End If
            pFact.CreateStringLeaf PKEY_ItemNameDisplay, nCOP, StrPtr(sText), 0&, CONDITION_CREATION_DEFAULT, IID_ICondition, pName
            Set aCds(nCds) = pName
            nCds = nCds + 1
        End If
    End If

    'Exclude folders by looking for the 'D' attribute
    If Check4.Value = vbUnchecked Then
        pFact.CreateStringLeaf PKEY_FileAttributes, COP_VALUE_NOTCONTAINS, StrPtr("D"), 0&, CONDITION_CREATION_DEFAULT, IID_ICondition, pAttrib
        ReDim Preserve aCds(nCds)
        Set aCds(nCds) = pAttrib
        nCds = nCds + 1
    End If
    
    'Set size
    If Check1.Value = vbChecked Then
        Select Case Combo1.ListIndex
            Case 0: nCOP = COP_GREATERTHAN
            Case 1: nCOP = COP_EQUAL
            Case 2: nCOP = COP_LESSTHAN
        End Select
        pFact.CreateIntegerLeaf PKEY_Size, nCOP, CLng(Text3.Text) * 1024, CONDITION_CREATION_DEFAULT, IID_ICondition, pSize
        ReDim Preserve aCds(nCds)
        Set aCds(nCds) = pSize
        nCds = nCds + 1
    End If
    
    'Kind
    If List1.ListIndex > 0 Then
        Dim nKind As Long
        nKind = List1.ListIndex - 1 'ListIndex starts at 0 but we inserted (any) at the start
        pFact.CreateStringLeaf PKEY_Kind, COP_EQUAL, StrPtr(sKindVals(nKind)), 0&, CONDITION_CREATION_DEFAULT, IID_ICondition, pKind
        ReDim Preserve aCds(nCds)
        Set aCds(nCds) = pKind
        nCds = nCds + 1
    End If

    'DateTime
    If Check3.Value = vbChecked Then
        Dim stVal As SYSTEMTIME
        Dim dtNew As Date
        Dim ftVal As FILETIME, ftUtc As FILETIME
        Dim vr As Variant
        Dim pkDate As oleexp.PROPERTYKEY
        dtNew = DTPicker1.Value
        Debug.Print "SearchDateTime " & CStr(dtNew)
        stVal = DateToSystemTime(dtNew)
        SystemTimeToFileTime stVal, ftVal
        LocalFileTimeToFileTime ftVal, ftUtc
        InitPropVariantFromFileTime ftUtc, vr
        
        If Option1(0).Value = True Then
            nCOP = COP_LESSTHAN
        Else
            nCOP = COP_GREATERTHAN
        End If
        pFact.CreateLeaf PKEY_DateModified, nCOP, vr, 0&, StrPtr(LOCALE_NAME_USER_DEFAULT), Nothing, Nothing, Nothing, CONDITION_CREATION_DEFAULT, IID_ICondition, pDate1
        If (pDate1 Is Nothing) = False Then
            Debug.Print "SetConditions->Created DT leaf"
            ReDim Preserve aCds(nCds)
            Set aCds(nCds) = pDate1
            nCds = nCds + 1
        Else
            Debug.Print "SetConditions->Failed to create DateTime condition"
        End If
                
    End If
    ''You can continue to create as many condition leafs with as many Property Keys as you want.
    
    If UBound(aCds) = 0 Then
        'Only one condition, don't need an array
        Set ppCondition = aCds(0)
    Else
        pFact.CreateCompoundFromArray CT_AND_CONDITION, aCds(0), nCds, CONDITION_CREATION_DEFAULT, IID_ICondition, ppCondition
    End If
    If (ppCondition Is Nothing) = False Then SetConditions = S_OK

    Set pFact = Nothing
Else
    Debug.Print "SetConditions->Failed to create factory."
End If
End Function

And that's it, all that's left is calling it and displaying the results:

Private Sub Command1_Click()
Dim psiLoc As IShellItem
Dim pCond As ICondition
oleexp.SHCreateItemFromParsingName StrPtr(Text2.Text), Nothing, IID_IShellItem, psiLoc
If (psiLoc Is Nothing) = False Then
    If SetConditions(pCond) = S_OK Then
        Set siResultsItem = ExecFileSearchEx(psiLoc, pCond)
        If (siResultsItem Is Nothing) = False Then
            Dim fod As FileOpenDialog
            Set fod = New FileOpenDialog
            fod.SetFolder siResultsItem
            fod.Show Me.hWnd
            'Process a file(s) selected from the results here, or even skip it and enumerate the contents of siResultsItem for the full list
        End If
    End If
End If
End Sub

That displays them in an Open File dialog, but there's any number of possibilities since it creates an actual location. In the upcoming version of my Shell Browser, it's just handed off to the normal load folder routine, the 'Results Folder' gets added to the directory tree under Desktop.

---

twinBASIC 64bit compatible version at https://github.com/fafalone/MiscDemos