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>