
Imports System.Runtime.InteropServices

Module Utils_DesktopIcons

    Private Const LVM_FIRST As UInteger = 4096
    Private Const LVM_GETITEMCOUNT As UInteger = (LVM_FIRST + 4)
    Private Const LVM_GETITEMRECT As UInteger = (LVM_FIRST + 14)
    Private Const LVM_GETITEMSTATE As UInteger = (LVM_FIRST + 44)
    Private Const LVM_GETITEMTEXT As UInteger = (LVM_FIRST + 45)
    Private Const LVM_GETITEMW As UInteger = (LVM_FIRST + 75)
    Private Const LVM_GETITEMPOSITION As UInteger = (LVM_FIRST + 16)

    Private Const PROCESS_VM_OPERATION As UInteger = 8
    Private Const PROCESS_VM_READ As UInteger = 16
    Private Const PROCESS_VM_WRITE As UInteger = 32

    Private Const MEM_COMMIT As UInteger = 4096
    Private Const MEM_RELEASE As UInteger = 32768
    Private Const MEM_RESERVE As UInteger = 8192

    Private Const PAGE_READWRITE As UInteger = 4

    Private Const LVIF_TEXT As Integer = 1

    Private Const LVIS_FOCUSED As UInteger = 1
    Private Const LVIS_SELECTED As UInteger = 2
    Private Const LVIS_CUT As UInteger = 4
    Private Const LVIS_DROPHILITED As UInteger = 8

    Private Const LVIR_BOUNDS As UInteger = 0
    Private Const LVIR_ICON As UInteger = 1
    Private Const LVIR_LABEL As UInteger = 2
    Private Const LVIR_SELECTBOUNDS As UInteger = 3


    Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As UInteger, ByVal flAllocationType As UInteger, ByVal flProtect As UInteger) As IntPtr

    Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As UInteger, ByVal dwFreeType As UInteger) As Boolean

    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal handle As IntPtr) As Boolean

    Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As IntPtr, ByVal nSize As Integer, ByRef vNumberOfBytesRead As UInteger) As Boolean

    Private Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As IntPtr, ByVal nSize As Integer, ByRef vNumberOfBytesRead As UInteger) As Boolean

    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As UInteger, ByVal bInheritHandle As Boolean, ByVal dwProcessId As UInteger) As IntPtr

    Private Declare Auto Function SendMessage Lib "user32.DLL" (ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

    Private Declare Auto Function FindWindow Lib "user32.DLL" (ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr

    Private Declare Auto Function FindWindowEx Lib "user32.DLL" (ByVal hwndParent As IntPtr, ByVal hwndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr

    Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As IntPtr, ByRef dwProcessId As UInteger) As UInteger


    Private Structure LVITEM
        Public mask As Integer
        Public iItem As Integer
        Public iSubItem As Integer
        Public state As Integer
        Public stateMask As Integer
        Public pszText As IntPtr  ' string
        Public cchTextMax As Integer
        Public iImage As Integer
        Public lParam As IntPtr
        Public iIndent As Integer
        Public iGroupId As Integer
        Public cColumns As Integer
        Public puColumns As IntPtr
    End Structure

    Private Structure POINTAPI
        Dim x As Integer
        Dim y As Integer
    End Structure

    Private Structure RECTAPI
        Dim Left As Int32
        Dim Top As Int32
        Dim Right As Int32
        Dim Bottom As Int32
    End Structure


    Friend Function GetDesktopIcons() As IconParams()
        Dim vItemCount As Integer
        Dim vProcessId As UInteger
        Dim vProcess As IntPtr
        Dim vPointer As IntPtr
        Dim vTransferredBytes As UInteger
        Dim vBuffer() As Byte = New Byte((256) - 1) {}
        Dim vItem(0) As LVITEM

        ' ---------------------------------------------------------------------- get desktop listview handle
        Dim vHandle As IntPtr = FindWindow("Progman", "Program Manager")
        vHandle = FindWindowEx(vHandle, IntPtr.Zero, "SHELLDLL_DefView", Nothing)
        vHandle = FindWindowEx(vHandle, IntPtr.Zero, "SysListView32", "FolderView")

        ' ---------------------------------------------------------------------- get desktop icons count
        vItemCount = SendMessage(vHandle, LVM_GETITEMCOUNT, 0, 0)
        'Debug.Print(vbCr & vItemCount.ToString)

        ' ---------------------------------------------------------------------- prepare the IconParams array
        Dim IconParamArray(vItemCount - 1) As IconParams

        ' ---------------------------------------------------------------------- get desktop listview process 
        GetWindowThreadProcessId(vHandle, vProcessId)
        vProcess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, _
                               False, _
                               vProcessId)

        ' ---------------------------------------------------------------------- alloc a interchange space
        vPointer = VirtualAllocEx(vProcess, _
                                  IntPtr.Zero, _
                                  4096, _
                                  MEM_RESERVE Or MEM_COMMIT, _
                                  PAGE_READWRITE)

        Try
            For i As Int32 = 0 To vItemCount - 1

                ' -------------------------------------------------------------- get icon text
                vItem(0).mask = LVIF_TEXT
                vItem(0).iItem = i
                vItem(0).iSubItem = 0
                vItem(0).cchTextMax = vBuffer.Length
                vItem(0).pszText = CType((CType(vPointer, Integer) + Marshal.SizeOf(GetType(LVITEM))), IntPtr)

                WriteProcessMemory(vProcess, _
                                   vPointer, _
                                   Marshal.UnsafeAddrOfPinnedArrayElement(vItem, 0), _
                                   Marshal.SizeOf(GetType(LVITEM)), _
                                   vTransferredBytes)

                SendMessage(vHandle, LVM_GETITEMW, i, vPointer.ToInt32)
                ReadProcessMemory(vProcess, _
                                  CType((CType(vPointer, Integer) + Marshal.SizeOf(GetType(LVITEM))), IntPtr), _
                                  Marshal.UnsafeAddrOfPinnedArrayElement(vBuffer, 0), _
                                  vBuffer.Length, _
                                  vTransferredBytes)

                IconParamArray(i).IconName = System.Text.Encoding.Unicode.GetString(vBuffer, _
                                                                                    0, _
                                                                                    CType(vTransferredBytes, Integer))

                Dim firstzero As Int32 = InStr(IconParamArray(i).IconName, Chr(0))
                If firstzero > 0 Then
                    IconParamArray(i).IconName = Left(IconParamArray(i).IconName, firstzero - 1)
                End If
                'Debug.Print(IconParamArray(j).IconName.Length.ToString)

                ' -------------------------------------------------------------- get icon location
                SendMessage(vHandle, LVM_GETITEMPOSITION, i, vPointer.ToInt32)
                Dim vPoint(0) As Point
                ReadProcessMemory(vProcess, _
                                  vPointer, _
                                  Marshal.UnsafeAddrOfPinnedArrayElement(vPoint, 0), _
                                  Marshal.SizeOf(GetType(Point)), _
                                  vTransferredBytes)

                IconParamArray(i).IconLocation = vPoint(0)

                ' -------------------------------------------------------------- get icon rectangle
                Dim vRect(0) As RECTAPI
                vRect(0).Left = LVIR_SELECTBOUNDS

                WriteProcessMemory(vProcess, _
                                  vPointer, _
                                  Marshal.UnsafeAddrOfPinnedArrayElement(vRect, 0), _
                                  Marshal.SizeOf(GetType(RECTAPI)), _
                                  vTransferredBytes)

                SendMessage(vHandle, LVM_GETITEMRECT, i, vPointer.ToInt32)

                ReadProcessMemory(vProcess, _
                                  vPointer, _
                                  Marshal.UnsafeAddrOfPinnedArrayElement(vRect, 0), _
                                  Marshal.SizeOf(GetType(RECTAPI)), _
                                  vTransferredBytes)

                IconParamArray(i).IconRect.X = vRect(0).Left
                IconParamArray(i).IconRect.Y = vRect(0).Top
                IconParamArray(i).IconRect.Width = vRect(0).Right - vRect(0).Left
                IconParamArray(i).IconRect.Height = vRect(0).Bottom - vRect(0).Top

                ' -------------------------------------------------------------- get icon state (not working >> always zero)
                'IconParamArray(i).IconState = SendMessage(vHandle, _
                '                                          LVM_GETITEMSTATE, _
                '                                          i, _
                '                                          LVIS_DROPHILITED)
            Next

        Finally
            VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE)
            CloseHandle(vProcess)
        End Try

        Return IconParamArray
    End Function


    Friend Structure IconParams
        Dim IconName As String
        Dim IconLocation As Point
        Dim IconRect As Rectangle
        Dim IconState As Int32
    End Structure


    Friend Function Get_CursorPointedIcon_Info() As String
        Dim iparray() As IconParams
        iparray = GetDesktopIcons()
        '
        For Each ip As IconParams In iparray
            If ip.IconRect.Contains(Cursor.Position) Then
                Return ip.IconName & _
                       ip.IconLocation.ToString & _
                       ip.IconRect.ToString & _
                       " Iconstate=" & ip.IconState.ToString
            End If
        Next
        '
        Return ""
    End Function

    Friend Function Get_CursorPointedIcon_Name() As String
        Dim iparray() As IconParams
        iparray = GetDesktopIcons()
        '
        For Each ip As IconParams In iparray
            If ip.IconRect.Contains(Cursor.Position) Then
                Return ip.IconName
            End If
        Next
        '
        Return ""
    End Function


    ' --------------------------------------------------------------------------------------
    '  Not working temptative to get the desktop-links destination path 
    ' --------------------------------------------------------------------------------------

    'Private Function GetDesktopIconDestinationPath(ByVal IconName As String) As String

    '    Dim d As IO.DirectoryInfo
    '    Dim files() As IO.FileInfo

    '    d = New IO.DirectoryInfo(GetDesktopPath)
    '    files = d.GetFiles()

    '    ' ---------------------------------------------- for each desktop file
    '    For Each f As IO.FileInfo In files

    '        Debug.Print(f.Name & " " & IconName)


    '        If LCase(f.Name) = LCase(IconName & ".lnk") Then
    '            MsgBox(f.Name)

    '        ElseIf LCase(f.Name) = LCase(IconName) Then
    '            MsgBox(f.Name)
    '        End If

    '    Next

    '    Return ""
    'End Function


End Module
