Click here to Skip to main content
15,892,298 members
Articles / Desktop Programming / Win32

ExpTreeLib Version 3 - Explorer-like Navigation and Operation for your Forms

Rate me:
Please Sign up or sign in to vote.
4.97/5 (54 votes)
9 Jan 2014CPOL22 min read 280.9K   14K   83  
A Class Library for building Forms with a folder navigation TreeView and form specific ListViews that can be tailored for your application and behave like Windows Explorer. Full documentation.
Imports ExpTreeLib
Imports ExpTreeLib.CShItem
Imports ExpTreeLib.SystemImageListManager
Imports ExpTreeLib.ShellDll
Imports ExpTreeLib.ShellDll.ShellAPI
Imports ExpTreeLib.ShellDll.ShellHelper
Imports System.Collections.Generic
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports System.IO
Imports System.Text
Imports System.Threading

''' <summary>
''' This Form is an <b>optimized</b> fully working start point for any form which requires an ExplorerTree and
''' ListView. It illustrates the use of a BackgroundWorker to insert slow to gather information into ListViewItems.
''' It leaves enough room for application specific controls. 
''' </summary>
''' <remarks>
''' <para>This Form illustrates the use of:
''' <list type="bullet">
''' <item><description>Use of a BackgroundWorker to improve GUI responsiveness.</description></item>
''' <item><description>Use of the ExpTreeNodeSelected Event Handler.</description></item>
''' <item><description>Use of LVColSorter for column sorting. See MakeLviItem for a custom ListViewItem 
''' builder which is compatible with and useful for LVColSorter. 
''' See Also SortLVItems for how to perform a Refresh of the 
''' ListView in response to a Refresh command from the Context Menu.</description></item>
''' <item><description>Full Context Menus in the ListView.</description></item>
''' <item><description>ListViewItem editing (first SubItem only) if the ListViewItem.Tag is a CShItem.</description></item>
''' <item><description>Handling of dynamic update Events from CShItemUpdate Events.</description></item>
''' <item><description>Proper handling of the Delete Key.</description></item>
''' <item><description>Shows how to handle a DoubleClick on a ListViewItem.</description></item>
''' </list>
''' </para>
''' </remarks>
Public Class frmThread_TestVersion
    'avoid Globalization problem-- an empty timevalue
    Dim EmptyTimeValue As New DateTime(1, 1, 1, 0, 0, 0)

    Private LastSelectedCSI As CShItem

    Private DW As CDragWrapper              'wrapper for Drag ops originating in lv1
    Private DropWrap As ClvDropWrapper      'wrapper for Drop ops targeting lv1

    Private m_CreateNew As Boolean = False  'Flag for NewMenu processing of "New" item

#Region "   Public Properties"
    ''' <summary>
    ''' InitialLoadLimit is a the number of lv1.Items whose IconIndex will we fetched on initial load
    ''' the balance will be fetched AFTER lv1 shows its initial display
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <Browsable(True), Category("Misc"), _
    Description("Maximum # of Items to build in GUI Thread for initial display"), _
    DefaultValue(32)> _
    Public Property InitialLoadLimit() As Integer
        Get
            Return _InitialLoadLimit
        End Get
        Set(ByVal value As Integer)
            _InitialLoadLimit = value
        End Set
    End Property
    Private _InitialLoadLimit As Integer = 32

    ''' <summary>
    ''' WorkUpdateInterval is the Maximum # of Items to build in each 
    ''' BackGroundWorker Progress Interval before reporting them back to the GUI.
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks>If there are 200 items to show, the first InitialLoadLimit will be built and
    '''          displayed in the GUI thread. The balance will be built in the BackgroundWorker
    '''          thread and reported back to the GUI in chunks of WorkUpdateInterval Items.</remarks>
    <Browsable(True), Category("Misc"), _
    Description("Maximum # of Items in each Background update interval"), _
    DefaultValue(100)> _
    Public Property WorkUpdateInterval() As Integer
        Get
            Return _WorkUpdateInterval
        End Get
        Set(ByVal value As Integer)
            _WorkUpdateInterval = value
        End Set
    End Property
    Private _WorkUpdateInterval As Integer = 100
#End Region

#Region "   Form Close Methods"
    Private Sub ExitToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitToolStripMenuItem.Click
        Me.Close()
    End Sub

    Private Sub frmThread_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing  '7/1/2012
        RemoveHandler CShItemUpdate, AddressOf UpdateInvoke '7/1/2012
        Event2.Close()          '7/8/2012
    End Sub         '7/1/2012

#End Region

#Region "   Form Load/VisibleChanged, lv1 HandleCreated"

    Private Sub frmThread_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Setup Drag and Drop Wrappers
        DW = New CDragWrapper(lv1)
        DropWrap = New ClvDropWrapper(lv1)
        'Setup Change Notification	7/1/2012
        AddHandler CShItemUpdate, AddressOf UpdateInvoke        '7/1/2012
    End Sub

    Private Sub lv1_HandleCreated(ByVal sender As Object, ByVal e As System.EventArgs) _
                Handles lv1.HandleCreated
        SystemImageListManager.SetListViewImageList(lv1, False, False)
        SystemImageListManager.SetListViewImageList(lv1, True, False)
    End Sub

    Private Sub frmThread_VisibleChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.VisibleChanged
        SystemImageListManager.SetListViewImageList(lv1, False, False)
        SystemImageListManager.SetListViewImageList(lv1, True, False)
    End Sub
#End Region

