VBA Everything

[light]

I managed to get the SDK running for VBA 7.1, Excel 2019, based on this excellent example:

viewtopic.php?t=9123

Well ... almost

Everything_GetResultFullPathNameW works, see below.
Everything_GetResultFileNameW crashes.
Everything_GetResultPathW crashes, as well.

As String, as LongPtr, doesn't matter. Best case, the raw pointer is returned.

So any idea, what's wrong with it, aside, it's VBA, I know, I know ...

Code: Select all

Declare PtrSafe Function Everything_GetResultFullPathNameW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long, ByVal ins As LongPtr, ByVal size As Long) As LongPtr

Declare PtrSafe Function Everything_GetResultPathW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long, ByVal ins As LongPtr, ByVal size As Long) As LongPtr

Declare PtrSafe Function Everything_GetResultFileNameW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long) As String

Const MAXPATHLEN = 260

Dim maxPath As String
maxPath = String(MAXPATHLEN, 0)

Dim i as long, result as Long
Dim fullPath as String, filePath as String, fileName as String

for i = 0 to Everything_GetNumResults - 1

result = CLng(Everything_GetResultFullPathNameW(i, StrPtr(maxPath), 260))
fullPath = Left(maxPath, result)

result = CLng(Everything_GetResultFullPathNameW(i, StrPtr(maxPath), 260))
filePath = Left(maxPath, result)

fileName = Everything_GetResultFileNameW(i)
...

[void]

Please make sure you declare the dll function with the Unicode keyword.
Please make sure you call Everything_QueryW (not Everything_QueryA)
Please use String for wide char pointers.

The following worked for me:

Code: Select all

Public Class Form1

    Public Declare Unicode Function Everything_SetSearchW Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal search As String) As UInt32
    Public Declare Function Everything_SetRequestFlags Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal dwRequestFlags As UInt32) As UInt32
    Public Declare Function Everything_QueryW Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal bWait As Integer) As Integer
    Public Declare Function Everything_GetNumResults Lib "d:\dev\everything\sdk\dll\Everything32.dll" () As UInt32
    Public Declare Unicode Function Everything_GetResultFileNameW Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal index As UInt32) As String
    Public Declare Unicode Function Everything_GetResultPathW Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal index As UInt32) As String
    Public Declare Function Everything_GetLastError Lib "d:\dev\everything\sdk\dll\Everything32.dll" () As UInt32
    Public Declare Unicode Function Everything_GetResultFullPathNameW Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal index As UInt32, ByVal buf As System.Text.StringBuilder, ByVal size As UInt32) As UInt32
    Public Declare Function Everything_GetResultSize Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal index As UInt32, ByRef size As UInt64) As Integer
    Public Declare Function Everything_GetResultDateModified Lib "d:\dev\everything\sdk\dll\Everything32.dll" (ByVal index As UInt32, ByRef ft As UInt64) As Integer

    Public Const EVERYTHING_REQUEST_FILE_NAME = &H1
    Public Const EVERYTHING_REQUEST_PATH = &H2
    Public Const EVERYTHING_REQUEST_FULL_PATH_AND_FILE_NAME = &H4
    Public Const EVERYTHING_REQUEST_EXTENSION = &H8
    Public Const EVERYTHING_REQUEST_SIZE = &H10
    Public Const EVERYTHING_REQUEST_DATE_CREATED = &H20
    Public Const EVERYTHING_REQUEST_DATE_MODIFIED = &H40
    Public Const EVERYTHING_REQUEST_DATE_ACCESSED = &H80
    Public Const EVERYTHING_REQUEST_ATTRIBUTES = &H100
    Public Const EVERYTHING_REQUEST_FILE_LIST_FILE_NAME = &H200
    Public Const EVERYTHING_REQUEST_RUN_COUNT = &H400
    Public Const EVERYTHING_REQUEST_DATE_RUN = &H800
    Public Const EVERYTHING_REQUEST_DATE_RECENTLY_CHANGED = &H1000
    Public Const EVERYTHING_REQUEST_HIGHLIGHTED_FILE_NAME = &H2000
    Public Const EVERYTHING_REQUEST_HIGHLIGHTED_PATH = &H4000
    Public Const EVERYTHING_REQUEST_HIGHLIGHTED_FULL_PATH_AND_FILE_NAME = &H8000

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Everything_SetSearchW(TextBox1.Text)
        Everything_SetRequestFlags(EVERYTHING_REQUEST_FILE_NAME Or EVERYTHING_REQUEST_PATH Or EVERYTHING_REQUEST_SIZE Or EVERYTHING_REQUEST_DATE_MODIFIED)
        Everything_QueryW(1)

        Dim NumResults As UInt32
        Dim i As UInt32
        'Dim filename As New System.Text.StringBuilder(260)
        Dim size As UInt64
        Dim ftdm As UInt64
        Dim DateModified As System.DateTime

        NumResults = Everything_GetNumResults()

        ListBox1.Items.Clear()

        If NumResults > 0 Then
            For i = 0 To NumResults - 1

                'Everything_GetResultFullPathNameW(i, filename, filename.Capacity)
                Everything_GetResultSize(i, size)
                Everything_GetResultDateModified(i, ftdm)

                DateModified = System.DateTime.FromFileTime(ftdm)

                'ListBox1.Items.Insert(i, filename.ToString() & " size:" & size & " date:" & DateModified.ToString())
                ListBox1.Items.Insert(i, Everything_GetResultPathW(i) & " \ " & Everything_GetResultFileNameW(i) & " size:" & size & " date:" & DateModified.ToString())

            Next
        End If

    End Sub

