i want to make the listview control collapsible to the groups alone. Like in Vista's My Computer, where only the group names are shown and then we click on the group to expand it.
I am using VB.NET 3.5
Check this out:
Collapsible ListViewGroup
and maybe:
Add Group Collapse Behavior on a Listview Control
Both are written in C# but of course you can still use them in VB.NET projects.
You can only use these on Vista and later.
There is definitely no way to do this with the bog-standard VB.NET ListView control. In fact, it doesn't seem possible even with an ObjectListView, which is my usual port of call when I encounter a ListView limitation.
You could either:
Roll your own control
Switch to a TreeView
Give up
I think that number 2 is the best option in your case, as it's not that difficult. Number one is overkill and takes a lot of time. If you have a GUI layer that is tightly coupled to your logic and database layers, it may be a lot harder to convert to a TreeView. Or, you could just be using the other ListView views. (In the latter case, an TreeListView from the same FOSS project could be the way to go - it is GPL though.)
It may be easier just to kill this feature - I don't think it would be critical.
Here's an old article that extends the list view:
http://www.codeproject.com/KB/list/GroupListView.aspx?msg=1135144
Here's a sample that does what I think you want with a GridView, panel and the Collapsible Panel Extender
You could also switch to the AJAX control toolkit Accordian control.
I have managed to achieve this by looking at what you guys have posted around here and this is how my code looks like.
Imports System.Collections.Generic
Imports System.Text
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Reflection
Public Class ListViewCollapsible
Inherits ListView
Private Const LVM_FIRST As Integer = &H1000
' ListView messages
Private Const LVM_SETGROUPINFO As Integer = (LVM_FIRST + 147)
' ListView messages Setinfo on Group
Private Const WM_LBUTTONUP As Integer = &H202
' Windows message left button
Private Delegate Sub CallBackSetGroupState(lstvwgrp As ListViewGroup, state As ListViewGroupState)
Private Delegate Sub CallbackSetGroupString(lstvwgrp As ListViewGroup, value As String)
''' <summary>
''' Sends the specified message to a window or windows. The SendMessage function calls the window procedure for the specified window and does not return until the window procedure has processed the message.
''' To send a message and return immediately, use the SendMessageCallback or SendNotifyMessage function. To post a message to a thread's message queue and return immediately, use the PostMessage or PostThreadMessage function.
''' </summary>
''' <param name="hWnd">
''' [in] Handle to the window whose window procedure will receive the message.
''' If this parameter is HWND_BROADCAST, the message is sent to all top-level windows in the system, including disabled or invisible unowned windows, overlapped windows, and pop-up windows; but the message is not sent to child windows.
''' Microsoft Windows Vista and later. Message sending is subject to User Interface Privilege Isolation (UIPI). The thread of a process can send messages only to message queues of threads in processes of lesser or equal integrity level.
''' </param>
''' <param name="Msg">[in] Specifies the message to be sent.</param>
''' <param name="wParam">[in] Specifies additional message-specific information.</param>
''' <param name="lParam">[in] Type of LVGROUP, Specifies additional message-specific information.</param>
''' <returns>
''' Microsoft Windows Vista and later. When a message is blocked by UIPI the last error, retrieved with GetLastError, is set to 5 (access denied).
''' Applications that need to communicate using HWND_BROADCAST should use the RegisterWindowMessage function to obtain a unique message for inter-application communication.
''' The system only does marshalling for system messages (those in the range 0 to (WM_USER-1)). To send other messages (those >= WM_USER) to another process, you must do custom marshalling.
''' If the specified window was created by the calling thread, the window procedure is called immediately as a subroutine. If the specified window was created by a different thread, the system switches to that thread and calls the appropriate window procedure. Messages sent between threads are processed only when the receiving thread executes message retrieval code. The sending thread is blocked until the receiving thread processes the message. However, the sending thread will process incoming nonqueued messages while waiting for its message to be processed. To prevent this, use SendMessageTimeout with SMTO_BLOCK set. For more information on nonqueued messages, see Nonqueued Messages.
''' Windows 95/98/Me: SendMessageW is supported by the Microsoft Layer for Unicode (MSLU). To use this, you must add certain files to your application, as outlined in Microsoft Layer for Unicode on Windows 95/98/Me Systems.
''' </returns>
<DllImport("User32.dll"), Description("Sends the specified message to a window or windows. The SendMessage function calls the window procedure for the specified window and does not return until the window procedure has processed the message. To send a message and return immediately, use the SendMessageCallback or SendNotifyMessage function. To post a message to a thread's message queue and return immediately, use the PostMessage or PostThreadMessage function.")> _
Private Shared Function SendMessage(hWnd As IntPtr, Msg As Integer, wParam As Integer, lParam As IntPtr) As Integer
End Function
Private Shared Function GetGroupID(lstvwgrp As ListViewGroup) As System.Nullable(Of Integer)
Dim rtnval As System.Nullable(Of Integer) = Nothing
Dim GrpTp As Type = lstvwgrp.[GetType]()
If GrpTp IsNot Nothing Then
Dim pi As PropertyInfo = GrpTp.GetProperty("ID", BindingFlags.NonPublic Or BindingFlags.Instance)
If pi IsNot Nothing Then
Dim tmprtnval As Object = pi.GetValue(lstvwgrp, Nothing)
If tmprtnval IsNot Nothing Then
rtnval = CInt(tmprtnval)
End If
End If
End If
Return rtnval
End Function
Private Shared Sub setGrpState(lstvwgrp As ListViewGroup, state As ListViewGroupState)
If Environment.OSVersion.Version.Major < 6 Then
'Only Vista and forward allows collaps of ListViewGroups
Return
End If
If lstvwgrp Is Nothing OrElse lstvwgrp.ListView Is Nothing Then
Return
End If
If lstvwgrp.ListView.InvokeRequired Then
lstvwgrp.ListView.Invoke(New CallBackSetGroupState(AddressOf setGrpState), lstvwgrp, state)
Else
Dim GrpId As System.Nullable(Of Integer) = GetGroupID(lstvwgrp)
Dim gIndex As Integer = lstvwgrp.ListView.Groups.IndexOf(lstvwgrp)
Dim group As New LVGROUP
group.CbSize = Marshal.SizeOf(group)
group.State = state
group.Mask = ListViewGroupMask.State
Dim ip As IntPtr = IntPtr.Zero
Try
If GrpId IsNot Nothing Then
group.IGroupId = GrpId.Value
ip = Marshal.AllocHGlobal(group.CbSize)
Marshal.StructureToPtr(group, ip, False)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, GrpId.Value, ip)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, GrpId.Value, ip)
Else
group.IGroupId = gIndex
ip = Marshal.AllocHGlobal(group.CbSize)
Marshal.StructureToPtr(group, ip, False)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, gIndex, ip)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, gIndex, ip)
End If
lstvwgrp.ListView.Refresh()
Finally
If (ip <> IntPtr.Zero) Then Marshal.FreeHGlobal(ip)
End Try
End If
End Sub
Private Shared Sub setGrpFooter(lstvwgrp As ListViewGroup, footer As String)
If Environment.OSVersion.Version.Major < 6 Then
'Only Vista and forward allows footer on ListViewGroups
Return
End If
If lstvwgrp Is Nothing OrElse lstvwgrp.ListView Is Nothing Then
Return
End If
If lstvwgrp.ListView.InvokeRequired Then
lstvwgrp.ListView.Invoke(New CallbackSetGroupString(AddressOf setGrpFooter), lstvwgrp, footer)
Else
Dim GrpId As System.Nullable(Of Integer) = GetGroupID(lstvwgrp)
Dim gIndex As Integer = lstvwgrp.ListView.Groups.IndexOf(lstvwgrp)
Dim group As New LVGROUP
group.CbSize = Marshal.SizeOf(group)
group.PszFooter = footer
group.Mask = ListViewGroupMask.Footer
Dim ip As IntPtr = IntPtr.Zero
Try
If GrpId IsNot Nothing Then
group.IGroupId = GrpId.Value
ip = Marshal.AllocHGlobal(group.CbSize)
Marshal.StructureToPtr(group, ip, False)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, GrpId.Value, ip)
Else
group.IGroupId = gIndex
ip = Marshal.AllocHGlobal(group.CbSize)
Marshal.StructureToPtr(group, ip, False)
SendMessage(lstvwgrp.ListView.Handle, LVM_SETGROUPINFO, gIndex, ip)
End If
Finally
If (ip <> IntPtr.Zero) Then Marshal.FreeHGlobal(ip)
End Try
End If
End Sub
Public Sub SetGroupState(state As ListViewGroupState)
For Each lvg As ListViewGroup In Me.Groups
setGrpState(lvg, state)
Next
End Sub
Public Sub SetGroupState(state As ListViewGroupState, lvg As ListViewGroup)
setGrpState(lvg, state)
End Sub
Public Sub SetGroupFooter(lvg As ListViewGroup, footerText As String)
setGrpFooter(lvg, footerText)
End Sub
Protected Overrides Sub WndProc(ByRef m As Message)
If m.Msg = WM_LBUTTONUP Then
MyBase.DefWndProc(m)
End If
MyBase.WndProc(m)
End Sub
End Class
''' <summary>
''' LVGROUP StructureUsed to set and retrieve groups.
''' </summary>
''' <example>
''' LVGROUP myLVGROUP = new LVGROUP();
''' myLVGROUP.CbSize // is of managed type uint
''' myLVGROUP.Mask // is of managed type uint
''' myLVGROUP.PszHeader // is of managed type string
''' myLVGROUP.CchHeader // is of managed type int
''' myLVGROUP.PszFooter // is of managed type string
''' myLVGROUP.CchFooter // is of managed type int
''' myLVGROUP.IGroupId // is of managed type int
''' myLVGROUP.StateMask // is of managed type uint
''' myLVGROUP.State // is of managed type uint
''' myLVGROUP.UAlign // is of managed type uint
''' myLVGROUP.PszSubtitle // is of managed type IntPtr
''' myLVGROUP.CchSubtitle // is of managed type uint
''' myLVGROUP.PszTask // is of managed type string
''' myLVGROUP.CchTask // is of managed type uint
''' myLVGROUP.PszDescriptionTop // is of managed type string
''' myLVGROUP.CchDescriptionTop // is of managed type uint
''' myLVGROUP.PszDescriptionBottom // is of managed type string
''' myLVGROUP.CchDescriptionBottom // is of managed type uint
''' myLVGROUP.ITitleImage // is of managed type int
''' myLVGROUP.IExtendedImage // is of managed type int
''' myLVGROUP.IFirstItem // is of managed type int
''' myLVGROUP.CItems // is of managed type IntPtr
''' myLVGROUP.PszSubsetTitle // is of managed type IntPtr
''' myLVGROUP.CchSubsetTitle // is of managed type IntPtr
''' </example>
''' <remarks>
''' The LVGROUP structure was created by Paw Jershauge
''' Created: Jan. 2008.
''' The LVGROUP structure code is based on information from Microsoft's MSDN2 website.
''' The structure is generated via an automated converter and is as is.
''' The structure may or may not hold errors inside the code, so use at own risk.
''' Reference url: http://msdn.microsoft.com/en-us/library/bb774769(VS.85).aspx
''' </remarks>
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode), Description("LVGROUP StructureUsed to set and retrieve groups.")> _
Public Structure LVGROUP
''' <summary>
''' Size of this structure, in bytes.
''' </summary>
<Description("Size of this structure, in bytes.")> _
Public CbSize As Integer
''' <summary>
''' Mask that specifies which members of the structure are valid input. One or more of the following values:LVGF_NONENo other items are valid.
''' </summary>
<Description("Mask that specifies which members of the structure are valid input. One or more of the following values:LVGF_NONE No other items are valid.")> _
Public Mask As ListViewGroupMask
''' <summary>
''' Pointer to a null-terminated string that contains the header text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the header text.
''' </summary>
<Description("Pointer to a null-terminated string that contains the header text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the header text.")> _
<MarshalAs(UnmanagedType.LPWStr)> _
Public PszHeader As String
''' <summary>
''' Size in TCHARs of the buffer pointed to by the pszHeader member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Size in TCHARs of the buffer pointed to by the pszHeader member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchHeader As Integer
''' <summary>
''' Pointer to a null-terminated string that contains the footer text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the footer text.
''' </summary>
<Description("Pointer to a null-terminated string that contains the footer text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the footer text.")> _
<MarshalAs(UnmanagedType.LPWStr)> _
Public PszFooter As String
''' <summary>
''' Size in TCHARs of the buffer pointed to by the pszFooter member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Size in TCHARs of the buffer pointed to by the pszFooter member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchFooter As Integer
''' <summary>
''' ID of the group.
''' </summary>
<Description("ID of the group.")> _
Public IGroupId As Integer
''' <summary>
''' Mask used with LVM_GETGROUPINFO (Microsoft Windows XP and Windows Vista) and LVM_SETGROUPINFO (Windows Vista only) to specify which flags in the state value are being retrieved or set.
''' </summary>
<Description("Mask used with LVM_GETGROUPINFO (Microsoft Windows XP and Windows Vista) and LVM_SETGROUPINFO (Windows Vista only) to specify which flags in the state value are being retrieved or set.")> _
Public StateMask As Integer
''' <summary>
''' Flag that can have one of the following values:LVGS_NORMALGroups are expanded, the group name is displayed, and all items in the group are displayed.
''' </summary>
<Description("Flag that can have one of the following values:LVGS_NORMAL Groups are expanded, the group name is displayed, and all items in the group are displayed.")> _
Public State As ListViewGroupState
''' <summary>
''' Indicates the alignment of the header or footer text for the group. It can have one or more of the following values. Use one of the header flags. Footer flags are optional. Windows XP: Footer flags are reserved.LVGA_FOOTER_CENTERReserved.
''' </summary>
<Description("Indicates the alignment of the header or footer text for the group. It can have one or more of the following values. Use one of the header flags. Footer flags are optional. Windows XP: Footer flags are reserved.LVGA_FOOTER_CENTERReserved.")> _
Public UAlign As UInteger
''' <summary>
''' Windows Vista. Pointer to a null-terminated string that contains the subtitle text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the subtitle text. This element is drawn under the header text.
''' </summary>
<Description("Windows Vista. Pointer to a null-terminated string that contains the subtitle text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the subtitle text. This element is drawn under the header text.")> _
Public PszSubtitle As IntPtr
''' <summary>
''' Windows Vista. Size, in TCHARs, of the buffer pointed to by the pszSubtitle member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Windows Vista. Size, in TCHARs, of the buffer pointed to by the pszSubtitle member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchSubtitle As UInteger
''' <summary>
''' Windows Vista. Pointer to a null-terminated string that contains the text for a task link when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the task text. This item is drawn right-aligned opposite the header text. When clicked by the user, the task link generates an LVN_LINKCLICK notification.
''' </summary>
<Description("Windows Vista. Pointer to a null-terminated string that contains the text for a task link when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the task text. This item is drawn right-aligned opposite the header text. When clicked by the user, the task link generates an LVN_LINKCLICK notification.")> _
<MarshalAs(UnmanagedType.LPWStr)> _
Public PszTask As String
''' <summary>
''' Windows Vista. Size in TCHARs of the buffer pointed to by the pszTask member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Windows Vista. Size in TCHARs of the buffer pointed to by the pszTask member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchTask As UInteger
''' <summary>
''' Windows Vista. Pointer to a null-terminated string that contains the top description text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the top description text. This item is drawn opposite the title image when there is a title image, no extended image, and uAlign==LVGA_HEADER_CENTER.
''' </summary>
<Description("Windows Vista. Pointer to a null-terminated string that contains the top description text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the top description text. This item is drawn opposite the title image when there is a title image, no extended image, and uAlign==LVGA_HEADER_CENTER.")> _
<MarshalAs(UnmanagedType.LPWStr)> _
Public PszDescriptionTop As String
''' <summary>
''' Windows Vista. Size in TCHARs of the buffer pointed to by the pszDescriptionTop member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Windows Vista. Size in TCHARs of the buffer pointed to by the pszDescriptionTop member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchDescriptionTop As UInteger
''' <summary>
''' Windows Vista. Pointer to a null-terminated string that contains the bottom description text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the bottom description text. This item is drawn under the top description text when there is a title image, no extended image, and uAlign==LVGA_HEADER_CENTER.
''' </summary>
<Description("Windows Vista. Pointer to a null-terminated string that contains the bottom description text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the bottom description text. This item is drawn under the top description text when there is a title image, no extended image, and uAlign==LVGA_HEADER_CENTER.")> _
<MarshalAs(UnmanagedType.LPWStr)> _
Public PszDescriptionBottom As String
''' <summary>
''' Windows Vista. Size in TCHARs of the buffer pointed to by the pszDescriptionBottom member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Windows Vista. Size in TCHARs of the buffer pointed to by the pszDescriptionBottom member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchDescriptionBottom As UInteger
''' <summary>
''' Windows Vista. Index of the title image in the control imagelist.
''' </summary>
<Description("Windows Vista. Index of the title image in the control imagelist.")> _
Public ITitleImage As Integer
''' <summary>
''' Windows Vista. Index of the extended image in the control imagelist.
''' </summary>
<Description("Windows Vista. Index of the extended image in the control imagelist.")> _
Public IExtendedImage As Integer
''' <summary>
''' Windows Vista. Read-only.
''' </summary>
<Description("Windows Vista. Read-only.")> _
Public IFirstItem As Integer
''' <summary>
''' Windows Vista. Read-only in non-owner data mode.
''' </summary>
<Description("Windows Vista. Read-only in non-owner data mode.")> _
Public CItems As IntPtr
''' <summary>
''' Windows Vista. NULL if group is not a subset. Pointer to a null-terminated string that contains the subset title text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the subset title text.
''' </summary>
<Description("Windows Vista. NULL if group is not a subset. Pointer to a null-terminated string that contains the subset title text when item information is being set. If group information is being retrieved, this member specifies the address of the buffer that receives the subset title text.")> _
Public PszSubsetTitle As IntPtr
''' <summary>
''' Windows Vista. Size in TCHARs of the buffer pointed to by the pszSubsetTitle member. If the structure is not receiving information about a group, this member is ignored.
''' </summary>
<Description("Windows Vista. Size in TCHARs of the buffer pointed to by the pszSubsetTitle member. If the structure is not receiving information about a group, this member is ignored.")> _
Public CchSubsetTitle As IntPtr
End Structure
Public Enum ListViewGroupMask
None = &H0
Header = &H1
Footer = &H2
State = &H4
Align = &H8
GroupId = &H10
SubTitle = &H100
Task = &H200
DescriptionTop = &H400
DescriptionBottom = &H800
TitleImage = &H1000
ExtendedImage = &H2000
Items = &H4000
Subset = &H8000
SubsetItems = &H10000
End Enum
Public Enum ListViewGroupState
''' <summary>
''' Groups are expanded, the group name is displayed, and all items in the group are displayed.
''' </summary>
Normal = 0
''' <summary>
''' The group is collapsed.
''' </summary>
Collapsed = 1
''' <summary>
''' The group is hidden.
''' </summary>
Hidden = 2
''' <summary>
''' Version 6.00 and Windows Vista. The group does not display a header.
''' </summary>
NoHeader = 4
''' <summary>
''' Version 6.00 and Windows Vista. The group can be collapsed.
''' </summary>
Collapsible = 8
''' <summary>
''' Version 6.00 and Windows Vista. The group has keyboard focus.
''' </summary>
Focused = 16
''' <summary>
''' Version 6.00 and Windows Vista. The group is selected.
''' </summary>
Selected = 32
''' <summary>
''' Version 6.00 and Windows Vista. The group displays only a portion of its items.
''' </summary>
SubSeted = 64
''' <summary>
''' Version 6.00 and Windows Vista. The subset link of the group has keyboard focus.
''' </summary>
SubSetLinkFocused = 128
End Enum
I have tested this and it works just fine for me.
Hope it will help some of you as well.
Related
I've seen lots of posts on here (and elsewhere) with a solution to the problem of finding the available free space on a UNC path, but these all involve using GetDiskFreeSpaceEx which only appears to be available in C.
I've included it in some test code and get:
Error BC30451 'GetDiskFreeSpaceEx' is not declared. It may be inaccessible due to its protection level.
The IDE offers the solutions of creating a method or a property.
Trying this in a console program...
What is the VB equivalent of this?
When working with P/Invoke, I usually write a class with the name of the method and not only the method declaration itself and try to expose the functionality in a .NET fashion instead of low-level C++ style.
e.g. in the method description of the native GetDiskFreeSpaceEx function it is mentioned that in case the provided path is an UNC-path the trailing backslash is mandatory!
C++ style: Write it in the description, if the caller does not provide it in that fashion, they are to blame themselves, RTFM.
.NET style: We adjust it for the caller, they do not have to worry about such implementation details.
I would also provide 3 different methods for each available information (I included a 4th one for the space used), and a common one to get more than one value at once.
Here how it could look:
Imports System
Imports System.ComponentModel
Imports System.IO
Imports System.Runtime.InteropServices
Namespace PInvoke.Kernel32
Public Class GetDiskFreeSpaceEx
''' <summary>
''' Retrieves the number of bytes currently available to the caller. This takes into account any quotas etc. that may
''' exist on the folder resp. file share.
''' </summary>
''' <param name="folderName">The name of the path to retrieve the for me available bytes from.</param>
''' <returns>The maximum number of bytes that are currently available for me to use.</returns>
Public Shared Function GetAvailableBytesToCaller(folderName As String) As UInt64
Dim result As SizeInfo = Invoke(folderName)
Return result.BytesAvailableToCaller
End Function
''' <summary>
''' Retrieves the number of bytes currently available on the according volume. This may be more than I can use,
''' see <see cref="GetAvailableBytesToCaller(String)" /> for a method that respects quotas etc.
''' </summary>
''' <param name="folderName">The name of the path to retrieve the (in general) available bytes from.</param>
''' <returns>The maximum number of bytes that are available for all users together.</returns>
Public Shared Function GetAvailableBytesInTotal(folderName As String) As UInt64
Dim result As SizeInfo = Invoke(folderName)
Return result.BytesAvailableInTotal
End Function
''' <summary>
''' Retrieves the number of bytes currently used on the according volume. This value corresponds to
''' <see cref="GetBytesInTotal(String)"/> - <see cref="GetAvailableBytesInTotal(String)"/>.
''' </summary>
''' <param name="folderName">The name of the path to retrieve the used bytes from.</param>
''' <returns>The number of bytes that are already used by all users together.</returns>
Public Shared Function GetUsedBytesInTotal(folderName As String) As UInt64
Dim result As SizeInfo = Invoke(folderName)
Return result.BytesUsedInTotal
End Function
''' <summary>
''' Retrieves the size in bytes of the according volume (the total of already used and available space).
''' </summary>
''' <param name="folderName">The name of the path to retrieve the (in general) available bytes from.</param>
''' <returns>The maximum number of bytes that are available for all users together.</returns>
Public Shared Function GetBytesInTotal(folderName As String) As UInt64
Dim result As SizeInfo = Invoke(folderName)
Return result.TotalNumberOfBytes
End Function
''' <summary>
''' Retrieves a <see cref="SizeInfo"/> object containing the information about how many bytes are available at
''' the given path in general or for the current user account, how much is the total and how much is already
''' used.
''' </summary>
''' <param name="folderName">The name of the path from which to retrieve the size info.</param>
''' <returns>The according size info object.</returns>
Public Shared Function Invoke(folderName As String) As SizeInfo
'Check argument
If (String.IsNullOrWhiteSpace(folderName)) Then
Throw New ArgumentNullException(NameOf(folderName), "The folder's name must not be null, empty or white-space!")
End If
'Expand environment variables
Try
folderName = Environment.ExpandEnvironmentVariables(folderName)
Catch ex As Exception
Throw New ArgumentException($"Unable to expand possible environment variables of folder '{folderName}'! See inner exception for details...", ex)
End Try
'Get full path
Try
folderName = Path.GetFullPath(folderName)
Catch ex As Exception
Throw New ArgumentException($"Unable to retrieve absolute path of folder '{folderName}'! See inner exception for details...", ex)
End Try
'Append final back-slash (which is mandatory for UNC paths)
folderName = folderName.Replace(Path.AltDirectorySeparatorChar, Path.DirectorySeparatorChar)
If (Not folderName.EndsWith(Path.DirectorySeparatorChar)) Then
folderName &= Path.DirectorySeparatorChar
End If
'Invoke method
Dim bytesAvailableToCaller As UInt64
Dim bytesInTotal As UInt64
Dim bytesAvailableInGeneral As UInt64
Dim success As Boolean = Invoke(folderName, bytesAvailableToCaller, bytesInTotal, bytesAvailableInGeneral)
If (Not success) Then Throw New Win32Exception()
'Return result
Return New SizeInfo(bytesAvailableToCaller, bytesInTotal, bytesAvailableInGeneral)
End Function
'Private Methods
<DllImport("kernel32.dll", EntryPoint:="GetDiskFreeSpaceExW", ExactSpelling:=True, SetLastError:=True, CharSet:=CharSet.Unicode)>
Private Shared Function Invoke(folderName As String, ByRef bytesAvailableToCaller As UInt64, ByRef bytesInTotal As UInt64, ByRef bytesAvailableInGeneral As UInt64) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
'************************************************************************************************************************
' Inner Class "SizeInfo"
'************************************************************************************************************************
Public Class SizeInfo
Public Sub New(freeBytesAvailableToCaller As UInt64, totalNumberOfBytes As UInt64, freeBytesAvailableInTotal As UInt64)
Me.BytesAvailableToCaller = freeBytesAvailableToCaller
Me.BytesAvailableInTotal = freeBytesAvailableInTotal
Me.TotalNumberOfBytes = totalNumberOfBytes
End Sub
Public ReadOnly Property BytesAvailableToCaller As UInt64
Public ReadOnly Property BytesAvailableInTotal As UInt64
Public ReadOnly Property BytesUsedInTotal As UInt64
Get
Dim total As UInt64 = TotalNumberOfBytes
Dim available As UInt64 = BytesAvailableInTotal
If (total <= available) Then Return 0
Return total - available
End Get
End Property
Public ReadOnly Property TotalNumberOfBytes As UInt64
End Class
End Class
End Namespace
I am trying my best not to use late binding with the getObject function. How ever i know i wont be looked down upon turning strict off in only One class.
My question is i can't find what to declare my member type of.
Dim restPoint = GetObject("winmgmts:\\.\root\default:Systemrestore")
If restPoint IsNot Nothing Then
If restPoint.CreateRestorePoint("test restore point system", 12, 100) = 0 Then
MsgBox("Restore Point created successfully")
Else
MsgBox("Could not create restore point!")
End If
End If
I have spent hours trying to research msdn createrestorepoint come from. I don't want to use WMI directly or keep strict off.
Thanks
I guess i will go with WMI for now. That snippet cleaned up.
Imports System.Management
Public Class CreateRestorePoint
''' <summary>
''' Defines the search query for the ManagementScope path.
''' </summary>
Private Const MANAGEMENT_SCOPE As String = "\\localhost\root\default:SystemRestore"
''' <summary>
''' Attempts to create a new restore point using WMI.
''' </summary>
''' <returns>True if the restore point was created, other wise false.</returns>
''' <remarks>
''' Gets the object containing the input parameters to a method, and then fills in the values and passes the object to the InvokeMethod call.
''' </remarks>
Friend Function CreateRestorePoint() As Boolean
Dim created As Boolean = True
Using wmiQuery As New ManagementClass(New ManagementPath(MANAGEMENT_SCOPE))
Dim query = GetParams(wmiQuery)
Try
wmiQuery.InvokeMethod("CreateRestorePoint", query, Nothing)
Catch ex As ManagementException
created = False
End Try
End Using
Return created
End Function
''' <summary>
''' Sets the ManagementBaseObject parameters.
''' </summary>
''' <param name="wmiQuery"></param>
''' <returns>Returns a ManagementBaseObject representing the list of input parameters for a method.</returns>
''' <remarks>The members of this class enable you to access WMI data using a specific WMI class path.></remarks>
Private Function GetParams(wmiQuery As ManagementClass) As ManagementBaseObject
Dim query = wmiQuery.GetMethodParameters("CreateRestorePoint")
query("Description") = "-CautionSparta"
query("RestorePointType") = 12
query("EventType") = 100
Return query
End Function
End Class
I have a text file containing the properties for a virtual server running on my machine. I would like to be able to edit those properties from a GUI built with VB 2008. The Properties file is pre-generated with default values and I would like to change those values to fit my needs.
The Properties file is formatted as follows:
Item-One=ValueOne
Item-Two=ValueTwo
Item-Three=OtherLongValue
etc.
What I need is to be able to select the property based off it's name (Item-Two) and then remove the original value (which may be unknown) and place in my custom value. Values are String type.
I have already tried two suggestions, but neither achieve my goal.
Attempt1:
System.IO.File.WriteAllText(propName, System.IO.File.ReadAllText(propName).Replace("initial", "final"))
Attempt2:
Dim thefile As String = PropertyFileName
Dim lines() As String = System.IO.File.ReadAllLines(thefile)
lines(28) = "Item-Example=" + myValue
System.IO.File.WriteAllLines(thefile, lines)
Number One does not work because it requires me to know the original value, which I do not.
Number Two "works" but often adds new lines instead of replacing the old.
Here is a class I made. It is also documented which should help with inteliSense. Bellow I added some example of its usage.
SettingManager.vb
''' <summary>
''' Manages Settings which can be loaded and saved to a file specified
''' </summary>
''' <remarks></remarks>
Public Class SettingManager
Private filePath As String
Private prop As New Dictionary(Of String, String)
''' <summary>
''' Create a new SettingManager and loads settings from file specified.
''' If file specified doesnt exist, a new one is created upon save()
''' </summary>
''' <param name="filePath">Setting file to load</param>
''' <remarks></remarks>
Sub New(ByVal filePath As String)
Me.filePath = filePath
If (Not System.IO.File.Exists(filePath)) Then
Return
End If
Using reader As System.IO.StreamReader = New System.IO.StreamReader(filePath)
Dim line As String
line = reader.ReadLine()
'Loop through the lines and add each setting to the dictionary: prop
Do While (Not line Is Nothing)
'Spit the line into setting name and value
Dim tmp(2) As String
tmp = line.Split("=")
Me.AddSetting(tmp(0), tmp(1))
line = reader.ReadLine()
Loop
End Using
End Sub
''' <summary>
''' Get value of specified setting if exists.
''' If setting doesnt exist, KeyNotFound exception is thrown
''' </summary>
''' <param name="name">Name of setting</param>
''' <returns>Value of setting</returns>
Function GetSetting(ByVal name As String) As String
If (Not prop.ContainsKey(name)) Then
Throw New KeyNotFoundException("Setting: " + name + " not found")
End If
Return prop(name)
End Function
''' <summary>
''' Adds a new setting.
''' </summary>
''' <param name="name">Name of setting</param>
''' <param name="value">Value of setting</param>
''' <remarks>Save() function should be called to save changes</remarks>
Sub AddSetting(ByVal name As String, ByVal value As String)
If (prop.ContainsKey(name)) Then
prop(name) = value
Else
prop.Add(name, value)
End If
End Sub
''' <summary>
''' Saves settings to file. Any new settings added are also saved
''' </summary>
''' <remarks></remarks>
Sub Save()
Using writer As System.IO.StreamWriter = New System.IO.StreamWriter(filePath)
For Each kvp As KeyValuePair(Of String, String) In Me.prop
writer.WriteLine(kvp.Key + "=" + kvp.Value)
Next
End Using
End Sub
End Class
How to use:
Create a new file in your project called SettingManager.vb
Copy the code above into it
Example Usage
Dim sm As New SettingManager("settings.txt")
'Get Setting
Console.WriteLine(sm.GetSetting("Item-One")) 'Value-One
'Change setting
pm.AddSetting("Item-One", "different_value")
Console.WriteLine(sm.GetSetting("Item-One")) 'different_value
'Add new Setting
pm.AddSetting("name", "Krimson")
Console.WriteLine(sm.GetSetting("name")) 'Krimson
'Save any changes made
sm.Save()
Note: The code is not robust enough. For example if a value contains an =, errors might occur since there is no check implemented to prevent this. However, this should be a good starting point
A little Addition
Do While (Not line Is Nothing)
If line = Nothing OrElse line.Length = 0 OrElse line.StartsWith("#") Then
'Continue Do
Else
'Spit the line into setting name and value
Dim tmp(2) As String
tmp = line.Split("=")
Me.AddSetting(tmp(0), tmp(1))
End If
line = reader.ReadLine()
Loop
I am having some issues writing a large set of data to an XML file. I am using the following class to serialize objects to xml and then write them to disk:
''' <summary>
''' Borrowed from http://icanmakethiswork.blogspot.ca/2012/11/xsdxml-schema-generator-xsdexe-taking.html
''' </summary>
''' <typeparam name="T"></typeparam>
''' <remarks></remarks>
Public Class XMLConverter(Of T)
Private Shared serializer As XmlSerializer = Nothing
''' <summary>
''' Static constructor that initialises the serializer for this type
''' </summary>
Shared Sub New()
serializer = New XmlSerializer(GetType(T))
End Sub
''' <summary>
''' Write a node to an xmlwriter
''' </summary>
''' <param name="writer"></param>
''' <param name="itemToAppend">the object to be converted and written</param>
''' <remarks></remarks>
Public Shared Sub AppendToXml(writer As XmlWriter, itemToAppend As T)
Dim strObj As String = ToXML(itemToAppend)
strObj = XMLCleaner.CleanResult(strObj)
writer.WriteRaw(strObj)
writer.Flush()
strObj = Nothing
End Sub
''' <summary>
''' Serialize the supplied object into a string of XML
''' </summary>
''' <param name="obj"></param>
''' <returns></returns>
Public Shared Function ToXML(obj As T) As String
Dim strXml As String = ""
Using memoryStream As New MemoryStream()
serializer.Serialize(memoryStream, obj)
memoryStream.Position = 0
Using sr As New StreamReader(memoryStream)
strXml = sr.ReadToEnd()
End Using
End Using
Return strXml
End Function
End Class
Public Class XMLCleaner
'This is just for removing junk and slightly modifying the output
Public Shared Function CleanResult(result As String) As String
Dim retVal As String = Regex.Replace(result, "\sxmlns.+?"".*?""", "")
retVal = Regex.Replace(retVal, "SavedSearchRecord", "Record")
retVal = retVal.Replace("<?xml version=""1.0""?>", "")
retVal = Regex.Replace(retVal, vbCrLf, vbCrLf & " ")
Return retVal
End Function
End Class
And am calling this like so:
XMLConverter(Of SavedSearchRecord).AppendToXml(writer, record)
The issue is that memory is quickly being accumulated as I append new records to the file and ultimately results in an out of memory exception.
I've seen that not caching the serializer can result in this behaviour, but I think I've sidestepped that issue in my implementation. (Please correct me if I am wrong).
After examining a memory dump:
716821b4 28535 10497120 System.String
71682b74 140213 145562968 System.Char[]
71685670 140258 758802112 System.Byte[]
I can see that I have an enormous number of byte arrays getting stuck in memory. The data in the arrays leads me to believe that these are being stranded in memory by the ToXML function (as they contain the unmodified serialized object strings).
Given that the memory stream is in a Using block, I can't figure out why these byte arrays are not being collected by the GC.
In addition to this there also seems to be a large number of Char arrays in memory as well (about 1/5 of the memory used by the byte arrays) that are not being collected.
Can anyone tell me how to prevent this code from culminating in out of memory exceptions?
FYI code is written using .NET 4.0
I posted my question in a Microsoft forum and it was correctly answered there. I invited the answerer to post their response here, but they have not done so.
The original answer in full can be found here
Paraphrasing:
The serializer creates an assembly to serialize a loaded assembly in an AppDomain which cannot be unloaded.
The workaround was to Cache the serializer by specifying the RootAttribute (only one assembly will leak, once, which is a minimum amount of memory)
This workaround is the best if all the serialized objects are the same type and the object being serialized is not too large.
In my code, I didn't have the RootAttribute specified in the XMLSerializer constructor which was causing a new assembly to be created each time I called the serializer.
Changing from this
''' <summary>
''' Static constructor that initialises the serializer for this type
''' </summary>
Shared Sub New()
serializer = New XmlSerializer(GetType(T))
End Sub
To this:
''' <summary>
''' Static constructor that initialises the serializer for this type
''' </summary>
Shared Sub New()
serializer = New XmlSerializer(GetType(T), XmlRootAttribute(GetType(T).ToString))
End Sub
Completely resolved the leaking.
For a more in depth explanation for why this worked, please see the original answer in the link I posted above.
Please note that I later had to modify the constructor a bit for the results to make sense, but the above was the minimum required to fix the leak.
Shared Sub New()
Dim root As String = GetType(T).ToString
root = root.Substring(root.LastIndexOf(".") + 1, root.Length - root.LastIndexOf(".") - 1)
Dim rootNode As New XmlRootAttribute(root)
rootNode.Namespace = "<appropriate.xsd>"
serializer = New XmlSerializer(GetType(T), rootNode)
End Sub
From MSDN https://msdn.microsoft.com/en-us/library/system.xml.serialization.xmlserializer(v=vs.110).aspx
To increase performance, the XML serialization infrastructure dynamically generates assemblies to serialize and deserialize specified types. The infrastructure finds and reuses those assemblies. This behavior occurs only when using the following constructors:
XmlSerializer.XmlSerializer(Type)
XmlSerializer.XmlSerializer(Type, String)
If you use any of the other constructors, multiple versions of the same assembly are generated and never unloaded, which results in a memory leak and poor performance. The easiest solution is to use one of the previously mentioned two constructors. Otherwise, you must cache the assemblies in a Hashtable, as shown in the following example.
I'm taking a VB.Net DLL and turning it into a Portable Class Library. Once I got all of the classes moved into the new project for the PCL, Visual Studio started throwing errors for a lot of common VB syntax that I thought would still work just fine. Some examples:
LCase
InStr
Left
Mid
On Error GoTo 0
Err
Is it possible there is just some option or include I need to have to get these to work?
You must use methods of assemblies that are supported by Portable Class Libraries (see Assemblies section). You'll be able to find equivelants to the methods that aren't working for you (ex = SubString, ToUpper, ToLower, IndexOf, etc).
When using portable to target the down-level platforms (.NET 4.0, Silverlight, Windows Phone, Xbox), we do not support the majority of the features that are exposed within Microsoft.VisualBasic.dll.
Instead, we make use of the embedded runtime feature. This embeds certain functionality that would traditionally be found in Microsoft.VisualBasic.dll, into the resulting binary itself. The features that are supported are called out on this page, under the /vbruntime* section: http://msdn.microsoft.com/en-us/library/bb531259.aspx.
When targeting .NET 4.5 & Windows Store apps only, then you do get access to the traditional Microsoft.VisualBasic.dll.
As a workaround, to help you move to portable, you can define your own module that bridges the old VB functions to their .NET equivalents:
Public Module VisualBasicBridge
Public Function LCase(value As String) As String
Return value.ToLower()
End Function
End Module
As far as On Error, I'm not aware of a good way to bridging that without providing your own implementation of Microsoft.VisualBasic, and passing that via the /vbruntime switch/msbuild property.
You can create those methods so that you don't have to update tons of your legacy code. Most of it is very straightforward, the biggest difference comes with the string functions where the legacy VB functions use a 1 based index and .Net uses a 0 index. To give you an example, here is the Mid function recreated to behave like VB (created like an extension method here):
''' <summary>
''' Simulates the same functionality provide by the traditional 1 based index Mid function.
''' </summary>
''' <param name="str"></param>
''' <param name="startPos"></param>
''' <param name="length"></param>
''' <returns></returns>
''' <remarks></remarks>
<Extension()> _
Public Function Mid(ByVal str As String, ByVal startPos As Integer, ByVal length As Integer) As String
Return str.Substring(startPos - 1, length)
End Function
Here's a few more from your list and/or commonly used ones:
''' <summary>
''' Extension to the Visual Basic Left function
''' </summary>
''' <param name="str"></param>
''' <param name="length"></param>
''' <returns></returns>
''' <remarks></remarks>
<Extension()> _
Public Function [Left](ByVal str As String, ByVal length As Integer) As String
Return str.Substring(0, length)
End Function
''' <summary>
''' Extension to the Visual Basic Right function
''' </summary>
''' <param name="str"></param>
''' <param name="length"></param>
''' <returns></returns>
''' <remarks></remarks>
<Extension()> _
Public Function [Right](ByVal str As String, ByVal length As Integer) As String
Return str.Substring(str.Length - length, length)
End Function
''' <summary>
''' Determines whether a string is a numeric value. This implementation uses Decimal.TryParse to produce it's value.
''' </summary>
''' <param name="str"></param>
''' <returns></returns>
''' <remarks></remarks>
<Extension()> _
Public Function [IsNumeric](str As String) As Boolean
Dim result As Decimal = 0
Return Decimal.TryParse(str, result)
End Function
<Extension()> _
Public Function LCase(str As String) As String
Return str.ToLower
End Function
All think those methods are in Microsoft.VisualBasic namespace. You can replace them with standard ones:
LCase => string.ToLower()
InStr => string.IndexOf()
....
Replace "on error" with regular try/catch
Best regards