What is your computer doing with all that memory? There are various kinds of memory allocated and used in each process. These include:

·         Managed memory (VB.Net, C#, managed C++)

·         Heap memory

·         Stacks

·         Images (files loaded into a process)

 

VirtualAlloc is the basis of these allocations. If a process needs more of these types of memory, VirtualAlloc is called.

 

You can inspect the various kinds of memory by running the sample code below. It offers a list of current processes, from which you dbl-click one to inspect.

 

Once you choose a process, a snapshot of all Virtual memory allocations is shown in a ListView, along with the size, type, etc. If it’s an image, the filename is shown too.  Hovering over addresses shows the memory contents in a tooltip. Double click to open another window with the entire memory contents. You can read strings in memory in these displays.

 

One can imagine this being the base of your own custom Task Manager. Perhaps you want to search for all strings in all processes. “Microsoft” occurs quite often!

 

Imagine taking a memory snapshot of a process, doing something in that process, then taking another snapshot and displaying the difference.

 

Caveats: you may not have rights to read some processes or some memory. Also, if you build to 32 bit (Project Options->Compile->AdvancedCompileOptions->TargetCPU->AnyCpu) and run on 64 bit, you might have problems.

 

It can examine both 32 and 64 bit processes.  If you get Access Denied on some processes, you might have better luck running it as Administrator

 

Start Visual Studio 2008

File->New Project->VB WPF Application.

 

Open Window1.xaml.vb, replace the contents (about 650 lines) with the sample below.

 

 

See also:

Create your own media browser: Display your pictures, music, movies in a XAML tooltip

How to Create dynamic XAML to display arbitrary XML

Remove double spaces from pasted code samples in blog

 

 

 

 

<code sample>

Imports System.Runtime.InteropServices

 

Class Window1

    Private WithEvents _btnRefresh As Button

 

    Private Sub Window1_Loaded(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs) Handles MyBase.Loaded

        Me.Width = 800

        Me.Height = 800

 

        RefreshContent()

    End Sub

 

    Sub RefreshContent()

        Dim q = From proc In System.Diagnostics.Process.GetProcesses _

                Select proc.Id, _

                       proc.ProcessName, _

                       proc.WorkingSet64, _

                       proc.PrivateMemorySize64, _

                       Is64 = ProcessType(proc) _

                Order By ProcessName

        Me.Title = "Choose a process. Count = " + q.Count.ToString

        Dim XAML = _

        <Grid

            xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

            xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

            >

            <Grid.RowDefinitions>

                <RowDefinition MaxHeight="20"/>

                <RowDefinition/>

            </Grid.RowDefinitions>

            <StackPanel Orientation="Horizontal" Grid.Row="0">

                <Button Name="btnRefresh">Refresh</Button>

            </StackPanel>

            <DockPanel Grid.Row="1" Name="dp">

 

            </DockPanel>

        </Grid>

        Dim gr = CType(System.Windows.Markup.XamlReader.Load(XAML.CreateReader), Grid)

        _btnRefresh = CType(gr.FindName("btnRefresh"), Button)

        Dim dp = CType(gr.FindName("dp"), DockPanel)

        dp.Children.Add(New Browse(q, delDblClick:=AddressOf OnProcWindDblClick))

        Me.Content = gr

    End Sub

 

    Shared Function ProcessType(ByVal proc As Process) As String

        Dim is32 = False

        If IntPtr.Size = 4 Then ' 64 bit=8, 32=4

            is32 = True

        End If

        Dim retProcType = "64"

        Try

            Dim IsrunningUnderWow64 = False

            If IsWow64Process(proc.Handle, IsrunningUnderWow64) AndAlso IsrunningUnderWow64 Then

            End If

            If IsrunningUnderWow64 OrElse is32 Then

                retProcType = "32"

            End If

 

        Catch ex As Exception

            retProcType = ex.Message

        End Try

        Return retProcType

    End Function

 

    <DllImport("Kernel32.dll", SetLastError:=True, CallingConvention:=CallingConvention.Winapi)> _

        Public Shared Function IsWow64Process( _

        ByVal hProcess As IntPtr, _

        <MarshalAs(UnmanagedType.Bool)> ByRef wow64Process As Boolean) As <MarshalAs(UnmanagedType.Bool)> Boolean

    End Function

 

    Sub OnbtnRefresh_Click() Handles _btnRefresh.Click

        RefreshContent()

    End Sub

 

    Sub OnProcWindDblClick(ByVal sender As Object, ByVal e As RoutedEventArgs)

        Try

            Dim lv = TryCast(sender, Browse)

            If lv IsNot Nothing Then

                Dim tb = TryCast(e.OriginalSource, TextBlock)

                If tb IsNot Nothing Then

                    Dim dt = tb.DataContext

                    If dt IsNot Nothing Then

                        Dim procTarget = tb.Text

                        Dim q = From a In Process.GetProcessesByName(procTarget)

                        If q.Count > 0 Then

                            Dim oWin = New VirtMemWindow(q.First) With {.Owner = Me}

                        End If

                    End If

                End If

            End If

        Catch ex As Exception

            MessageBox.Show(ex.Message)

        End Try

    End Sub

 

    Class VirtMemWindow

        Inherits Window

        Private _proc As Process

 

        Private WithEvents _btnAggregate As Button

        Private _Is32 As Boolean

 

        Sub New(ByVal proc As Process)

            Dim mbi As New MEMORY_BASIC_INFORMATION

            _proc = proc

            Dim ptype = ProcessType(_proc)

 

            If ptype = "32" Then

                _Is32 = True

            ElseIf ptype = "64" Then

                _Is32 = False

            Else

                Throw New InvalidOperationException(ptype)

            End If

            If IntPtr.Size = 4 AndAlso Not _Is32 Then

                Throw New InvalidOperationException("32 bit app can't examine 64 bit process")

            End If

 

            Dim lpMem As UInt64 = 0

            Do While VirtualQueryEx(_proc.Handle, New UIntPtr(lpMem), mbi, Marshal.SizeOf(mbi)) = Marshal.SizeOf(mbi)

                _virtAllocs.Add(mbi)

                lpMem = mbi.BaseAddress.ToUInt64 + mbi.RegionSize.ToUInt64

            Loop

            Dim XAML = _

            <Grid

                xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

                xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

                >

                <Grid.RowDefinitions>

                    <RowDefinition MaxHeight="20"/>

                    <RowDefinition/>

                </Grid.RowDefinitions>

                <StackPanel Orientation="Horizontal" Grid.Row="0">

                    <Button Name="btnAgg">Aggregate</Button>

                </StackPanel>

                <DockPanel Grid.Row="1" Name="dp">

 

                </DockPanel>

            </Grid>

            Dim gr = CType(System.Windows.Markup.XamlReader.Load(XAML.CreateReader), Grid)

            _btnAggregate = CType(gr.FindName("btnAgg"), Button)

            Dim dp = CType(gr.FindName("dp"), DockPanel)

            If _virtAllocs.Count = 0 Then

                dp.Children.Add(New TextBlock With {.Text = "No items found. Perhaps 64/32 bit or Rights issue"})

            Else

                Dim q = From a In _virtAllocs _

                        Select AllocationBase = Format64or32(a.AllocationBase), _

                                BaseAddress = Format64or32(a.BaseAddress), _

                                RegionSize = Format64or32(a.RegionSize), _

                                Filename = GetFileNameFromMBI(a), _

                                AllocationProtect = a.AllocationProtect.ToString, _

                                AllocationState = a.State.ToString, _

                                Type = CType(a.lType, AllocationType).ToString _

                                Order By Filename.ToString.Length Descending

 

                Me.Title += String.Format("{0} Virtual Memory Use #items={1}  ", proc.ProcessName, q.Count)

 

                dp.Children.Add(New Browse(q, _

                                        delMouseMove:=AddressOf On_VirtmemMouseMove, _

                                        deldblclick:=AddressOf On_VirtmemDblClick))

 

            End If

            Me.Content = gr

            Me.Show()

        End Sub

 

        Function Format64or32(ByVal num As UIntPtr) As String

            Dim retval = ""

            If _Is32 Then

                retval = num.ToUInt32.ToString("x8")

            Else

                retval = num.ToUInt64.ToString("x16")

            End If

            Return retval

        End Function

 

        Sub OnbtnAggClick() Handles _btnAggregate.Click

            Dim qAgg = From a In _virtAllocs _

                       Group By AllocationType = a.lType.ToString Into Tot = Sum(a.RegionSize.ToUInt64), Cnt = Count(a.RegionSize.ToUInt64 > 0)

            Dim oWin = New Window With {.Title = "Aggregate"}

            oWin.Content = New Browse(qAgg)

            oWin.Owner = Me

            oWin.Show()

        End Sub

 

        Private _virtAllocs As New List(Of MEMORY_BASIC_INFORMATION)

 

        Sub On_VirtmemDblClick(ByVal sender As Object, ByVal e As RoutedEventArgs)

            Try

                Dim lv = TryCast(sender, Browse)

                If lv IsNot Nothing Then

                    Dim tb = TryCast(e.OriginalSource, TextBlock)

                    If tb IsNot Nothing Then

                        Select Case tb.Name

                            Case "AllocationBase", "BaseAddress"

                                ClearPriorToolTipIfAny()

                                Dim baseAddr = Convert.ToInt64(tb.Text, 16) ' convert from hex (base 16)

                                Dim allocQuery = From a In _virtAllocs _

                                        Where If(tb.Name = "AllocationBase", a.AllocationBase, a.BaseAddress) = baseAddr

 

 

                                If allocQuery.Count > 0 Then

                                    Dim virtAlloc = allocQuery.First

                                    Dim strAddrDump = GetAddressDump( _

                                        virtAlloc.BaseAddress, _

                                        virtAlloc.RegionSize, _

                                        nMax:=0 _

                                        )

 

                                    Dim tbxDump = New TextBox With { _

                                        .Text = strAddrDump, _

                                        .VerticalScrollBarVisibility = ScrollBarVisibility.Auto, _

                                        .BorderThickness = New Windows.Thickness(0), _

                                        .FontFamily = New FontFamily("Courier New"), _

                                    .FontSize = 10 _

                                    }

                                    Dim oWin = New Window With { _

                                        .Title = String.Format("Mem dump Address = {0:x8}, size = {1}", _

                                                                tb.Text, _

                                                                virtAlloc.RegionSize _

                                                                ) _

                                    }

                                    oWin.Content = tbxDump

                                    oWin.Owner = Me

                                    oWin.Show()

                                End If

                        End Select

                    End If

 

                End If

 

            Catch ex As Exception

 

            End Try

 

        End Sub

 

        Sub ClearPriorToolTipIfAny()

            If _LastTipObj IsNot Nothing Then

                Dim lastTip = CType(_LastTipObj.ToolTip, ToolTip)

                lastTip.IsOpen = False

                _LastTipObj = Nothing

            End If

        End Sub

 

        Private _LastTipObj As FrameworkElement

        Sub On_VirtmemMouseMove(ByVal sender As Object, ByVal e As RoutedEventArgs)

            Dim lv = TryCast(sender, Browse)

            If lv IsNot Nothing Then

                Dim tb = TryCast(e.OriginalSource, TextBlock)

                If tb IsNot Nothing Then

                    '                    Dim o = lv.ItemContainerGenerator.ContainerFromItem(tb)

                    If _LastTipObj IsNot Nothing Then

                        Dim lastTip = CType(_LastTipObj.ToolTip, ToolTip)

                        If tb Is _LastTipObj Then ' over same obj: don't create a new tip

                            Return

                        Else

                            ' different object: close the tip

                            lastTip.IsOpen = False

                        End If

                    End If

 

                    Dim dt = tb.DataContext

                    If dt IsNot Nothing Then

                        Dim ttipObj = New ToolTip

                        ttipObj.PlacementTarget = tb

                        ttipObj.Placement = Controls.Primitives.PlacementMode.Bottom

                        Select Case tb.Name

                            Case "AllocationBase", "BaseAddress"

                                Dim baseAddr = Convert.ToUInt64(tb.Text, 16) ' convert from hex (base 16)

                                Dim q = From a In _virtAllocs _

                                        Where If(tb.Name = "AllocationBase", a.AllocationBase, a.BaseAddress) = baseAddr

 

                                If q.Count > 0 Then

                                    Dim mbi = q.First

                                    Dim baddr = If(tb.Name = "AllocationBase", mbi.AllocationBase, mbi.BaseAddress)

                                    If CType(mbi.State, AllocationState) <> AllocationState.MEM_FREE AndAlso baddr.ToUInt64 > &H1000 Then

 

                                        Dim strAddrDump = GetAddressDump( _

                                            baddr, _

                                            mbi.RegionSize)

 

                                        Dim tbxDump = New TextBox With { _

                                            .Text = strAddrDump, _

                                            .BorderThickness = New Windows.Thickness(0), _

                                            .FontFamily = New FontFamily("Courier New"), _

                                            .FontSize = 10, _

                                            .Background = Brushes.LightYellow _

                                        }

                                        Dim sp = New StackPanel With {.Orientation = Orientation.Vertical}

                                        If CType(mbi.lType, AllocationType) = AllocationType.MEM_IMAGE Then

                                            Dim sbFilename As New Text.StringBuilder(300)

                                            Dim rr = GetFileNameFromMBI(mbi)

                                            GetModuleFileNameEx(_proc.Handle, New UIntPtr(mbi.AllocationBase.ToUInt64), sbFilename, sbFilename.Capacity)

                                            sp.Children.Add(New TextBlock With {.Text = "Filename = " + sbFilename.ToString})

                                        End If

                                        sp.Children.Add(tbxDump)

                                        ttipObj.Content = sp

                                    Else

                                        ttipObj.Content = baddr.ToString + " bad address for mem dump"

                                    End If

 

                                End If

                            Case "RegionSize"

                                ttipObj.Content = String.Format(" Base 10: {0}", Convert.ToInt32(tb.Text, 16))

                            Case "Where", "Filename"

                                ttipObj.Content = tb.Text

                            Case Else

                                Return

                        End Select

                        ToolTipService.SetShowDuration(tb, 100000)

 

                        ttipObj.IsOpen = True

                        tb.ToolTip = ttipObj

                        _LastTipObj = tb

                    End If

                End If

            End If

 

        End Sub

 

        Const BlockSize As Integer = 1024

        <StructLayout(LayoutKind.Sequential)> _

        Structure ProcMemBlock

            <MarshalAs(UnmanagedType.ByValArray, sizeconst:=BlockSize)> _

            Dim data() As Byte

        End Structure

 

        Public Function GetAddressDump(ByVal nAddress As UIntPtr, ByVal nTotalBytesToRead As UIntPtr, Optional ByVal nMax As Integer = 1024) As String

            Dim sbAddrDump As New Text.StringBuilder

            Try

                If nMax > 0 Then

                    nTotalBytesToRead = Math.Min(nMax, nTotalBytesToRead.ToUInt64)

                End If

                Dim blk = New ProcMemBlock

                Dim nBytesLeftToRead = nTotalBytesToRead

                Do While nBytesLeftToRead.ToUInt64 > 0

                    Dim nBytesToReadForThisBlock = Math.Min(nBytesLeftToRead.ToUInt64, BlockSize)

                    Dim nBytesRead As UIntPtr = 0

                    If ReadProcessMemory(_proc.Handle, nAddress, blk, nBytesToReadForThisBlock, nBytesRead) Then

                        nBytesLeftToRead = nBytesLeftToRead.ToUInt64 - nBytesRead.ToUInt64

                        Dim innerCnt = 0

                        Dim strBytes = ""

                        Dim strChars = ""

                        For i = 0 To nBytesRead.ToUInt64 - 1 Step 4

                            If innerCnt Mod 8 = 0 Then

                                If i > 0 Then ' if we're ending a line, dump out the bytes and chars

                                    sbAddrDump.AppendLine("  " + strBytes + "  " + strChars)

                                    strBytes = ""

                                    strChars = ""

                                Else

                                    sbAddrDump.AppendLine()

                                End If

                                If _Is32 Then

                                    sbAddrDump.Append(String.Format("{0:x8} : ", nAddress.ToUInt32 + CUInt(i)))

                                Else

                                    Dim offset = nAddress.ToUInt64 + CUInt(i)

                                    sbAddrDump.Append(String.Format("{0:x16} : ", nAddress.ToUInt64 + CUInt(i)))

                                End If

                            End If

                            innerCnt += 1

                            Dim dword = 0

                            For p = 0 To 3

                                dword += CInt(blk.data(i + p)) << shifts(3 - p)

                            Next

                            '                        Dim dword = Marshal.ReadIntPtr(New IntPtr(nAddress + i)).ToInt32

                            toBytes(dword, strBytes, strChars)

                            sbAddrDump.Append(String.Format("{0:x8} ", dword))

                        Next

                        ' some leftovers

                        Dim startLeftover = innerCnt

                        Do While innerCnt Mod 8 > 0

                            sbAddrDump.Append("         ")

                            innerCnt += 1

                        Loop

                        sbAddrDump.AppendLine("  " + strBytes + "  ")

                        innerCnt = startLeftover

                        Do While innerCnt Mod 8 > 0

                            sbAddrDump.Append("   ")

                            innerCnt += 1

                        Loop

                        sbAddrDump.AppendLine(strChars)

 

                        Do While innerCnt Mod 8 > 0

                            sbAddrDump.Append("         ")

                            innerCnt += 1

                        Loop

                    Else

                        Exit Do

                    End If

                    nAddress = nAddress.ToUInt64 + nBytesRead.ToUInt64

                Loop

            Catch ex As Exception

                sbAddrDump.Append("Exception when reading " + nAddress.ToString + " " + ex.Message)

 

            End Try

 

            Return sbAddrDump.ToString

        End Function

 

        Const badchars = vbCr + vbLf + vbTab + Chr(&HB) + Chr(&HC)

        Private Shared shifts As Integer() = {24, 16, 8, 0}

        Shared Sub toBytes(ByVal num As Integer, ByRef strBytes As String, ByRef strChars As String)

            For i = 3 To 0 Step -1

                Dim abyte = CByte((num >> shifts(i) And &HFF))

                strBytes += String.Format("{0:x2} ", abyte)

                Dim thechar = " "

                If abyte > 15 AndAlso abyte < 127 Then

                    If badchars.IndexOf(thechar) < 0 Then

                        thechar = Chr(abyte).ToString

                    End If

                End If

                strChars += thechar

            Next

        End Sub

 

        <DllImport("kernel32.dll", SetLastError:=True)> _

        Public Shared Function ReadProcessMemory( _

               ByVal hProcess As IntPtr, _

               ByVal lpBaseAddress As UIntPtr, _

               ByRef lpBuffer As ProcMemBlock, _

               ByVal dwSize As Integer, _

               ByRef lpNumberOfBytesRead As Integer _

         ) As Integer

        End Function

 

        <DllImport("psapi")> _

        Shared Function GetModuleFileNameEx(ByVal hProcess As IntPtr, ByVal hModule As UIntPtr, ByVal lpFileName As Text.StringBuilder, ByVal nSize As Integer) As Integer

        End Function

 

        <DllImport("kernel32")> _

        Shared Function VirtualQueryEx( _

                                    ByVal hProcess As IntPtr, _

                                    ByVal lpAddress As UIntPtr, _

                                    ByRef mbi As MEMORY_BASIC_INFORMATION, _

                                    ByVal dwLength As UInteger) As UInteger

        End Function

 

        <StructLayout(LayoutKind.Sequential)> _

        Structure MEMORY_BASIC_INFORMATION

            Dim BaseAddress As UIntPtr

            Dim AllocationBase As UIntPtr

            Dim AllocationProtect As AllocationProtect

            Dim RegionSize As UIntPtr

            Dim State As AllocationState

            Dim Protect As AllocationProtect

            Dim lType As AllocationType

        End Structure

 

        <Flags()> _

        Enum AllocationProtect

            PAGE_EXECUTE = &H10

            PAGE_EXECUTE_READ = &H20

            PAGE_EXECUTE_READWRITE = &H40

            PAGE_EXECUTE_WRITECOPY = &H80

            PAGE_NOACCESS = &H1

            PAGE_READONLY = &H2

            PAGE_READWRITE = &H4

            PAGE_WRITECOPY = &H8

            PAGE_GUARD = &H100

            PAGE_NOCACHE = &H200

            PAGE_WRITECOMBINE = &H400

        End Enum

 

        <Flags()> _

        Enum AllocationType

            MEM_IMAGE = &H1000000

            MEM_MAPPED = &H40000

            MEM_PRIVATE = &H20000

        End Enum

 

        <Flags()> _

        Enum AllocationState

            MEM_COMMIT = &H1000

            MEM_FREE = &H10000

            MEM_RESERVE = &H2000

        End Enum

 

        Function GetFileNameFromMBI(ByVal mbi As MEMORY_BASIC_INFORMATION) As String

            Dim retval = ""

            If CType(mbi.lType, AllocationType) = AllocationType.MEM_IMAGE Or True Then

                If mbi.AllocationBase.ToUInt64 > 0 Then

                    Dim sbFilename As New Text.StringBuilder(300)

                    If GetModuleFileNameEx(_proc.Handle, New UIntPtr(mbi.AllocationBase.ToUInt64), sbFilename, sbFilename.Capacity) > 0 Then

                        retval = sbFilename.ToString

                    End If

                End If

            End If

            Return retval

        End Function

 

    End Class

End Class

 

 

' see http://blogs.msdn.com/calvin_hsia/archive/2007/12/06/6684376.aspx

Public Class Browse

    Inherits ListView

 

    Private _Browse As Browse = Me

    Private _delDblClick As BrowEventDelegate

    Private _delMouseMove As BrowEventDelegate

    Public _query As IEnumerable

 

    Delegate Sub BrowEventDelegate(ByVal sender As Object, ByVal e As RoutedEventArgs)

 

    Sub New( _

               ByVal Query As IEnumerable, _

               Optional ByVal delDblClick As BrowEventDelegate = Nothing, _

               Optional ByVal delMouseMove As BrowEventDelegate = Nothing, _

               Optional ByVal fAllowHeaderClickSort As Boolean = True)

 

        _query = Query

        Dim gv As New GridView

 

        _Browse.View = gv

        _Browse.ItemsSource = Query

        If fAllowHeaderClickSort Then

            _Browse.AddHandler(GridViewColumnHeader.ClickEvent, New RoutedEventHandler(AddressOf HandleHeaderClick))

        End If

        If delDblClick IsNot Nothing Then

            _delDblClick = delDblClick

            _Browse.AddHandler(MouseDoubleClickEvent, New RoutedEventHandler(AddressOf OnRowDblClickEvent))

        End If

        If delMouseMove IsNot Nothing Then

            _delMouseMove = delMouseMove

            _Browse.AddHandler(MouseMoveEvent, New RoutedEventHandler(AddressOf OnMouseMoveEvent))

 

        End If

 

        If Query.GetType.GetInterface(GetType(IEnumerable(Of )).FullName).GetGenericArguments(0).Name = "XElement" Then ' It's XML

            Dim Elem1 = CType(Query, IEnumerable(Of XElement))(0).Elements ' Thanks Avner!

            For Each Item In Elem1

                Dim gvc As New GridViewColumn

                gvc.Header = Item.Name.LocalName

                gv.Columns.Add(gvc)

                Dim bind As New Binding("Element[" + Item.Name.LocalName + "].Value")

                gvc.DisplayMemberBinding = bind

                gvc.Width = 180

            Next

        Else ' it's some anonymous type like "VB$AnonymousType_1`3". Let's use reflection to get the column names

            For Each mem In From mbr In _

                    Query.GetType().GetInterface(GetType(IEnumerable(Of )).FullName) _

                    .GetGenericArguments()(0).GetMembers _

                    Where mbr.MemberType = Reflection.MemberTypes.Property

 

                Dim datatype = CType(mem, Reflection.PropertyInfo)

                Dim coltype = datatype.PropertyType.Name

                Select Case coltype

                    Case "Int32", "String", "Int64"

                        Dim gvc As New GridViewColumn

                        gvc.Header = mem.Name

                        gv.Columns.Add(gvc)

                        Dim XAMLdt = _

                        <DataTemplate

                            xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

                            xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

                            >

                            <StackPanel Orientation="Horizontal">

                                <TextBlock Name=<%= mem.Name %>

                                    Text=<%= If(coltype = "String", _

                                             "{Binding Path=" + mem.Name + "}", _

                                             "{Binding Path=" + mem.Name + "}") %>

                                    >

                                </TextBlock>

                            </StackPanel>

                        </DataTemplate>

                        gvc.CellTemplate = CType(System.Windows.Markup.XamlReader.Load(XAMLdt.CreateReader), DataTemplate)

                        If coltype <> "String" Then

                            '                           gvc.Width = 80

                            gvc.Width = Double.NaN ' auto

                        Else

                            '                                gvc.DisplayMemberBinding = New Binding(mem.Name)

                            '                            gvc.Width = 180

                            gvc.Width = Double.NaN ' auto

                        End If

                End Select

            Next

        End If

        Dim XAMLlbStyle = _

        <Style

            xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

            xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

            TargetType="ListBoxItem">

            <Setter Property="Foreground" Value="Blue"/>

            <Style.Triggers>

                <Trigger Property="IsSelected" Value="True">

                    <Setter Property="Foreground" Value="White"/>

                    <Setter Property="Background" Value="Aquamarine"/>

                </Trigger>

                <Trigger Property="IsMouseOver" Value="True">

                    <Setter Property="Foreground" Value="Red"/>

                </Trigger>

            </Style.Triggers>

        </Style>

        _Browse.ItemContainerStyle = CType(Windows.Markup.XamlReader.Load(XAMLlbStyle.CreateReader), Windows.Style)

    End Sub

 

    Sub OnRowDblClickEvent(ByVal sender As Object, ByVal e As RoutedEventArgs)

        If _delDblClick IsNot Nothing Then

            _delDblClick.Invoke(sender, e)

        End If

    End Sub

 

    Sub OnMouseMoveEvent(ByVal sender As Object, ByVal e As RoutedEventArgs)

        If _delMouseMove IsNot Nothing Then

            _delMouseMove.Invoke(sender, e)

        End If

    End Sub

 

    Dim _Lastdir As System.ComponentModel.ListSortDirection = ComponentModel.ListSortDirection.Ascending

    Dim _LastHeaderClicked As GridViewColumnHeader = Nothing

    Sub HandleHeaderClick(ByVal sender As Object, ByVal e As RoutedEventArgs)

        If e.OriginalSource.GetType Is GetType(GridViewColumnHeader) Then

            Dim gvh = CType(e.OriginalSource, GridViewColumnHeader)

            Dim dir As System.ComponentModel.ListSortDirection = ComponentModel.ListSortDirection.Ascending

            If Not gvh Is Nothing AndAlso Not gvh.Column Is Nothing Then

                If _LastHeaderClicked IsNot Nothing Then

                    _LastHeaderClicked.Column.HeaderTemplate = Nothing

                End If

                Dim hdr = gvh.Column.Header

                If gvh Is _LastHeaderClicked Then

                    If _Lastdir = ComponentModel.ListSortDirection.Ascending Then

                        dir = ComponentModel.ListSortDirection.Descending

                    End If

                End If

                gvh.Column.HeaderTemplate = CType(Windows.Markup.XamlReader.Load( _

                    <DataTemplate

                        xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"

                        xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"

                        >

                        <DockPanel>

                            <TextBlock HorizontalAlignment="Center"

                                Text="{Binding}"/>

                            <Path

                                Fill="DarkGray"

                                Data=<%= If(dir = ComponentModel.ListSortDirection.Ascending, _

                                         "M 5,10 L 15,10 L 10,5", _

                                         "M 5,5 L 10,10 L 15,5") %>/>

                        </DockPanel>

                    </DataTemplate>.CreateReader), DataTemplate)

 

                Sort(CStr(hdr), dir)

                _LastHeaderClicked = gvh

                _Lastdir = dir

            End If

        End If

    End Sub

 

    Sub Sort(ByVal sortby As String, ByVal dir As System.ComponentModel.ListSortDirection)

        _Browse.Items.SortDescriptions.Clear()

        Dim sd = New System.ComponentModel.SortDescription(sortby, dir)

        _Browse.Items.SortDescriptions.Add(sd)

        _Browse.Items.Refresh()

    End Sub

End Class

 

 

 

</code sample>