End Class

[light]

Thanks a lot. Unfortunately, your code looks like VB.net or something. In VBA, there is no Unicode keyword for declarations.

Meanwhile, I solved LPCWSTR to VBA.String by using "StringFromPointerW", s. below.

Code: Select all

Option Explicit

Private Declare PtrSafe Function lstrlenW Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)

' https://codekabinett.com/rdumps.php?Lang=2&targetDoc=api-pointer-convert-vba-string-ansi-unicode

Function StringFromPointerW(ByVal pointerToString As LongPtr) As String
    Const BYTES_PER_CHAR As Integer = 2
    Dim tmpBuffer()    As Byte
    Dim byteCount      As Long
    byteCount = lstrlenW(pointerToString) * BYTES_PER_CHAR
    If byteCount > 0 Then
        ReDim tmpBuffer(0 To byteCount - 1) As Byte
        Call CopyMemory(VarPtr(tmpBuffer(0)), pointerToString, byteCount)
    End If
    StringFromPointerW = tmpBuffer
End Function ' StringFromPointerW()

Sub testEverything()

    Dim search As String
    Dim result As Long
    
    search = "d: ""important keyword"""   
    result = Everything_SetSearchW(StrPtr(search))
    result = Everything_QueryW(True)
    
    Dim n As Long
    n = Everything_GetNumResults
    
    If n > 0 Then
    
        Const MAXPATHLEN = 260 ' 255 Char + 4 Length + Null
        Dim maxPath As String
        Dim i As Long
        
        For i = 1 To n
 
 '           OK!       
            maxPath = String(MAXPATHLEN, 0)
            result = Everything_GetResultFullPathNameW(i - 1, StrPtr(maxPath), 260)
            fullPath = Left(maxPath, result)
                        
'           CRASHES!
'           a(i, 1) = StringFromPointerW(Everything_GetResultPathW(i - 1))

'           OK!
            a(i, 2) = StringFromPointerW(Everything_GetResultFileNameW(i - 1))

	    ...

From reading Everything.h, I don' t get it, why Everything_GetResultPathW crashes, and Everything_GetResultFileNameW works perfectly fine.

Everything.h

Code: Select all

EVERYTHINGUSERAPI LPCWSTR EVERYTHINGAPI Everything_GetResultPathW(DWORD dwIndex);

EVERYTHINGUSERAPI LPCWSTR EVERYTHINGAPI Everything_GetResultFileNameW(DWORD dwIndex);

VBA:

Code: Select all

Declare PtrSafe Function Everything_GetResultPathW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long) As LongPtr ' LPCWSTR

Declare PtrSafe Function Everything_GetResultFileNameW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long) As LongPtr ' LPCWSTR

Any hint appreciated.

[void]

Odd, please try setting a temporary variable to the result of Everything_GetResultPathW .
Insert a break point and check if Everything_GetResultPathW is returning NULL.

Are you calling Everything_SetRequestFlags? -If so, please make sure you are requesting the path.

The following worked for me with Excel 2016 x64:

Code: Select all

Private Declare PtrSafe Function Everything_GetResultFullPathNameW Lib "C:\Users\limited\Desktop\everything64.dll" _
(ByVal index As Long, ByVal ins As LongPtr, ByVal size As Long) As Long

Private Declare PtrSafe Function Everything_GetResultPathW Lib "C:\Users\limited\Desktop\everything64.dll" _
(ByVal index As Long) As LongPtr

Private Declare PtrSafe Function Everything_GetResultFileNameW Lib "C:\Users\limited\Desktop\everything64.dll" _
(ByVal index As Long) As LongPtr

Private Declare PtrSafe Function Everything_SetSearchW Lib "C:\Users\limited\Desktop\everything64.dll" _
(ByVal search As LongPtr) As Long

Private Declare PtrSafe Function Everything_QueryW Lib "C:\Users\limited\Desktop\everything64.dll" _
(ByVal wait As Integer) As Long

Private Declare PtrSafe Function Everything_GetNumResults Lib "C:\Users\limited\Desktop\everything64.dll" _
() As Long

Option Explicit