#Region "   ExplorerTree Event Handling -- AfterNodeSelect"
    Private Sub AfterNodeSelect(ByVal pathName As String, ByVal CSI As CShItem) _
           Handles ExpTree1.ExpTreeNodeSelected

        If LastSelectedCSI IsNot Nothing AndAlso LastSelectedCSI Is CSI Then Exit Sub
        Cursor = Cursors.WaitCursor
        tsslMiddle.Text = pathName
        Me.Text = pathName
        tsslLeft.Text = "Building Display"

        If BGW2 IsNot Nothing Then
            BGW2.CancelAsync()
            Event2.WaitOne()
        End If
        Dim TotalItems As Integer
        Dim StTime As DateTime = Now()
        Dim combList As ArrayList = CSI.GetItems

        TotalItems = combList.Count
        If TotalItems > 0 Then
            'Build the ListViewItems & add to lv1
            lv1.BeginUpdate()
            lv1.Items.Clear()
            If LastSelectedCSI IsNot Nothing AndAlso LastSelectedCSI IsNot CSI Then
                LastSelectedCSI.ClearItems(True)
            End If
            lv1.Refresh()

            Dim InitialFillLim As Integer = Math.Min(combList.Count, InitialLoadLimit)
            Dim FirstLoad As New List(Of ListViewItem)(InitialFillLim)
            For i As Integer = 0 To InitialFillLim - 1
                Dim lvi As ListViewItem = MakeSparceLVItem(combList(i))
                RefreshLvi(lvi)
                lvi.ImageIndex = SystemImageListManager.GetIconIndex(combList(i), False)
                FirstLoad.Add(lvi)
            Next
            lv1.Items.AddRange(FirstLoad.ToArray)

            'Fill the ListView with the remaining items without FileInfo or ICon
            Dim SparseLoad As New List(Of ListViewItem)(combList.Count - InitialFillLim)
            If combList.Count > InitialFillLim Then
                For i As Integer = InitialFillLim To combList.Count - 1
                    Dim lvi As ListViewItem = MakeSparceLVItem(combList(i))
                    RefreshLvi(lvi, True)
                    SparseLoad.Add(lvi)
                Next
                lv1.Items.AddRange(SparseLoad.ToArray)
            End If
            lv1.EndUpdate()

            If combList.Count > InitialLoadLimit Then
                LoadLV1(SparseLoad)
            End If
        Else
            lv1.Items.Clear()
            If LastSelectedCSI IsNot Nothing AndAlso LastSelectedCSI IsNot CSI Then
                LastSelectedCSI.ClearItems(True)
            End If
            tsslRight.Text = " Has No Items"
        End If
        LastSelectedCSI = CSI
        lv1.Tag = LastSelectedCSI           '7/5/2012   For ClvDropWapper

        'Now that lv.ListViewItems has been set up (and MakeLvItem does attach the appropriate tags
        ' to both the ListViewItem and the appropriate SubItems), set the ListViewItemSorter
        lv1.ListViewItemSorter = New LVColSorter(lv1)
        tsslLeft.Text = "Ready"
        Debug.WriteLine("Visible " & CSI.Text & " " & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms")
        ShowCounts()
        Cursor = Cursors.Default
    End Sub

    Private Sub ShowCounts()
        If lv1.Items.Count > 0 Then
            Dim Dirs As Integer
            Dim Files As Integer
            For Each lvi As ListViewItem In lv1.Items
                Dim Item As CShItem = lvi.Tag
                If Item.IsFolder Then
                    Dirs += 1
                Else : Files += 1
                End If
            Next
            tsslRight.Text = Dirs & " Directories " & Files & " Files"
        Else
            tsslRight.Text = " Has No Items"
        End If
    End Sub
#End Region

#Region "   Various MakeLV routines"

    ''' <summary>
    ''' Creates a minimal ListViewItem from the input CShItem
    ''' </summary>
    ''' <param name="item">The CShItem that this ListViewItem represents</param>
    ''' <returns>A ListViewItem with .Tag and .Text filled, with empty SubItems for the balance of the SubItems required by the ListView.</returns>
    ''' <remarks>When it is timely to fill the remaining SubItems with data (after BGW2 has completed), call RefreshLvi.</remarks>
    Private Function MakeSparceLVItem(ByVal item As CShItem) As ListViewItem
        Dim lvi As New ListViewItem(item.DisplayName)
        With lvi
            .Tag = item
            For i As Integer = 1 To lv1.Columns.Count - 1
                .SubItems.Add("")
            Next
        End With
        Return lvi
    End Function

    ''' <summary>
    ''' Loads all of a ListViewItem's SubItems with values from the associated CShItem - obtained from the ListViewItem's .Tag.
    ''' Note that the CShItem's time sensitive values will be set by CShItem using a W32_FindData structure if it finds one in the
    ''' CShItem's .Tag - as set in this Form by a BackgroundWorker.
    ''' </summary>
    ''' <param name="lvi">The ListViewItem to be refreshed</param>
    ''' <param name="DeferSet">If True, Defer the filling of Length and Date information until later (in the BackgroundWorker).
    '''                        If False (the default) fill Length and Date information in this call.</param>
    ''' <remarks>For optimization, depends on BGW2 having filled CSI.W32Data with a W32Find_Data structure which CShItem will 
    '''          use for Length, Attributes, and Date information.</remarks>
    Private Sub RefreshLvi(ByVal lvi As ListViewItem, Optional ByVal DeferSet As Boolean = False)
        Dim CSI As CShItem = lvi.Tag
        'Set the Items that must come from a CShItem
        lvi.Text = CSI.Name
        lvi.SubItems(3).Text = CSI.TypeName

        If Not DeferSet Then    'Set the SubItems that may come from an W32Find_Data
            With lvi
                'Set Length
                If CSI.IsDisk OrElse (CSI.IsFileSystem And Not CSI.IsFolder) Then      'Not CSI.IsDisk And
                    If CSI.Length > 1024 Then
                        .SubItems(1).Text = (Format(CSI.Length / 1024, "#,### KB"))
                    Else
                        .SubItems(1).Text = (Format(CSI.Length, "##0 Bytes"))
                    End If
                    .SubItems(1).Tag = CSI.Length
                Else
                    '.SubItems(1) already has been correctly set to blank entry
                    'But, to make LVColSorter work correctly, then we have to Set the .Tag to 0 (really)
                    .SubItems(1).Tag = 0L
                End If
                'Set LastWriteTime
                If CSI.IsDisk OrElse CSI.LastWriteTime = EmptyTimeValue Then '"#1/1/0001 12:00:00 AM#" is empty
                    '.SubItems(2) already has been correctly set to blank entry
                    'But, to make LVColSorter work correctly, then we have to Set the .Tag to EmptyTimeValue
                    ' (Not really in this case, but it is good to do in the general case)
                    .SubItems(2).Tag = EmptyTimeValue
                Else
                    .SubItems(2).Text = CSI.LastWriteTime.ToString("MM/dd/yyyy HH:mm:ss")   '01/01/2014
                    .SubItems(2).Tag = CSI.LastWriteTime
                End If
                'Set Attributes
                If Not CSI.IsDisk And CSI.IsFileSystem Then
                    Dim SB As New StringBuilder()
                    Try
                        Dim attr As FileAttributes = CSI.Attributes
                        If (attr And FileAttributes.System) = FileAttributes.System Then SB.Append("S")
                        If (attr And FileAttributes.Hidden) = FileAttributes.Hidden Then SB.Append("H")
                        If (attr And FileAttributes.ReadOnly) = FileAttributes.ReadOnly Then SB.Append("R")
                        If (attr And FileAttributes.Archive) = FileAttributes.Archive Then SB.Append("A")
                    Catch
                    End Try
                    .SubItems(4).Text = SB.ToString
                Else
                    '.SubItems(4) already has been correctly set to blank entry
                    'But, to make LVColSorter work correctly, then we have to Set the .Tag to EmptyTimeValue
                    ' (Not really in this case, but it is good to do in the general case)
                    .SubItems(4).Tag = EmptyTimeValue
                End If
                'Set CreationTime
                If CSI.IsDisk OrElse CSI.CreationTime = EmptyTimeValue Then '"#1/1/0001 12:00:00 AM#" is empty
                    '.SubItems(5) already has been correctly set to blank entry
                    'But, to make LVColSorter work correctly, then we have to Set the .Tag to EmptyTimeValue
                    ' (Not really in this case, but it is good to do in the general case)
                    .SubItems(5).Tag = EmptyTimeValue
                Else
                    .SubItems(5).Text = CSI.CreationTime.ToString("MM/dd/yyyy HH:mm:ss")   '01/01/2014
                    .SubItems(5).Tag = CSI.CreationTime
                End If
            End With
        End If
    End Sub

#End Region

#Region "   The Background worker"
    Private WithEvents BGW2 As BackgroundWorker
    Private Event2 As New ManualResetEvent(True)
    Private InBkground As Integer = 0
    Private ItemInfo As Dictionary(Of String, W32Find_Data)
    Private BkStTime As DateTime

    Private Sub LoadLV1(ByVal ListToDo As List(Of ListViewItem))
        Debug.WriteLine("----LoadLV1 ListToDo.Count = " & ListToDo.Count)
        BkStTime = Now()
        If ListToDo IsNot Nothing AndAlso ListToDo.Count > 0 Then
            Event2.Reset()
            BGW2 = New BackgroundWorker
            tsslLeft.Text = "Loading Info"
            With BGW2
                .WorkerReportsProgress = True
                .WorkerSupportsCancellation = True
                InBkground = 0
                .RunWorkerAsync(ListToDo)
            End With
        End If
    End Sub

    '7/8/2012 - Routine modified to correct a potential deadlock
    Private Sub BGW2_DoWork(ByVal sender As Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BGW2.DoWork
        Dim ThisWorker As BackgroundWorker = sender
        Dim WorkList As List(Of ListViewItem) = e.Argument
        Dim Results As New List(Of ListViewItem)(WorkUpdateInterval)
        Dim Item As CShItem = DirectCast(WorkList(0).Tag, CShItem).Parent
        If Item.IsFileSystem AndAlso WorkList.Count > 0 Then
            GetItemDatas(Item, WorkList)
        End If
        For i As Integer = 0 To WorkList.Count - 1
            If ThisWorker.CancellationPending Then
                e.Cancel = True : Results = Nothing
                Exit For
            End If
            Item = WorkList(i).Tag
            'Force fetch of IconIndex 
            Dim tmp As Integer = Item.IconIndexNormal
            Results.Add(WorkList(i))
            If Results.Count = WorkUpdateInterval Then
                If ThisWorker.CancellationPending Then
                    e.Cancel = True : Results = Nothing
                    Exit For
                End If
                ThisWorker.ReportProgress(i, Results)
                Results = New List(Of ListViewItem)(WorkUpdateInterval)
            End If
        Next
        Event2.Set()
        e.Result = Results
    End Sub

    Private Sub BGW2_ProgressChanged(ByVal sender As Object, ByVal e As System.ComponentModel.ProgressChangedEventArgs) Handles BGW2.ProgressChanged
        Dim Items As List(Of ListViewItem) = e.UserState
        For Each Lvi As ListViewItem In Items
            SetLvi(Lvi)
            InBkground += 1
        Next
    End Sub

    Private Sub BGW2_RunWorkerCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.RunWorkerCompletedEventArgs) Handles BGW2.RunWorkerCompleted
        Debug.WriteLine("----RWCompleted - " & e.ToString)
        If Not e.Cancelled AndAlso e.Error Is Nothing Then
            If e.Result IsNot Nothing Then
                Dim Items As List(Of ListViewItem) = e.Result
                For Each Lvi As ListViewItem In Items
                    SetLvi(Lvi)
                    InBkground += 1
                Next
            End If
        End If
        Debug.WriteLine("Total " & " " & Now().Subtract(BkStTime).TotalMilliseconds.ToString & "ms")
        'Debug.WriteLine(InBkground & " Items set in BGW2")
        Event2.Set()
        BGW2.Dispose()          '7/8/2012
        BGW2 = Nothing
    End Sub

    Private Sub GetItemDatas(ByVal BaseCSI As CShItem, ByVal LVIList As List(Of ListViewItem))
        ItemInfo = New Dictionary(Of String, W32Find_Data)(LVIList.Count)
        Try
            GetInfos(BaseCSI)
        Catch ex As ApplicationException    'only occurs on Invalid Handle - we have nothing to do
            Exit Sub
        End Try
        For Each Lvi As ListViewItem In LVIList
            Dim CSI As CShItem = Lvi.Tag
            Dim csiName As String = IO.Path.GetFileName(CSI.Path)
            If CSI.IsFolder Then
                csiName = csiName & "\"
            End If
            If ItemInfo.ContainsKey(csiName) Then
                CSI.W32Data = ItemInfo(csiName)
            Else
#If DEBUG Then
                Throw New ArgumentException("No ItemData for " & CSI.Path)
#End If
            End If
        Next
    End Sub

    Private Sub GetInfos(ByVal CSI As CShItem)

        Dim DirName As String = CSI.Path
        Dim Data As New W32Find_Data(DirName)

        Dim Handle As SafeFindHandle = Nothing

        Handle = FindFirstFile(DirName & "\*", Data)
        If Handle.IsInvalid Then
            Debug.WriteLine("Invalid Handle for " & CSI.Path)
            Throw New ApplicationException("Invalid FindFileHandle returned for " & DirName)
        End If
        Dim HR As Boolean = True
        While (HR)
            If (Data.dwFileAttributes And FileAttributes.Directory) <> 0 Then
                If Not Data.cFileName.StartsWith(".") Then
                    ItemInfo.Add(Data.Name & "\", Data)
                End If
            Else
                ItemInfo.Add(Data.Name, Data)
            End If
            Data = New W32Find_Data(DirName)
            HR = FindNextFile(Handle, Data)
        End While
        Handle.Close()
    End Sub

    Private Sub SetLvi(ByVal Lvi As ListViewItem)
        Dim CSI As CShItem = Lvi.Tag
        Lvi.ImageIndex = CSI.IconIndexNormal
        RefreshLvi(Lvi)
    End Sub

#End Region

#Region "   View Menu Event Handling"
    Private Sub mnuViewLargeIcons_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LargeIconsToolStripMenuItem.Click
        lv1.View = View.LargeIcon
    End Sub

    Private Sub mnuViewSmallIcons_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SmallIconsToolStripMenuItem.Click
        lv1.View = View.SmallIcon
    End Sub

    Private Sub mnuViewList_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListToolStripMenuItem.Click
        lv1.View = View.List
    End Sub

    Private Sub mnuViewDetails_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DetailsToolStripMenuItem.Click
        lv1.View = View.Details
    End Sub

    Private Sub mnuViewTile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TileToolStripMenuItem.Click
        lv1.TileSize = New Size(CInt(lv1.ClientSize.Width * 0.333), CInt(lv1.ClientSize.Height / 4))
        lv1.View = View.Tile
    End Sub
#End Region

#Region "   Dynamic Update Handler"
    ''' <summary>
    ''' To receive notification of changes to the FileSystem which may affect the GUI display, declare
    ''' DeskTopItem WithEvents. Changes to CShItem's internal tree which are caused by notification of 
    ''' FileSystem changes or by a refresh of the contents of the internal tree raise CShItemUpdate
    ''' events.  For possible future changes, we check to see if an Invoke is required or not.
    ''' </summary>
    ''' <remarks></remarks>
    Private Delegate Sub InvokeUpdate(ByVal sender As Object, ByVal e As ShellItemUpdateEventArgs)

    'Private WithEvents DeskTopItem As CShItem = CShItem.GetDeskTop '7/1/2012

    Private m_InvokeUpdate As New InvokeUpdate(AddressOf DoItemUpdate)

    ''' <summary>
    ''' Returns the last CShItem Selected.
    ''' </summary>
    Public ReadOnly Property SelectedItem() As CShItem
        Get
            Return LastSelectedCSI
        End Get
    End Property
    ''' <summary>
    ''' Determines if DoItemUpdate should be called directly or via Invoke, and then calls it.
    ''' </summary>
    ''' <param name="sender">The CShItem of the Folder of the changed item.</param>
    ''' <param name="e">Contains information about the type of change and items affected.</param>
    ''' <remarks>Responds to events raised by either WM_Notify messages or FileWatch.</remarks>
    Private Sub UpdateInvoke(ByVal sender As Object, ByVal e As ShellItemUpdateEventArgs) '7/1/2012 removed Handles clause
        If Me.InvokeRequired Then
            Invoke(m_InvokeUpdate, sender, e)
        Else
            DoItemUpdate(sender, e)
        End If
    End Sub
    ''' <summary>
    ''' Makes changes in lv1 GUI in response to updating events raised by CShItem.
    ''' </summary>
    ''' <param name="sender">The CShItem of the Folder of the changed item.</param>
    ''' <param name="e">Contains information about the type of change and items affected.</param>
    ''' <remarks>Responds to events raised by WM_Notify messages. </remarks>
    Private Sub DoItemUpdate(ByVal sender As Object, ByVal e As ShellItemUpdateEventArgs)
        Debug.WriteLine("Enter frmThread DoItemUpdate -- " & DirectCast(e.Item, CShItem).DisplayName & " - " & e.UpdateType.ToString)
        Dim Parent As CShItem = DirectCast(sender, CShItem)
        If Parent Is LastSelectedCSI Then ' 6/11/2012 - OrElse (e.Item Is LastSelectedCSI AndAlso e.UpdateType = CShItemUpdateType.Updated) Then   'If not, then of no interest to us
            Try
                lv1.BeginUpdate()
                Select Case e.UpdateType
                    Case CShItem.CShItemUpdateType.Created
                        Dim lvi As ListViewItem = MakeSparceLVItem(e.Item)
                        lvi.ImageIndex = e.Item.IconIndexNormal
                        RefreshLvi(lvi)
                        InsertLvi(lvi, lv1)     '6/11/2012
                        If m_CreateNew Then
                            m_CreateNew = False
                            lvi.BeginEdit()
                        End If
                    Case CShItemUpdateType.Deleted
                        Dim lvi As ListViewItem = FindLVItem(e.Item)
                        If lvi IsNot Nothing Then
                            lv1.Items.Remove(lvi)
                        End If
                    Case CShItemUpdateType.Renamed
                        Dim lvi As ListViewItem = FindLVItem(e.Item)
                        If lvi IsNot Nothing Then
                            If e.Item.Parent IsNot LastSelectedCSI Then     'if true = item renamed to different directory
                                lv1.Items.Remove(lvi)
                            Else
                                RefreshLvi(lvi)
                                e.Item.ResetIconIndex()                       'may have changed
                                lvi.ImageIndex = e.Item.IconIndexNormal
                                lv1.Items.Remove(lvi)   '6/11/2012
                                InsertLvi(lvi, lv1)     '6/11/2012
                            End If
                        End If
                    Case CShItemUpdateType.UpdateDir  'in this case Parent/sender is the item of interest
                        ' CShItemUpdater, etc. will do the appropriate Adds and Removes, generating
                        ' Created/Deleted events that will occur before an UpdateDir event. There is
                        ' no need to do anything here.
                        'lv1.BeginUpdate()
                        'lv1.Sort()
                        'lv1.EndUpdate()

                    Case CShItemUpdateType.Updated
                        Dim lvi As ListViewItem = FindLVItem(e.Item)
                        If lvi IsNot Nothing Then
                            Dim indx As Integer = lv1.Items.IndexOf(lvi)
                            Dim newLVI As ListViewItem = MakeSparceLVItem(e.Item)
                            RefreshLvi(newLVI)
                            e.Item.ResetIconIndex()                       'may have changed
                            newLVI.ImageIndex = e.Item.IconIndexNormal
                            lv1.Items.RemoveAt(indx)
                            lv1.Items.Insert(indx, newLVI)
                        End If
                    Case CShItemUpdateType.IconChange
                        Dim lvi As ListViewItem = FindLVItem(e.Item)
                        If lvi IsNot Nothing Then
                            e.Item.ResetIconIndex()
                            lvi.ImageIndex = e.Item.IconIndexNormal
                        End If
                    Case CShItemUpdateType.MediaChange
                        Dim lvi As ListViewItem = FindLVItem(e.Item)
                        If lvi IsNot Nothing Then
                            RefreshLvi(lvi)
                            e.Item.ResetIconIndex()
                            lvi.ImageIndex = e.Item.IconIndexNormal
                        End If
                End Select

            Catch ex As Exception
                Debug.WriteLine("Error in frmThread -- lv1 updater -- " & ex.ToString)
            Finally
                lv1.EndUpdate()
            End Try
            ShowCounts()
        End If      'end of Parent Is LastSelectedCSI test
    End Sub

    Private Function FindLVItem(ByVal item As CShItem) As ListViewItem
        For Each lvi As ListViewItem In lv1.Items
            If lvi.Tag Is item Then
                Return lvi
            End If
        Next
        Return Nothing
    End Function

    ''' <summary>
    ''' Given a ListViewItem with a  CShItem in its' Tag, and a ListView whose Items all have a CShItem in
    ''' their Tags, Insert the ListViewItem in its' proper place in the ListView.
    ''' </summary>
    ''' <param name="lvi">The ListViewItem to be inserted.</param>
    ''' <param name="LV">The ListView into which the ListViewItem is to be inserted.</param>
    ''' <remarks>6/11/2012 - better than a Sort when the list is in order.<br />
    '''          Will honor any prior Column Sorts.</remarks>
    Private Sub InsertLvi(ByVal lvi As ListViewItem, ByVal LV As ListView)
        Dim Item As CShItem = lvi.Tag
        If lv1.ListViewItemSorter IsNot Nothing AndAlso TypeOf lv1.ListViewItemSorter Is LVColSorter Then
            Dim CSorter As LVColSorter = DirectCast(lv1.ListViewItemSorter, LVColSorter)
            For i As Integer = 0 To LV.Items.Count - 1
                If CSorter.Compare(LV.Items(i), lvi) > 0 Then
                    LV.Items.Insert(i, lvi)
                    lvi.EnsureVisible()
                    Exit Sub
                End If
            Next
        Else
            For i As Integer = 0 To LV.Items.Count - 1
                If DirectCast(LV.Items(i).Tag, CShItem).CompareTo(Item) > 0 Then
                    LV.Items.Insert(i, lvi)
                    lvi.EnsureVisible()
                    Exit Sub
                End If
            Next
        End If
        'on fall thru, did not find a spot to insert, so it goes at then end
        LV.Items.Add(lvi)
        lvi.EnsureVisible()
    End Sub
#End Region

#Region "   lv1_DoubleClick"

    Private Sub lv1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles lv1.DoubleClick
        Dim csi As CShItem = lv1.SelectedItems(0).Tag
        If csi.IsFolder Then
            ExpTree1.ExpandANode(csi)
        Else
            Try
                Process.Start(csi.Path)
            Catch ex As Exception
                MsgBox(ex.Message, MsgBoxStyle.OkOnly, "Error in starting application")
            End Try
        End If
    End Sub
#End Region

#Region "   LabelEdit Handlers (Item Rename) From Calum"
    ''' <summary>
    ''' Handles Before Item Rename for lv1
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks>Modified version of Calum McLellan's code from ExpList.</remarks>
    Private Sub lv1_BeforeLabelEdit(ByVal sender As Object, ByVal e As System.Windows.Forms.LabelEditEventArgs) Handles lv1.BeforeLabelEdit
        Dim item As CShItem = DirectCast(lv1.Items(e.Item).Tag, CShItem)
        If (Not item.IsFileSystem) Or item.IsDisk Or _
            item.Path = CShItem.GetCShItem(CSIDL.MYDOCUMENTS).Path Or _
            Not (item.CanRename) Then
            System.Media.SystemSounds.Beep.Play()
            e.CancelEdit = True
        End If
    End Sub

    ''' <summary>
    ''' Handles After Item Rename for lv1
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks>Modified version of Calum McLellan's code from ExpList.</remarks>
    Private Sub lv1_AfterLabelEdit(ByVal sender As Object, ByVal e As System.Windows.Forms.LabelEditEventArgs) Handles lv1.AfterLabelEdit
        Dim item As CShItem = DirectCast(lv1.Items(e.Item).Tag, CShItem)
        Dim NewName As String
        Dim index As Integer
        Dim path As String
        If e.Label Is Nothing OrElse e.Label = String.Empty Then Exit Sub '6/11/2012
        Try
            NewName = e.Label.Trim

            If NewName.Length < 1 OrElse NewName.IndexOfAny(System.IO.Path.GetInvalidPathChars) <> -1 Then
                e.CancelEdit = True
                System.Media.SystemSounds.Beep.Play()
                Exit Sub
            End If

            path = item.Path

            index = path.LastIndexOf("\"c)
            If index = -1 Then
                e.CancelEdit = True
                System.Media.SystemSounds.Beep.Play()
                Exit Sub
            End If

            Dim newPidl As IntPtr = IntPtr.Zero
            If item.Parent.Folder.SetNameOf(lv1.Handle, CShItem.ILFindLastID(item.PIDL), NewName, SHGDN.NORMAL, newPidl) = S_OK Then
            Else
                System.Media.SystemSounds.Beep.Play()
                e.CancelEdit = True
            End If
        Catch ex As Exception
            e.CancelEdit = True
            System.Media.SystemSounds.Beep.Play()
            Exit Sub
        End Try
    End Sub
#End Region

#Region "   Context Menu Handlers"
    Private m_WindowsContextMenu As WindowsContextMenu = New WindowsContextMenu

    Private Function IsWithin(ByVal Ctl As Control, ByVal e As MouseEventArgs) As Boolean
        IsWithin = False            'default to Not Within
        If e.X < 0 OrElse e.Y < 0 Then Exit Function
        Dim CR As Rectangle = Ctl.ClientRectangle
        If e.X > CR.Width OrElse e.Y > CR.Height Then Exit Function
        IsWithin = True
    End Function
    ''' <summary>
    ''' Sort the ListViewItems based on the CShItems stored in the .Tag of each ListViewItem.
    ''' </summary>
    ''' <remarks>Cannot use LVColSorter for this since we do not know current state
    ''' </remarks>
    Private Sub SortLVItems()
        With lv1
            If .Items.Count < 2 Then Exit Sub 'no point in sorting 0 or 1 items
            .BeginUpdate()
            Dim tmp(.Items.Count - 1) As ListViewItem
            .Items.CopyTo(tmp, 0)
            Array.Sort(tmp, New TagComparer)
            .Items.Clear()
            .Items.AddRange(tmp)
            .EndUpdate()
        End With
    End Sub

    ''' <summary>
    ''' m_OutOfRange is set to True on lv1.MouseLeave (which happens under many circumstances) to prevent
    ''' the non-ListViewItem specific menu from firing. See Remarks
    ''' m_OutOfRange is set to False (allowing ContextMenus in lv1), only on lv1.MouseDown when the Right
    ''' button is pressed. MouseDown only occurs when the Mouse is really over lv1.
    ''' </summary>
    ''' <remarks>
    '''If you hold down the right mouse button, then leave lv1,
    ''' then let go of the mouse button, the MouseUp event is fired upon
    ''' re-entering the lv1 - meaning that the Windows ContextMenu will
    ''' be shown if we don't use this flag (from Calum)
    '''</remarks>
    Private m_OutOfRange As Boolean

    Private Sub lv1_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles lv1.MouseLeave
        m_OutOfRange = True
    End Sub

    Private Sub lv1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lv1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Right Then
            m_OutOfRange = False
        End If
    End Sub

    ''' <summary>
    ''' Handles RightButton Click
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks>Modified version of Calum McLellan's code from ExpList.</remarks>
    Private Sub lv1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles lv1.MouseUp
        If e.Button = Windows.Forms.MouseButtons.Right Then
            If Not IsWithin(lv1, e) Then Exit Sub
            If m_OutOfRange Then Exit Sub
            Dim lvi As ListViewItem
            Dim pt As New System.Drawing.Point(e.X, e.Y)
            lvi = lv1.GetItemAt(e.X, e.Y)
            If Not IsNothing(lvi) AndAlso lv1.SelectedItems.Count > 0 Then
                Dim itms(lv1.SelectedItems.Count - 1) As CShItem
                For i As Integer = 0 To lv1.SelectedItems.Count - 1
                    itms(i) = DirectCast(lv1.SelectedItems(i).Tag, CShItem)
                Next
                Dim cmi As CMInvokeCommandInfoEx = Nothing
                Dim allowRename As Boolean = True          'Don't allow rename of more than 1 item
                If lv1.SelectedItems.Count > 1 Then allowRename = False
                If m_WindowsContextMenu.ShowMenu(Me.Handle, itms, MousePosition, allowRename, cmi) Then
                    'Check for rename
                    Dim cmdBytes(256) As Byte
                    m_WindowsContextMenu.winMenu.GetCommandString(cmi.lpVerb.ToInt32, GCS.VERBA, 0, cmdBytes, 256)

                    Dim cmdName As String = szToString(cmdBytes).ToLower
                    If cmdName.Equals("rename") Then
                        lv1.LabelEdit = True
                        lvi.BeginEdit()
                    Else
                        m_WindowsContextMenu.InvokeCommand(m_WindowsContextMenu.winMenu, cmi.lpVerb, itms(0).Parent.Path, pt)
                    End If
                    Marshal.ReleaseComObject(m_WindowsContextMenu.winMenu)
                End If
            Else
                GetFolderMenu(MousePosition)
            End If
        End If
    End Sub

#Region "           Windows Folder ContextMenu "

    Private Sub GetFolderMenu(ByVal pt As Drawing.Point)
        Dim HR As Integer
        Dim min As Integer = 1
        Dim max As Integer = 100000
        Dim cmi As New CMInvokeCommandInfoEx
        Dim comContextMenu As IntPtr = CreatePopupMenu()
        Dim viewSubMenu As IntPtr = CreatePopupMenu()

        'Check item count - should always be 0 but check just in case
        Dim startIndex As Integer = GetMenuItemCount(comContextMenu.ToInt32)
        'Fill the context menu
        Dim itemInfo As New MENUITEMINFO("View")
        itemInfo.fMask = MIIM.SUBMENU Or MIIM.STRING
        itemInfo.hSubMenu = viewSubMenu
        InsertMenuItem(comContextMenu, 0, True, itemInfo)
        Dim checked As Integer = MFT.BYCOMMAND
        If lv1.View = View.Tile Then checked = MFT.RADIOCHECK Or MFT.CHECKED
        AppendMenu(viewSubMenu, checked, CMD.TILES, "Tiles")
        checked = MFT.BYCOMMAND
        If lv1.View = View.LargeIcon Then checked = MFT.RADIOCHECK Or MFT.CHECKED
        AppendMenu(viewSubMenu, checked, CMD.LARGEICON, "Large Icons")
        checked = MFT.BYCOMMAND
        If lv1.View = View.List Then checked = MFT.RADIOCHECK Or MFT.CHECKED
        AppendMenu(viewSubMenu, checked, CMD.LIST, "List")
        checked = MFT.BYCOMMAND
        If lv1.View = View.Details Then checked = MFT.RADIOCHECK Or MFT.CHECKED
        AppendMenu(viewSubMenu, checked, CMD.DETAILS, "Details")
        checked = MFT.BYCOMMAND

        AppendMenu(comContextMenu, MFT.SEPARATOR, 0, String.Empty)
        AppendMenu(comContextMenu, MFT.BYCOMMAND, CMD.REFRESH, "Refresh")
        AppendMenu(comContextMenu, MFT.SEPARATOR, 0, String.Empty)

        Dim enabled As Integer = MFT.GRAYED
        Dim effects As DragDropEffects
        If LastSelectedCSI Is Nothing Then
            enabled = MFT.BYCOMMAND
        Else
            effects = ShellHelper.CanDropClipboard(LastSelectedCSI)
            If ((effects And DragDropEffects.Copy) = DragDropEffects.Copy) Or _
                    ((effects And DragDropEffects.Move) = DragDropEffects.Move) Then ' Enable paste for stand-alone ExpList
                enabled = MFT.BYCOMMAND
            End If
        End If
        AppendMenu(comContextMenu, enabled, CMD.PASTE, "Paste")

        If LastSelectedCSI IsNot Nothing Then
            enabled = MFT.GRAYED
            If ((effects And DragDropEffects.Link) = DragDropEffects.Link) Then
                enabled = MFT.BYCOMMAND
            End If

            AppendMenu(comContextMenu, enabled, CMD.PASTELINK, _
                    "Paste Link")
            AppendMenu(comContextMenu, MFT.SEPARATOR, 0, String.Empty)

            ' Add the 'New' menu
            If LastSelectedCSI.IsFolder And _
                ((Not LastSelectedCSI.Path.StartsWith("::")) Or (LastSelectedCSI Is CShItem.GetDeskTop)) Then
                Dim xIndex As Integer = GetMenuItemCount(comContextMenu)
                m_WindowsContextMenu.SetUpNewMenu(LastSelectedCSI, comContextMenu, xIndex) ' 6) ' 7)
                AppendMenu(comContextMenu, MFT.SEPARATOR, 0, String.Empty)
            End If
            AppendMenu(comContextMenu, MFT.BYCOMMAND, CMD.PROPERTIES, _
                    "Properties")
        End If

        Dim cmdID As Integer = _
            TrackPopupMenuEx(comContextMenu, TPM.RETURNCMD, _
            pt.X, pt.Y, Me.Handle, IntPtr.Zero)


        If cmdID >= min Then
            cmi = New CMInvokeCommandInfoEx
            cmi.cbSize = Marshal.SizeOf(cmi)
            cmi.nShow = SW.SHOWNORMAL
            cmi.fMask = CMIC.UNICODE Or CMIC.PTINVOKE
            cmi.ptInvoke = New Drawing.Point(pt.X, pt.Y)

            Select Case cmdID
                Case CMD.TILES
                    lv1.View = View.Tile
                    GoTo CLEANUP
                Case CMD.LARGEICON
                    lv1.View = View.LargeIcon
                    GoTo CLEANUP
                Case CMD.LIST
                    lv1.View = View.List
                    GoTo CLEANUP
                Case CMD.DETAILS
                    lv1.View = View.Details
                    GoTo CLEANUP
                Case CMD.REFRESH
                    If LastSelectedCSI IsNot Nothing Then
                        LastSelectedCSI.UpdateRefresh()
                    End If
                    SortLVItems()
                    GoTo CLEANUP
                Case CMD.PASTE
                    If LastSelectedCSI IsNot Nothing Then
                        cmi.lpVerb = Marshal.StringToHGlobalAnsi("paste")
                        cmi.lpVerbW = Marshal.StringToHGlobalUni("paste")
                    Else
                        GoTo CLEANUP
                    End If
                Case CMD.PASTELINK
                    cmi.lpVerb = Marshal.StringToHGlobalAnsi("pastelink")
                    cmi.lpVerbW = Marshal.StringToHGlobalUni("pastelink")
                Case CMD.PROPERTIES
                    cmi.lpVerb = Marshal.StringToHGlobalAnsi("properties")
                    cmi.lpVerbW = Marshal.StringToHGlobalUni("properties")
                Case Else
                    If CShItem.IsVista Then cmdID -= 1 '12/15/2010 Change
                    cmi.lpVerb = CType(cmdID, IntPtr)
                    cmi.lpVerbW = CType(cmdID, IntPtr)
                    m_CreateNew = True
                    HR = m_WindowsContextMenu.newMenu.InvokeCommand(cmi)
#If DEBUG Then
                    If HR <> S_OK Then
                        Marshal.ThrowExceptionForHR(HR)
                    End If
#End If

                    GoTo CLEANUP
            End Select

            ' Invoke the Paste, Paste Shortcut or Properties command
            If LastSelectedCSI IsNot Nothing Then
                Dim prgf As Integer = 0
                Dim iunk As IntPtr = IntPtr.Zero
                Dim folder As ShellDll.IShellFolder = Nothing
                If LastSelectedCSI Is CShItem.GetDeskTop Then
                    folder = LastSelectedCSI.Folder
                Else
                    folder = LastSelectedCSI.Parent.Folder
                End If

                Dim relPidl As IntPtr = CShItem.ILFindLastID(LastSelectedCSI.PIDL)
                HR = folder.GetUIObjectOf(IntPtr.Zero, 1, New IntPtr() {relPidl}, IID_IContextMenu, prgf, iunk)
#If DEBUG Then
                If Not HR = S_OK Then
                    Marshal.ThrowExceptionForHR(HR)
                End If
#End If

                m_WindowsContextMenu.winMenu = CType(Marshal.GetObjectForIUnknown(iunk), IContextMenu)
                HR = m_WindowsContextMenu.winMenu.InvokeCommand(cmi)
                m_WindowsContextMenu.ReleaseMenu()

#If DEBUG Then
                If Not HR = S_OK Then
                    Marshal.ThrowExceptionForHR(HR)
                End If
#End If
            End If
        End If      '12/15/2010 change
CLEANUP:
        m_WindowsContextMenu.ReleaseNewMenu()

        Marshal.Release(comContextMenu)
        comContextMenu = IntPtr.Zero
        Marshal.Release(viewSubMenu)
        viewSubMenu = IntPtr.Zero

    End Sub

#End Region

    ''' <summary>
    ''' Handles Windows Messages having to do with the display of Cascading menus of the Context Menu.
    ''' </summary>
    ''' <param name="m">The Windows Message</param>
    Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
        'For send to menu in the ListView context menu
        Dim hr As Integer = 0
        If m.Msg = WM.INITMENUPOPUP Or m.Msg = WM.MEASUREITEM Or m.Msg = WM.DRAWITEM Then
            If Not m_WindowsContextMenu.winMenu2 Is Nothing Then
                hr = m_WindowsContextMenu.winMenu2.HandleMenuMsg(m.Msg, m.WParam, m.LParam)
                If hr = 0 Then
                    Return
                End If
            ElseIf (m.Msg = WM.INITMENUPOPUP And m.WParam = m_WindowsContextMenu.newMenuPtr) _
                    Or m.Msg = WM.MEASUREITEM Or m.Msg = WM.DRAWITEM Then
                If Not m_WindowsContextMenu.newMenu2 Is Nothing Then
                    hr = m_WindowsContextMenu.newMenu2.HandleMenuMsg(m.Msg, m.WParam, m.LParam)
                    If hr = 0 Then
                        Return
                    End If
                End If
            End If
        ElseIf m.Msg = WM.MENUCHAR Then
            If Not m_WindowsContextMenu.winMenu3 Is Nothing Then
                hr = m_WindowsContextMenu.winMenu3.HandleMenuMsg2(m.Msg, m.WParam, m.LParam, IntPtr.Zero)
                If hr = 0 Then
                    Return
                End If
            End If
        End If
        MyBase.WndProc(m)
    End Sub
#End Region

#Region "   Keyboard Events "
    ''' <summary>
    ''' Handles Delete Key processing for the ListView
    ''' </summary>
    ''' <param name="sender">object that raised the event</param>
    ''' <param name="e">a KeyEventsArgs</param>
    ''' <remarks>Modified version of Calum McLellan's code from ExpList.</remarks>
    Private Sub ExpList_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles lv1.KeyUp
        If e.KeyCode = Keys.Delete Then
            If LastSelectedCSI IsNot Nothing AndAlso LastSelectedCSI.IsFolder Then
                Dim HR As Integer
                Dim prgf As Integer = 0
                Dim iunk As IntPtr = IntPtr.Zero
                Dim folder As ShellDll.IShellFolder = LastSelectedCSI.Folder
                Dim pidls(lv1.SelectedItems.Count - 1) As IntPtr
                Dim i As Integer

                For i = 0 To lv1.SelectedItems.Count - 1
                    If Not DirectCast(lv1.SelectedItems(i).Tag, CShItem).CanDelete Then
                        MsgBox("Cannot Delete: " & DirectCast(lv1.SelectedItems(i).Tag, CShItem).DisplayName, MsgBoxStyle.OkOnly, "Cannot Delete")
                        Exit Sub
                    End If
                    'If Not lv1.SelectedItems(i).Tag.CanRename Then AllowRename = False
                    pidls(i) = CShItem.ILFindLastID(lv1.SelectedItems(i).Tag.PIDL)
                Next
                Dim relPidl As IntPtr = CShItem.ILFindLastID(LastSelectedCSI.PIDL)
                HR = folder.GetUIObjectOf(IntPtr.Zero, pidls.Length, pidls, IID_IContextMenu, prgf, iunk)
#If DEBUG Then
                If Not HR = S_OK Then
                    Marshal.ThrowExceptionForHR(HR)
                End If
#End If
                m_WindowsContextMenu.winMenu = CType(Marshal.GetObjectForIUnknown(iunk), IContextMenu)
                Dim cmi As New CMInvokeCommandInfoEx
                cmi.cbSize = Marshal.SizeOf(cmi)
                cmi.nShow = SW.SHOWNORMAL
                cmi.fMask = CMIC.UNICODE Or CMIC.PTINVOKE
                cmi.ptInvoke = New Drawing.Point(0, 0)
                cmi.lpVerb = Marshal.StringToHGlobalAnsi("delete")
                cmi.lpVerbW = Marshal.StringToHGlobalUni("delete")

                HR = m_WindowsContextMenu.winMenu.InvokeCommand(cmi)
                m_WindowsContextMenu.ReleaseMenu()
#If DEBUG Then
                If Not HR = S_OK Then
                    Marshal.ThrowExceptionForHR(HR)
                End If
#End If
            End If
        End If
    End Sub

#End Region

#Region "   Test Routines - Only found in this version of this Form"
    'Private Sub TestFindToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TestFindToolStripMenuItem.Click
    '    Dim CTest As CShItem = GetCShItem("C:\Testing")
    '    If CTest Is Nothing Then
    '        Debug.WriteLine("C:\Testing Not Got")
    '        Exit Sub
    '    End If
    '    Dim FCT As CShItem = FindCShItem(DeskTopItem, CTest.PIDL)
    '    If FCT Is Nothing Then
    '        Debug.WriteLine("C:\Testing Not Found")
    '        Exit Sub
    '    End If
    '    If CTest Is FCT Then
    '        Debug.WriteLine("Found correctly")
    '    End If
    '    Dim IsAncestor As Boolean = CShItem.IsAncestorOf(CTest.PIDL, FCT.PIDL)
    '    Debug.WriteLine("IsAncestorOf, default fparent returns " & IsAncestor.ToString)
    '    IsAncestor = CShItem.IsAncestorOf(CTest.PIDL, FCT.PIDL, True)
    '    Debug.WriteLine("IsAncestorOf, TRUE fparent returns " & IsAncestor.ToString)

    '    ' Now try for one not in tree
    '    Dim base As IntPtr = CTest.PIDL
    '    Dim Files As ArrayList = CTest.GetContentPtrs(SHCONTF.NONFOLDERS)
    '    If Files Is Nothing OrElse Files.Count < 1 Then Exit Sub
    '    For Each IP As IntPtr In Files
    '        Dim abs As IntPtr = concatPidls(base, IP)
    '        Dim tst As CShItem = FindCShItem(abs)
    '        If tst IsNot Nothing Then
    '            Debug.WriteLine("Found Item: " & tst.DisplayName)
    '        End If
    '        Marshal.FreeCoTaskMem(IP)
    '        Marshal.FreeCoTaskMem(abs)
    '    Next
    '    Dim AAA As CShItem = GetCShItem("C:\testing\AAA.txt")
    '    Dim FAAA As CShItem = FindCShItem(AAA.PIDL)
    'End Sub

    Private Sub TimeTestToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TimeTestToolStripMenuItem.Click
        If lv1.SelectedItems.Count < 1 Then
            MsgBox("Must Select an Item in the ListView to test with", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "Nothing Selected")
            Exit Sub
        End If
        Dim Result As String
        Dim P1 As IntPtr = DirectCast(lv1.SelectedItems(0).Tag, CShItem).PIDL
        Dim P2 As IntPtr = DirectCast(lv1.SelectedItems(0).Tag, CShItem).PIDL
        Dim StTime As DateTime = Now()
        ' Testing the same PIDL is instantaneous since ILIsEqual first tests the IntPtrs for equality
        'For i As Integer = 1 To 200000
        '    If Not CShItem.IsEqual(P1, P2) Then
        '        MsgBox("Wrong answer", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "IsEqual failed")
        '        Exit Sub
        '    End If
        'Next
        'Result = ("Test1 Elapsed time: " & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms")
        'Debug.WriteLine(Result)
        'MsgBox(Result, MsgBoxStyle.OkOnly, "Result of Test1")

        If lv1.SelectedItems.Count > 1 Then
            P2 = DirectCast(lv1.SelectedItems(1).Tag, CShItem).PIDL
            StTime = Now()
            For i As Integer = 1 To 200000
                If CShItem.IsEqual(P1, P2) Then
                    MsgBox("Wrong answer - Test2", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "IsEqual failed")
                    Exit Sub
                End If
            Next
            Result = "Test2 Elapsed time:  - Using CShItem.IsEqual vs Full PIDL: " & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms"
            Debug.WriteLine(Result)
            MsgBox(Result, MsgBoxStyle.OkOnly, "Result of Test2")

            Dim Rel1 As IntPtr = CShItem.ILFindLastID(DirectCast(lv1.SelectedItems(0).Tag, CShItem).PIDL)
            Dim Rel2 As IntPtr = CShItem.ILFindLastID(DirectCast(lv1.SelectedItems(1).Tag, CShItem).PIDL)
            Dim CSI1 As CShItem = DirectCast(lv1.SelectedItems(0).Tag, CShItem)
            StTime = Now()
            For i As Integer = 1 To 200000
                If CSI1.PidlsEqual(Rel1, Rel2) Then
                    MsgBox("Wrong answer - Test3", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "IsEqual failed")
                    Exit Sub
                End If
            Next
            Result = "Test3 Elapsed time - Same as Test2 with Last Item: " & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms"
            Debug.WriteLine(Result)
            MsgBox(Result, MsgBoxStyle.OkOnly, "Result of Test3")

            Rel1 = DirectCast(lv1.SelectedItems(0).Tag, CShItem).PIDL
            Rel2 = DirectCast(lv1.SelectedItems(1).Tag, CShItem).PIDL
            StTime = Now()
            For i As Integer = 1 To 200000
                If CShItem.GetDeskTop.PidlsEqual(Rel1, Rel2) Then
                    MsgBox("Wrong answer - Test4", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "IsEqual failed")
                    Exit Sub
                End If
            Next
            Result = "Test4 Elapsed time - Same as Test2 vs Full PIDL" & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms"
            Debug.WriteLine(Result)
            MsgBox(Result, MsgBoxStyle.OkOnly, "Result of Test4")
            ' Try the same test with AreBytesEqual
            StTime = Now()
            For i As Integer = 1 To 200000
                If CShItem.AreBytesEqual(Rel1, Rel2) Then
                    MsgBox("Wrong answer - Test5", MsgBoxStyle.Exclamation Or MsgBoxStyle.OkOnly, "IsEqual failed")
                    Exit Sub
                End If
            Next
            Result = "Test5 Elapsed time - Using AreBytesEqual - Full PIDL " & Now().Subtract(StTime).TotalMilliseconds.ToString & "ms"
            Debug.WriteLine(Result)
            MsgBox(Result, MsgBoxStyle.OkOnly, "Result of Test5")
        End If
    End Sub

    Private Sub TestCreDirToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TestCreDirToolStripMenuItem1.Click

        If LastSelectedCSI IsNot Nothing Then
            ExpTree1.ExpandANode(LastSelectedCSI)
            Dim Base As String = LastSelectedCSI.Path
            Directory.CreateDirectory(Base & "\" & "AAAziz")
            Dim SubDirBase As String = Base & "\" & "AAAziz\Sub"
            'ExpTree1.ExpandANode(Base & "\" & "AAAziz") 'This will fail since MKDIR has not yet been processed (or, perhaps, occurred)
            For i As Integer = 1 To 26
                Directory.CreateDirectory(SubDirBase & i.ToString)
            Next
        End If
    End Sub

    Private Sub TestFilterToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TestFilterToolStripMenuItem.Click
        If LastSelectedCSI IsNot Nothing Then
            Dim Lst As New List(Of String)
            Dim FLst As New ArrayList()
            FLst.AddRange(LastSelectedCSI.GetFiles("*.txt"))
            If FLst.Count > 0 Then
                For Each CSI As CShItem In FLst
                    Lst.Add(CSI.Name)
                Next
            Else : Lst.Add("No Files matched the Filter")
            End If
            Dim DispForm As New frmDisplay
            With DispForm
                .txtDisplay.Lines = Lst.ToArray
                .Show()
            End With
        End If
    End Sub

    Private Sub SearchBoxToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SearchBoxToolStripMenuItem.Click
        Dim SBForm As New frmSearchBox
        SBForm.ShowDialog()
        SBForm.Dispose()
    End Sub

    Private Sub MultiInstanceToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MultiInstanceToolStripMenuItem.Click
        Dim MForm As New frmTestMulti
        MForm.Show()
    End Sub
#End Region

End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)


Written By
United States United States
After 30+ years working in the IT field, mostly managing SysAdmins, I have retired. One of my hobbies returns me to programming, basically just to keep my hand in.

Comments and Discussions