Private Declare PtrSafe Function lstrlenW Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)

' https://codekabinett.com/rdumps.php?Lang=2&targetDoc=api-pointer-convert-vba-string-ansi-unicode

Function StringFromPointerW(ByVal pointerToString As LongPtr) As String
    Const BYTES_PER_CHAR As Integer = 2
    Dim tmpBuffer()    As Byte
    Dim byteCount      As Long
    byteCount = lstrlenW(pointerToString) * BYTES_PER_CHAR
    If byteCount > 0 Then
        ReDim tmpBuffer(0 To byteCount - 1) As Byte
        Call CopyMemory(VarPtr(tmpBuffer(0)), pointerToString, byteCount)
    End If
    StringFromPointerW = tmpBuffer
End Function ' StringFromPointerW()

Private Sub CommandButton1_Click()

    Dim result As Long
    
    result = Everything_SetSearchW(StrPtr(searchbox))
    result = Everything_QueryW(True)
    
    Dim n As Long
    n = Everything_GetNumResults()
    
    If n > 0 Then
    
        Dim i As Long
    
        For i = 1 To n

            Cells(i, 1) = StringFromPointerW(Everything_GetResultPathW(i - 1))
            Cells(i, 2) = StringFromPointerW(Everything_GetResultFileNameW(i - 1))
        Next i
    End If
End Sub

[light]

Thanks. Confirmed. Your code works like a charm with Excel 2019 x64, as well.

Back to my test sub, after "compressing" my code a bit, I could not reproduce the crashes, that I had before.

But, there is still something weird going on, now, when I am modifying the VBA source code for Everything DLL declarations. The compiler throws "insufficient memory", as soon as I copy & paste a declaration statement from here to there. Comment after paste helps. But ?!?!

Ok. That's VBA. I have to drill further. With Everything, everything is fine

This is my latest running version.

Code: Select all

' everythingTest

Option Explicit

Declare PtrSafe Function Everything_GetNumResults Lib "d:\dropbox\autover\vba\everything\everything64.dll" () As Long

Declare PtrSafe Function Everything_GetResultFullPathNameW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long, ByVal ins As LongPtr, ByVal size As Long) As Long

Declare PtrSafe Function Everything_GetResultPathW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long) As LongPtr ' LPCWSTR

Declare PtrSafe Function Everything_GetResultFileNameW Lib "d:\dropbox\autover\vba\everything\everything64.dll" _
(ByVal index As Long) As LongPtr ' LPCWSTR

Private Declare PtrSafe Function lstrlenW Lib "kernel32.dll" (ByVal lpString As LongPtr) As Long

Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As Long)

' https://codekabinett.com/rdumps.php?Lang=2&targetDoc=api-pointer-convert-vba-string-ansi-unicode

Public Function StringFromPointerW(ByVal pointerToString As LongPtr) As String

    Const BYTES_PER_CHAR As Integer = 2
    Dim tmpBuffer()    As Byte
    Dim byteCount      As Long
    byteCount = lstrlenW(pointerToString) * BYTES_PER_CHAR
    If byteCount > 0 Then
        ReDim tmpBuffer(0 To byteCount - 1) As Byte
        Call CopyMemory(VarPtr(tmpBuffer(0)), pointerToString, byteCount)
    End If
    StringFromPointerW = tmpBuffer

End Function ' StringFromPointerW()


Sub testEverything()

    Dim search As String

    search = "d: ""so important"""
    
    Everything_SetSearchW StrPtr(search)
    Everything_QueryW True 
    
    Dim n As Long
    n = Everything_GetNumResults

    If n > 0 Then
   
        Const MAXPATHLEN = 260 ' 255 Char + 4 Length + Null
        Dim maxPath As String
        maxPath = String(MAXPATHLEN, 0)

        ReDim a(n, 2) As String
        a(0, 0) = "fullPath"
        a(0, 1) = "path"
        a(0, 2) = "filename"
        
        Dim i As Long
        
        For i = 1 To n
            a(i, 0) = Left(maxPath, Everything_GetResultFullPathNameW(i - 1, StrPtr(maxPath), 260))
            a(i, 1) = StringFromPointerW(Everything_GetResultPathW(i - 1))
            a(i, 2) = StringFromPointerW(Everything_GetResultFileNameW(i - 1))
        next i
        
    End If
    
    With Sheets(1)
        .Range("a1").CurrentRegion.Clear
        .Range("a1").Resize(i, 3) = a
        .Range("a1:c1").Font.Bold = True
        .Columns("a:c").AutoFit
    End With
    
End Sub ' testEverything

[light]

Just to finish, for the records: the solution of "weird" is simple. If you are using dynamic arrays in VBA, don't forget to release memory. In my case, just insert

Code: Select all

Erase a

after the for-loop, before exit, and really everything is fine. Even for numResults > 10.000, > 100.000, whatever.