This question already has answers here:
VB.NET and sizeof
(3 answers)
Closed 8 years ago.
I am trying to convert the C# code given in this link. I got some errors after conversion, but i have corrected some. Still i get error for the line cbSize = sizeof(TOKEN_ELEVATION_TYPE)
The errors are:
'sizeof' is not declared. It may be inaccessible due to its protection level. D:\Desktop\WindowsApplication3\WindowsApplication3\Form1.vb 103 26 WindowsApplication3
'TOKEN_ELEVATION_TYPE' is a type and cannot be used as an expression. D:\Desktop\WindowsApplication3\WindowsApplication3\Form1.vb 103 33 WindowsApplication3
I tried using Len instead of sizeof, but the second error still exists. So can anyone help me to solve both errors. Below is the VB.NET code which has said error.
Imports System.Runtime.InteropServices
Imports System.Security.Principal
Imports System.ComponentModel
Public Class Form1
Public Const TOKEN_DUPLICATE As UInt32 = &H2
Public Const TOKEN_IMPERSONATE As UInt32 = &H4
Public Const TOKEN_QUERY As UInt32 = &H8
Public Declare Function GetTokenInformation Lib "advapi32.dll" ( _
ByVal TokenHandle As IntPtr, ByVal TokenInformationClass As TOKEN_INFORMATION_CLASS, _
ByVal TokenInformation As IntPtr, ByVal TokenInformationLength As System.UInt32, _
ByRef ReturnLength As System.UInt32) As Boolean
Declare Function DuplicateToken Lib "advapi32.dll" (ExistingTokenHandle As IntPtr, _
SECURITY_IMPERSONATION_LEVEL As Int16, ByRef DuplicateTokenHandle As IntPtr) _
As Boolean
Enum TOKEN_ELEVATION_TYPE
TokenElevationTypeDefault = 1
TokenElevationTypeFull
TokenElevationTypeLimited
End Enum
Public Enum TOKEN_INFORMATION_CLASS
TokenUser = 1
TokenGroups
TokenPrivileges
TokenOwner
TokenPrimaryGroup
TokenDefaultDacl
TokenSource
TokenType
TokenImpersonationLevel
TokenStatistics
TokenRestrictedSids
TokenSessionId
TokenGroupsAndPrivileges
TokenSessionReference
TokenSandBoxInert
TokenAuditPolicy
TokenOrigin
TokenElevationType
TokenLinkedToken
TokenElevation
TokenHasRestrictions
TokenAccessInformation
TokenVirtualizationAllowed
TokenVirtualizationEnabled
TokenIntegrityLevel
TokenUIAccess
TokenMandatoryPolicy
TokenLogonSid
MaxTokenInfoClass
' MaxTokenInfoClass should always be the last enum
End Enum
Public Enum SECURITY_IMPERSONATION_LEVEL
SecurityAnonymous
SecurityIdentification
SecurityImpersonation
SecurityDelegation
End Enum
Function IsAdmin() As Boolean
Dim identity = WindowsIdentity.GetCurrent()
Return (identity IsNot Nothing AndAlso New WindowsPrincipal(identity).IsInRole(WindowsBuiltInRole.Administrator))
End Function
''' <summary>
''' The function checks whether the primary access token of the process belongs
''' to user account that is a member of the local Administrators group, even if
''' it currently is not elevated.
''' </summary>
''' <returns>
''' Returns true if the primary access token of the process belongs to user
''' account that is a member of the local Administrators group. Returns false
''' if the token does not.
''' </returns>
Function CanBeAdmin() As Boolean
Dim fInAdminGroup As Boolean = False
Dim hToken As IntPtr = IntPtr.Zero
Dim hTokenToCheck As IntPtr = IntPtr.Zero
Dim pElevationType As IntPtr = IntPtr.Zero
Dim pLinkedToken As IntPtr = IntPtr.Zero
Dim cbSize As Integer = 0
If IsAdmin() Then
Return True
End If
Try
' Check the token for this user
hToken = WindowsIdentity.GetCurrent().Token
' Determine whether system is running Windows Vista or later operating
' systems (major version >= 6) because they support linked tokens, but
' previous versions (major version < 6) do not.
If Environment.OSVersion.Version.Major >= 6 Then
' Running Windows Vista or later (major version >= 6).
' Determine token type: limited, elevated, or default.
' Allocate a buffer for the elevation type information.
cbSize = sizeof(TOKEN_ELEVATION_TYPE)
Dim cbSizeuint As UInteger = Convert.ToUInt32(cbSize)
pElevationType = Marshal.AllocHGlobal(cbSize)
If pElevationType = IntPtr.Zero Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
End If
' Retrieve token elevation type information.
If Not GetTokenInformation(hToken, TOKEN_INFORMATION_CLASS.TokenElevationType, pElevationType, cbSizeuint, cbSizeuint) Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
End If
' Marshal the TOKEN_ELEVATION_TYPE enum from native to .NET.
Dim elevType As TOKEN_ELEVATION_TYPE = CType(Marshal.ReadInt32(pElevationType), TOKEN_ELEVATION_TYPE)
' If limited, get the linked elevated token for further check.
If elevType = TOKEN_ELEVATION_TYPE.TokenElevationTypeLimited Then
' Allocate a buffer for the linked token.
cbSize = IntPtr.Size
Dim cbSizeuint_ee As UInteger = Convert.ToUInt32(cbSize)
pLinkedToken = Marshal.AllocHGlobal(cbSize)
If pLinkedToken = IntPtr.Zero Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
End If
' Get the linked token.
If Not GetTokenInformation(hToken, TOKEN_INFORMATION_CLASS.TokenLinkedToken, pLinkedToken, cbSizeuint_ee, cbSizeuint_ee) Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
End If
' Marshal the linked token value from native to .NET.
hTokenToCheck = Marshal.ReadIntPtr(pLinkedToken)
End If
End If
' CheckTokenMembership requires an impersonation token. If we just got
' a linked token, it already is an impersonation token. If we did not
' get a linked token, duplicate the original into an impersonation
' token for CheckTokenMembership.
If hTokenToCheck = IntPtr.Zero Then
If Not DuplicateToken(hToken, CInt(SECURITY_IMPERSONATION_LEVEL.SecurityIdentification), hTokenToCheck) Then
Throw New Win32Exception(Marshal.GetLastWin32Error())
End If
End If
' Check if the token to be checked contains admin SID.
Dim id As New WindowsIdentity(hTokenToCheck)
Dim principal As New WindowsPrincipal(id)
fInAdminGroup = principal.IsInRole(WindowsBuiltInRole.Administrator)
Catch
Return False
Finally
' Centralized cleanup for all allocated resources.
If pElevationType <> IntPtr.Zero Then
Marshal.FreeHGlobal(pElevationType)
pElevationType = IntPtr.Zero
End If
If pLinkedToken <> IntPtr.Zero Then
Marshal.FreeHGlobal(pLinkedToken)
pLinkedToken = IntPtr.Zero
End If
End Try
Return fInAdminGroup
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs)
If CanBeAdmin() Then
MessageBox.Show("admin")
Else
MessageBox.Show("not admin")
End If
End Sub
End Class
You can get the effect of C# cbSize = sizeof(TOKEN_ELEVATION_TYPE) using Marshal.SizeOf to get the size of the underlying type.
Dim undertype As Type = [Enum].GetUnderlyingType(GetType(TOKEN_ELEVATION_TYPE))
cbSize = System.Runtime.InteropServices.Marshal.SizeOf(undertype)
When I ran it, undertype was System.Int32, and cbSize was 4.
Related
I am writing a volume control app in vb.net 6.0, using a reference to CoreAudioApi.dll.
I can:
Change the volume of the default render and capture devices.
Mute the default devices.
Alter the balance on the render device
List the full names, guid string and status of all the devices
However, despite a lot of research, I can not setup a callback for ControlChangeNotify.
It appears to be simple in C, however I am writing in VB. Can any one suggest a solution?
Update 18/12/2022 #Jimi supplied some very useful definitions and I have edited the post to show the current code attempts. I can get the master default volume using masterVol = GetMasterVolumeObject() as an IAudioEndpointVolume.
Update 22/12/2022 Following a re-read of many postings it became apparent that it was important to create a persistent reference to mastervol and the class reference (MyCallBack) to the class module implementing IAudioEndpointVolumeCallback.
Update 24/12/2022 The AudioCallback class is now firing when volume/mute are changed internally and externally. Transferring the callback data to the main form is problematic. I now have a working system which involves:
Declaring public events in the call back class for each type of control I want to change in the main form.
Initiating a BackgroundWorker to Process the data 10mS after being called by the callback class.
Calculating new audio values from the pNotifyData pointer.
RaiseEvent for each slider/checkbox and label in the main form that needs updating.
AddHandler in the main form to process the callback events.
Create handler routines with delegates for each control type.
From my point of view this topic is solved.
My thanks to #Jimi for his contribution.
Latest Updates:
Option Explicit On
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Public Class AudioCallback
Implements IAudioEndpointVolumeCallback
Public Event LabelReady(sender As AudioCallback, ByVal T As String)
Public Event SliderReady(sender As AudioCallback, EP As String, ByVal T As Integer)
Public Event CheckReady(sender As AudioCallback, EP As String, ByVal T As Boolean)
Public Function OnNotify(pNotifyData As IntPtr) As Integer Implements IAudioEndpointVolumeCallback.OnNotify
' Move to global structure
Gstructure = Marshal.PtrToStructure(pNotifyData, GetType(AUDIO_VOLUME_NOTIFICATION_DATA))
BackGround() ' Asynchronous call and delagate controls
Return 0
End Function
Private Sub BackGround()
Dim bgw = New BackgroundWorker()
AddHandler bgw.DoWork,
Sub()
System.Threading.Thread.Sleep(10)
End Sub
AddHandler bgw.RunWorkerCompleted,
Sub()
Update()
End Sub
bgw.RunWorkerAsync()
End Sub
Private Sub Update()
Dim svolL As Integer
Dim svolR As Integer
Dim balance As Integer
'ChkMaster.Checked = Gstructure.bMuted
RaiseEvent CheckReady(Me, "R", Gstructure.bMuted)
svolL = 0.5 + 100 * Gstructure.Left
svolR = 0.5 + 100 * Gstructure.Right
If svolL = svolR Then
balance = 0
Else
If svolR > svolL Then
balance = 100 - svolL * 100.0 / svolR
Else
balance = -(100 - svolR * 100.0 / svolL)
End If
End If
RaiseEvent SliderReady(Me, "RV", 0.5 + 100 * Gstructure.fMasterVolume) ' HMaster.Value = 0.5 + 100 * Gstructure.fMasterVolume
RaiseEvent SliderReady(Me, "RB", balance) ' HBalance.Value = balance
'LGuid.Text = Gstructure.guidEventContext.ToString
RaiseEvent LabelReady(Me, Gstructure.guidEventContext.ToString)
End Sub
End Class
' Main form Extracts ============================================
Imports CoreAudioApi
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Show()
' events for handling AudioCallback events
AddHandler MyCallBack.LabelReady, AddressOf LReady
AddHandler MyCallBack.SliderReady, AddressOf HReady
AddHandler MyCallBack.CheckReady, AddressOf CReady
End Sub
' Label Guid displays Callback GUID
' CheckBox ChkMaster displays Mute status
' Horizontal scrollbar HMaster displays default render volume
' Horizontal scrollbar HBalance displays default render balance
' The global variable IsSettingMaster prevents code associated
' with altering the value of the sliders from re-setting
' the volume / balance.
Private Sub LReady(sender As AudioCallback, Data As String) ' Set GUID label for Render
UpdateLabel(LGuid, Data)
End Sub
Private Delegate Sub UpdateLabelDelegate(TB As Label, param As String)
Private Sub UpdateLabel(TB As Label, param As String)
If TB.InvokeRequired Then
TB.Invoke(New UpdateLabelDelegate(AddressOf UpdateLabel), New Object() {TB, param})
Else
TB.Text = param
End If
End Sub
Private Sub CReady(sender As AudioCallback, EP As String, Data As Boolean) ' Set Master (Render) Mute checkbox
If EP = "R" Then UpdateChkbox(ChkMaster, Data)
End Sub
Private Delegate Sub UpdateChkboxDelegate(TB As CheckBox, param As Boolean)
Private Sub UpdateChkbox(TB As CheckBox, param As Boolean)
If TB.InvokeRequired Then
TB.Invoke(New UpdateChkboxDelegate(AddressOf UpdateChkbox), New Object() {TB, param})
Else
TB.Checked = param
End If
End Sub
Private Sub HReady(sender As AudioCallback, EP As String, Data As Integer) ' Set Master (Render) Volume / Master Balance slide
IsSettingMaster = True
If EP = "RV" Then UpdateHslide(HMaster, Data)
If EP = "RB" Then UpdateHslide(HBalance, Data)
IsSettingMaster = False
End Sub
Private Delegate Sub UpdateHslideDelegate(TB As HScrollBar, param As Integer)
Private Sub UpdateHslide(TB As HScrollBar, param As Integer)
If TB.InvokeRequired Then
TB.Invoke(New UpdateHslideDelegate(AddressOf UpdateHslide), New Object() {TB, param})
Else
TB.Value = param
End If
End Sub
History:
' ===============================
' Public Class containing Callback:
Option Explicit On
Imports System.Runtime.InteropServices
Public Class AudioCallback
Implements IAudioEndpointVolumeCallback
Public Function OnNotify(pNotifyData As IntPtr) As Integer Implements IAudioEndpointVolumeCallback.OnNotify
' Move to global structure
Gstructure = Marshal.PtrToStructure(pNotifyData, GetType(AUDIO_VOLUME_NOTIFICATION_DATA))
' Need mechanism to process new data in main form
' Must be asynchronous
' Raise event did not work
' Enabling Timer did not work
HaveChange = True ' Flag global variable
Return 0
End Function
End Class
' ===============================
' Public Class to Setup Callback:
Option Explicit On
Imports System.Runtime.InteropServices
' Implements IMMDevice, IMMDeviceEnumerator, IAudioEndpointVolume
' developed from https://exchangetuts.com/how-to-check-if-the-system-audio-is-muted-1641156904496320
Public Class CoreAudio
' Public definition in ModCoreaudioAlt https://stackoverflow.com/questions/52001368/how-to-check-if-the-system-audio-is-muted/52013031#52013031
' Public Interface IAudioEndpointVolumeCallback
' Public Structure AUDIO_VOLUME_NOTIFICATION_DATA
' Public Interface IMMDevice
' Public Interface IMMDeviceEnumerator
' End Public definition in ModCoreaudioAlt ==============================
Dim CLSID_MMDeviceEnumerator As Guid = New Guid("{BCDE0395-E52F-467C-8E3D-C4579291692E}")
Dim MMDeviceEnumeratorType As Type = Type.GetTypeFromCLSID(CLSID_MMDeviceEnumerator, True)
Private hr As Integer
Friend Enum EDataFlow
eRender
eCapture
eAll
EDataFlow_enum_count
End Enum
Friend Enum ERole
eConsole
eMultimedia
eCommunications
ERole_enum_count
End Enum
<Flags>
Friend Enum CLSCTX As UInteger
CLSCTX_INPROC_SERVER = &H1 ' In CLSCTX_ALL
CLSCTX_INPROC_HANDLER = &H2 ' In CLSCTX_ALL
CLSCTX_LOCAL_SERVER = &H4 ' In CLSCTX_ALL
CLSCTX_INPROC_SERVER16 = &H8
CLSCTX_REMOTE_SERVER = &H10 ' In CLSCTX_ALL
CLSCTX_INPROC_HANDLER16 = &H20
CLSCTX_RESERVED1 = &H40
CLSCTX_RESERVED2 = &H80
CLSCTX_RESERVED3 = &H100
CLSCTX_RESERVED4 = &H200
CLSCTX_NO_CODE_DOWNLOAD = &H400
CLSCTX_RESERVED5 = &H800
CLSCTX_NO_CUSTOM_MARSHAL = &H1000
CLSCTX_ENABLE_CODE_DOWNLOAD = &H2000
CLSCTX_NO_FAILURE_LOG = &H4000
CLSCTX_DISABLE_AAA = &H8000
CLSCTX_ENABLE_AAA = &H10000
CLSCTX_FROM_DEFAULT_CONTEXT = &H20000
CLSCTX_ACTIVATE_32_BIT_SERVER = &H40000
CLSCTX_ACTIVATE_64_BIT_SERVER = &H80000
CLSCTX_INPROC = CLSCTX_INPROC_SERVER Or CLSCTX_INPROC_HANDLER
CLSCTX_SERVER = CLSCTX_INPROC_SERVER Or CLSCTX_LOCAL_SERVER Or CLSCTX_REMOTE_SERVER ' In CLSCTX_ALL
CLSCTX_ALL = CLSCTX_SERVER Or CLSCTX_INPROC_HANDLER
End Enum
Friend Function GetMasterVolumeObject() As IAudioEndpointVolume
' Get the default IAudioEndpintVolume as "ppEndpoint" for eRender & eMultimedia
Dim deviceEnumerator As IMMDeviceEnumerator = Nothing
Dim MediaDevice As IMMDevice = Nothing
Dim ppEndpoint As IAudioEndpointVolume = Nothing
Dim EndPointVolID As Guid = GetType(IAudioEndpointVolume).GUID
Try
Dim MMDeviceEnumerator As Object = Activator.CreateInstance(MMDeviceEnumeratorType)
deviceEnumerator = CType(MMDeviceEnumerator, IMMDeviceEnumerator)
deviceEnumerator.GetDefaultAudioEndpoint(EDataFlow.eRender, ERole.eMultimedia, MediaDevice)
MediaDevice.Activate(EndPointVolID, CLSCTX.CLSCTX_ALL, IntPtr.Zero, ppEndpoint)
Catch ex As Exception
Form1.Showme("Error in GetMasterVolumeObject: " & ex.Message, Color.Red)
ppEndpoint = Nothing
Finally
If Not IsNothing(deviceEnumerator) Then Marshal.ReleaseComObject(deviceEnumerator)
If Not IsNothing(MediaDevice) Then Marshal.ReleaseComObject(MediaDevice)
End Try
Return ppEndpoint
End Function
Public Sub Callback()
Try
masterVol = GetMasterVolumeObject()
' MyCallBack defined in Module ModCoreAudioAlt : Public MyCallBack As New AudioCallback
If IsNothing(MyCallBack) Then
Form1.Showme("Failed to set MyCallBack", Color.Red)
Else
hr = masterVol.RegisterControlChangeNotify(MyCallBack)
If hr <> 0 Then
Form1.Showme("Callback register failed", Color.Red)
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
Else
Form1.Showme("Callback register OK", Color.Blue)
CallBackOn = True
End If
End If
Catch ex As Exception
Form1.Showme("CallBack error " & ex.Message, Color.Red)
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
End Try
End Sub
Public Sub Cancelcallback()
If CallBackOn = False Then Exit Sub
hr = masterVol.UnregisterControlChangeNotify(MyCallBack)
If hr <> 0 Then
MsgBox("Callback Failed to UnRegister", vbOK, "Core Audio Callback")
Else
If Not IsNothing(masterVol) Then Marshal.ReleaseComObject(masterVol)
Form1.Showme("Callback Un-register OK", Color.Blue)
CallBackOn = False
End If
End Sub
End Class
' ==============
' Public Module:
Imports System.Runtime.InteropServices
Imports CoreAudioApi
Module ModCoreAudioAlt
' https://stackoverflow.com/questions/74833398/coreaudio-in-vb-net-6-0-windows-11-Is-there-a-way-to-do-a-controlchangenotify
Public CallBackOn As Boolean = False ' Callback is on Flag
Public masterVol As IAudioEndpointVolume = Nothing
Public MyCallBack As New AudioCallback
Public Gstructure As New AUDIO_VOLUME_NOTIFICATION_DATA ' Callback data
Public HaveChange As Boolean = False ' Callback has fired
<ComImport>
<Guid("657804FA-D6AD-4496-8A60-352752AF4F89")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IAudioEndpointVolumeCallback
<PreserveSig()>
Function OnNotify(pNotifyData As IntPtr) As Integer
End Interface
<StructLayout(LayoutKind.Sequential)>
Public Structure AUDIO_VOLUME_NOTIFICATION_DATA
Public guidEventContext As Guid
Public bMuted As Boolean
Public fMasterVolume As Single
Public nChannels As UInteger
Public Left As Single ' .net will not allow pre-dimensioned array (aVolumes(1) as single)
Public Right As Single
End Structure
' https://gist.github.com/sverrirs/d099b34b7f72bb4fb386
<ComImport>
<Guid("5CDF2C82-841E-4546-9722-0CF74078229A")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IAudioEndpointVolume
Function RegisterControlChangeNotify(<MarshalAs(UnmanagedType.Interface)> pNotify As IAudioEndpointVolumeCallback) As Integer
Function UnregisterControlChangeNotify(<MarshalAs(UnmanagedType.Interface)> pNotify As IAudioEndpointVolumeCallback) As Integer
Function GetChannelCount(ByRef channelCount As Integer) As HRESULT
Function SetMasterVolumeLevel() As HRESULT
Function SetMasterVolumeLevelScalar(level As Single, eventContext As Guid) As HRESULT
Function GetMasterVolumeLevel(<Out> ByRef level As Single) As HRESULT
Function GetMasterVolumeLevelScalar(<Out> ByRef level As Single) As HRESULT
Function SetChannelVolumeLevel(channelNumber As Integer, level As Single, eventContext As Guid) As HRESULT
Function SetChannelVolumeLevelScalar(channelNumber As Integer, level As Single, eventContext As Guid) As HRESULT
Function GetChannelVolumeLevel(channelNumber As Integer, <Out> ByRef level As Single) As HRESULT
Function GetChannelVolumeLevelScalar(channelNumber As Integer, <Out> ByRef level As Single) As HRESULT
Function SetMute(<MarshalAs(UnmanagedType.Bool)> isMuted As Boolean, eventContext As Guid) As HRESULT
Function GetMute(<Out> ByRef isMuted As Boolean) As HRESULT
Function GetVolumeStepInfo(<Out> ByRef pnStep As Integer, ByRef pnStepCount As Integer) As HRESULT
Function VolumeStepUp(eventContext As Guid) As HRESULT
Function VolumeStepDown(eventContext As Guid) As HRESULT
Function QueryHardwareSupport(<Out> ByRef hardwareSupportMask As Integer) As HRESULT
Function GetVolumeRange(<Out> ByRef volumeMin As Single, <Out> ByRef volumeMax As Single, <Out> ByRef volumeStep As Single) As HRESULT
End Interface
<ComImport>
<Guid("A95664D2-9614-4F35-A746-DE8DB63617E6")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IMMDeviceEnumerator
Function EnumAudioEndpoints(ByVal dataFlow As EDataFlow, ByVal dwStateMask As Integer, <Out> ByRef ppDevices As IMMDeviceCollection) As HRESULT
' for 0x80070490 : Element not found
<PreserveSig>
Function GetDefaultAudioEndpoint(ByVal dataFlow As EDataFlow, ByVal role As ERole, <Out> ByRef ppEndpoint As IMMDevice) As HRESULT
Function GetDevice(ByVal pwstrId As String, <Out> ByRef ppDevice As IMMDevice) As HRESULT
Function NotImpl1() As Integer
End Interface
<ComImport>
<Guid("D666063F-1587-4E43-81F1-B948E807363F")>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IMMDevice
Function Activate(ByRef iid As Guid, ByVal dwClsCtx As CLSCTX, ByVal pActivationParams As IntPtr, <Out> ByRef ppInterface As IAudioEndpointVolume) As HRESULT
Function OpenPropertyStore(ByVal stgmAccess As Integer, <Out> ByRef ppProperties As IPropertyStore) As HRESULT
Function GetId(<Out> ByRef ppstrId As IntPtr) As HRESULT
Function GetState(<Out> ByRef pdwState As Integer) As HRESULT
End Interface
End Module
' ==========
' Main Form:
Public Class Form1
' Contains:
' HMaster horizonal scroll 0-105 for Volume
' HBalance horizontal scroll -100 to 105 for Balance
' ChkMaster CheckBox for Mute
' LGuid label for Callback GUID
' Uses timer1 with 1 second interval to poll for Callback flag
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
If HaveChange = False Then Exit Sub
HaveChange = False
ChkMaster.Checked = Gstructure.bMuted
Dim svolL As Integer = 100 * Gstructure.Left
Dim svolR As Integer = 100 * Gstructure.Right
Dim balance As Integer
If svolL = svolR Then
balance = 0
Else
If svolR > svolL Then
balance = 100 - svolL * 100.0 / svolR
Else
balance = -(100 - svolR * 100.0 / svolL)
End If
End If
HMaster.Value = 100 * Gstructure.fMasterVolume
HBalance.Value = balance
LGuid.Text = (Gstructure.guidEventContext.ToString)
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
If CallBackOn Then ClassCoreAudio.Cancelcallback()
End Sub
end class
I have a large vb.net x86 project that is running in VS2015 and .Net 4.5.2
When it is compiled and run in debug without optimization then it works ok. However if I compile and run it in Release mode with optimization turned on then I get a variety of exceptions at the same innocuous line of code. I have tried debugging it in release mode but the breakpoints are unreliable. Also the very act of debugging it seems to modify the exception. Also if I change the code (for example putting a MsgBox in to display information) then the problem can go away. For example I changed an Arraylist to a List(Of Control) and the problem no longer occurred where it did before but now moved elsewhere.
I have received all of the following at different times:
AccessViolationException,
NullReferenceException (somewhere deep within .Net classes)
and FatalExecutionEngineError
The exception detail in the AccessViolationException tells nothing except that "this is often an indication that other memory is corrupt". The stack trace is meaningless and there is no description of what it thought was at the invalid memory address.
I also cannot find any meaningful detail about what Optimization in the compiler actually does - one solution might be to turn Optimization off but I don't understand what the benefit / negative effect is of doing this.
Is the Optimization unreliable? How can one possibly try and ascertain what is happening?
The only unmanaged code we use is some calls to get Icons related to file extensions - which are then cloned into managed objects and the unmanaged memory destroyed. This is pretty standard and the same API has been used since 1.1 and through 4.5.2 for 10 years without this occurring before.
I cannot create a small project that reproduces the issue
Here's the code we use for extracting icons as it's the only potential cause I have right now. It was borrowed from elsewhere and I can't really tell whether it's as good as it should be:
Public Class IconExtractor
<Flags()> Private Enum SHGFI
SmallIcon = &H1
LargeIcon = &H0
Icon = &H100
DisplayName = &H200
Typename = &H400
SysIconIndex = &H4000
UseFileAttributes = &H10
End Enum
<StructLayout(LayoutKind.Sequential)>
Private Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<MarshalAs(UnmanagedType.LPStr, SizeConst:=260)> Public szDisplayName As String
<MarshalAs(UnmanagedType.LPStr, SizeConst:=80)> Public szTypeName As String
Public Sub New(ByVal B As Boolean)
hIcon = IntPtr.Zero
iIcon = 0
dwAttributes = 0
szDisplayName = vbNullString
szTypeName = vbNullString
End Sub
End Structure
Private Declare Auto Function SHGetFileInfo Lib "shell32" (
ByVal pszPath As String, ByVal dwFileAttributes As Integer,
ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlags As SHGFI) As Integer
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Boolean
End Function
Public Shared Sub GetIconsForFile(ByVal rstrFileName As String, ByRef rzSmallIcon As Icon, ByRef rzLargeIcon As Icon)
Dim zFileInfo As New SHFILEINFO(True)
Dim cbSizeInfo As Integer = Marshal.SizeOf(zFileInfo)
Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes Or SHGFI.SmallIcon
SHGetFileInfo(rstrFileName, 256, zFileInfo, cbSizeInfo, flags)
' Use clone so we can destroy immediately
rzSmallIcon = DirectCast(Icon.FromHandle(zFileInfo.hIcon).Clone, Icon)
DestroyIcon(zFileInfo.hIcon)
zFileInfo = New SHFILEINFO(True)
cbSizeInfo = Marshal.SizeOf(zFileInfo)
flags = SHGFI.Icon Or SHGFI.UseFileAttributes Or SHGFI.LargeIcon
SHGetFileInfo(rstrFileName, 256, zFileInfo, cbSizeInfo, flags)
' Use clone so we can destroy immediately
rzLargeIcon = DirectCast(Icon.FromHandle(zFileInfo.hIcon).Clone, Icon)
DestroyIcon(zFileInfo.hIcon)
End Sub
End Class
I stumbled across the solution to this by chance.
I was reading this documentation of SHGETFILEINFO
https://msdn.microsoft.com/en-us/library/windows/desktop/bb762179(v=vs.85).aspx
and found that it said in the remarks: You should call this function from a background thread. Failure to do so could cause the UI to stop responding
It isn't clear why you should call it from a background thread nor is it clear what "stop responding" might actually manifest itself as.
However it seemed this was fairly likely what was causing the problem and so I refactored to execute the api call under a separate thread. This has certainly seemed to work. Many of the examples on the internet of SHGETFILEINFO do not seem to consider the separate thread requirement.
I reproduce the whole refactored code here:
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Threading
''' <summary>
''' Retrieves the small and large icons registered for a filename based on the file's extension
''' </summary>
Public Class FileIcons
Private mFileName As String
Private mSmallIconHandle As IntPtr
Private mSmallIcon As Icon
Private mLargeIconHandle As IntPtr
Private mLargeIcon As Icon
Public Sub New(ByVal rFileName As String)
mFileName = rFileName
Dim t As New Thread(AddressOf GetIconsForFile)
t.SetApartmentState(ApartmentState.STA)
t.Start()
t.Join()
' Use clone so we can destroy immediately
mSmallIcon = DirectCast(Icon.FromHandle(mSmallIconHandle).Clone, Icon)
DestroyIcon(mSmallIconHandle)
' Use clone so we can destroy immediately
mLargeIcon = DirectCast(Icon.FromHandle(mLargeIconHandle).Clone, Icon)
DestroyIcon(mLargeIconHandle)
End Sub
Public ReadOnly Property SmallIcon As Icon
Get
Return mSmallIcon
End Get
End Property
Public ReadOnly Property LargeIcon As Icon
Get
Return mLargeIcon
End Get
End Property
Private Sub GetIconsForFile()
' Go and extract the small and large icons
' Full filename must be < MAX_PATH - which is 260 chars in .Net (apparently) though a file path/length of 256 also causes an error.
' Otherwise SHGetFileInfo gets nothing, Icon.FromHandle then gives "System.ArgumentException: The Win32 handle you passed to Icon is invalid or of the wrong type."
' This needs to be stopped in the calling code, or the resulting error trapped
Dim zFileInfo As New SHFILEINFO(True)
Dim cbSizeInfo As Integer = Marshal.SizeOf(zFileInfo)
Dim flags As SHGFI = SHGFI.Icon Or SHGFI.UseFileAttributes Or SHGFI.SmallIcon
SHGetFileInfo(mFileName, 256, zFileInfo, cbSizeInfo, flags)
mSmallIconHandle = zFileInfo.hIcon
zFileInfo = New SHFILEINFO(True)
cbSizeInfo = Marshal.SizeOf(zFileInfo)
flags = SHGFI.Icon Or SHGFI.UseFileAttributes Or SHGFI.LargeIcon
SHGetFileInfo(mFileName, 256, zFileInfo, cbSizeInfo, flags)
mLargeIconHandle = zFileInfo.hIcon
End Sub
#Region "WinAPI"
<Flags()> Private Enum SHGFI
SmallIcon = &H1
LargeIcon = &H0
Icon = &H100
DisplayName = &H200
Typename = &H400
SysIconIndex = &H4000
UseFileAttributes = &H10
End Enum
<StructLayout(LayoutKind.Sequential)>
Private Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<MarshalAs(UnmanagedType.LPStr, SizeConst:=260)> Public szDisplayName As String
<MarshalAs(UnmanagedType.LPStr, SizeConst:=80)> Public szTypeName As String
Public Sub New(ByVal B As Boolean)
hIcon = IntPtr.Zero
iIcon = 0
dwAttributes = 0
szDisplayName = vbNullString
szTypeName = vbNullString
End Sub
End Structure
Private Declare Auto Function SHGetFileInfo Lib "shell32" (
ByVal pszPath As String,
ByVal dwFileAttributes As Integer,
ByRef psfi As SHFILEINFO,
ByVal cbFileInfo As Integer,
ByVal uFlags As SHGFI) As Integer
<DllImport("user32.dll", SetLastError:=True)>
Private Shared Function DestroyIcon(ByVal hIcon As IntPtr) As Boolean
End Function
#End Region
End Class
I have this program that shows files with its icons using a ListView and it works a little bit fine but there's a problem, some files(.exe, .docx etc...) don't show their right icon like this. how do I fix that?
This is how I call the Shell:
' declare the Win32 API function SHGetFileInfo'
Public Declare Auto Function SHGetFileInfo Lib "shell32.dll" (ByVal pszPath As String, ByVal dwFileAttributes As Integer, ByRef psfi As SHFILEINFO, ByVal cbFileInfo As Integer, ByVal uFlags As Integer) As IntPtr
' declare some constants that SHGetFileInfo requires'
Public Const SHGFI_ICON As Integer = &H100
Public Const SHGFI_SMALLICON As Integer = &H1
' define the SHFILEINFO structure'
Structure SHFILEINFO
Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=260)> _
Public szDisplayName As String
<Runtime.InteropServices.MarshalAs(Runtime.InteropServices.UnmanagedType.ByValTStr, SizeConst:=80)> _
Public szTypeName As String
End Structure
Function RetrieveShellIcon(ByVal argPath As String) As Image
Dim mShellFileInfo As SHFILEINFO
Dim mSmallImage As IntPtr
Dim mIcon As System.Drawing.Icon
Dim mCompositeImage As Image
mShellFileInfo = New SHFILEINFO
mShellFileInfo.szDisplayName = New String(Chr(0), 260)
mShellFileInfo.szTypeName = New String(Chr(0), 80)
mSmallImage = SHGetFileInfo(argPath, 0, mShellFileInfo, System.Runtime.InteropServices.Marshal.SizeOf(mShellFileInfo), SHGFI_ICON Or SHGFI_SMALLICON)
' create the icon from the icon handle'
Try
mIcon = System.Drawing.Icon.FromHandle(mShellFileInfo.hIcon)
mCompositeImage = mIcon.ToBitmap
Catch ex As Exception
' create a blank black bitmap to return'
mCompositeImage = New Bitmap(16, 16)
End Try
' return the composited image'
Return mCompositeImage
End Function
Function GetIcon(ByVal argFilePath As String) As Image
Dim mFileExtension As String = System.IO.Path.GetExtension(argFilePath)
' add the image if it doesn't exist'
If cIcons.ContainsKey(mFileExtension) = False Then
cIcons.Add(mFileExtension, RetrieveShellIcon(argFilePath))
End If
' return the image'
Return cIcons(mFileExtension)
End Function
and this is how I show file icons in my `ListView.
Sub lv1items()
Dim lvi As ListViewItem
Dim di As New DirectoryInfo(Form2.TextBox1.Text)
Dim exts As New List(Of String)
ImageList1.Images.Clear()
If di.Exists = False Then
MessageBox.Show("Source path is not found", "Directory Not Found", MessageBoxButtons.OK, MessageBoxIcon.Error)
Else
For Each fi As FileInfo In di.EnumerateFiles("*.*")
lvi = New ListViewItem
lvi.Text = fi.Name
lvi.SubItems.Add(((fi.Length / 1024)).ToString("0.00"))
lvi.SubItems.Add(fi.CreationTime.ToShortDateString)
If exts.Contains(fi.Extension) = False Then
Dim mShellIconManager As New Form1
For Each mFilePath As String In My.Computer.FileSystem.GetFiles(Form2.TextBox1.Text)
ImageList1.Images.Add(fi.Extension, GetIcon(mFilePath))
exts.Add(fi.Extension)
Next
End If
lvi.ImageKey = fi.Extension
ListView1.Items.Add(lvi)
Next
End If
End Sub
That appears to be a weird limitation of the .net implication
its really just making a call to shell32.dll
You should call the function in shell32 directly
something like this should work
<DllImport("shell32.dll")>
Private Shared Function ExtractAssociatedIcon(hInst As IntPtr, lpIconPath As StringBuilder, ByRef lpiIcon As UShort) As IntPtr
End Function
_
Dim handle As IntPtr = SafeNativeMethods.ExtractAssociatedIcon(New HandleRef(Nothing, IntPtr.Zero), iconPath, index)
If handle <> IntPtr.Zero Then
Return Icon.FromHandle(handle)
End If
The syntax might not be exactly correct, also there is a good blog post about how to pull that information from the registry (which won't always give you the correct answer, but its faster)
Building a Better ExtractIcon (he uses the SHGetFileInfo API in shell32.dll if that blog ever dies it will give people a place to start looking)
I have a code in VB coded in Microsoft Visual Studio 2015 unfortunately I have an error when running the program.
Here's the error:
Managed Debugging Assistant 'PInvokeStackImbalance' has detected a problem in 'C:\Users\PC_6\Documents\Visual Studio 2015\Projects\Test\test\bin\Debug\Test.vshost.exe'.
Additional information: A call to PInvoke function 'Test!Test.Form1::InternetGetConnectedState' has unbalanced the stack.
Here's my code.
Imports System.Runtime.InteropServices
Public Class Form1
Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef conn As Long, ByVal val As Long) As Boolean
Private Sub btnPay_Click(sender As Object, e As EventArgs) Handles btnPay.Click
Select Case ListBox1.SelectedIndex
Case 0
MsgBox("Selected Payment is " + ListBox1.SelectedItem)
Case 1
MsgBox("Selected Payment is " + ListBox1.SelectedItem)
Case 2
btnPay.Text = ("Checking Connection")
Dim Out As Integer
If InternetGetConnectedState(Out, 0) = True Then
MsgBox("Connected!")
Else
MsgBox("No Connection!")
End If
Case Else
MsgBox("Please Select a Payment Type")
End Select
End Sub
End Class
The documentation for InternetGetConnectedState ( https://msdn.microsoft.com/en-us/library/windows/desktop/aa384702%28v=vs.85%29.aspx?f=255&MSPPError=-2147217396 ) shows it accepts LPDWORD and DWORD arguments, in .NET the equivalents are out UInt32 (or ref) and UInt32 respectively.
Change your signature to this:
Public Enum InternetConnection As UInt32
None = 0,
Configured = &H40,
Lan = &H02,
Modem = &H01,
ModemBusy = &H08,
Offline = &H20,
Proxy = &H04,
RasInstalled = &H10
End Enum
Private Declare Function InternetGetConnectedState Lib "wininet" (ByRef flags As InternetConnection, ByVal reserved As UInt32) As Boolean
And called like so:
Dim result As Boolean
InternetConnection flags;
result = InternetGetConnectedState( flags, 0 );
If result = False Then
' TODO: Call GetLastError to eliminate other causes of failure before determining it is indeed due to a lack of an internet connection
End If
I'm re-visiting a tool that I wrote in VB.Net for my helpdesk team a while back and want to add a couple of checkboxes to replicate the same function that Windows uses to show hidden files and folders / re-hide, as well as protected operating system files.
I know I can do this by editing a registry entry and restarting explorer.exe, but that closes all open Explorer Windows and I don't want that.
Does anyone know how Windows is able to do this by a simple click of a checkbox and how I may be able to code it in VB.net?
Any input on this is greatly appreciated in advance.
EDIT: So it looks like I have found a refresh method that works to refresh Windows Explorer / File Explorer which can be applied to Drarig's answer below but I am having trouble converting it to VB.net as the original example is in C#.
'Original at http://stackoverflow.com/questions/2488727/refresh-windows-explorer-in-win7
Private Sub refreshExplorer(ByVal explorerType As String)
Dim CLSID_ShellApplication As Guid = Guid.Parse("13709620-C279-11CE-A49E-444553540000")
Dim shellApplicationType As Type = Type.GetTypeFromCLSID(CLSID_ShellApplication, True)
Dim shellApplication As Object = Activator.CreateInstance(shellApplicationType)
Dim windows As Object = shellApplicationType.InvokeMember("Windows", Reflection.BindingFlags.InvokeMethod, Nothing, shellApplication, New Object() {})
Dim windowsType As Type = windows.GetType()
Dim count As Object = windowsType.InvokeMember("Count", Reflection.BindingFlags.GetProperty, Nothing, windows, Nothing)
For i As Integer = 0 To CType(count, Integer)
Dim item As Object = windowsType.InvokeMember("Item", Reflection.BindingFlags.InvokeMethod, Nothing, windows, New Object() {i})
Dim itemType As Type = item.GetType()
'Only fresh Windows explorer Windows
Dim itemName As String = CType(itemType.InvokeMember("Name", Reflection.BindingFlags.GetProperty, Nothing, item, Nothing), String)
If itemName = explorerType Then
itemType.InvokeMember("Refresh", Reflection.BindingFlags.InvokeMethod, Nothing, item, Nothing)
End If
Next
End Sub
I am getting an exception Object reference not set to an instance of an object when I set itemType as Type = item.GetType() above. I can't figure out which object isn't being created. When I step through the code it looks like windowsType contains an object for windows. Does anyone have any idea on this? Once this is worked out I can then apply it to Drarig's solution below.
Alright I wish I could have got this to you sooner, but busy lately at work. I took a little time today to figure this out as I love digging into something I have not done before. This is the whole class from a new project; didn't have time to wrap it up in a separate class. I am sure this will get you what you need. It was a little harder than I thought as getting the correct handle and then send the command, but I got it. I hope you find it useful.
P.S. Some of the things you can leave out, specifically the boolean used for loading, this was so I can pull the current value back on load and either check/uncheck the CheckBox.
Note: This is tried and tested on Windows 7, 8 and 10
Imports Microsoft.Win32
Imports System.Reflection
Imports System.Runtime.InteropServices
Public Class Form1
<Flags()> _
Public Enum KeyboardFlag As UInteger
KEYBOARDF_5 = &H74
End Enum
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function GetWindow(ByVal hl As Long, ByVal vm As Long) As IntPtr
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Boolean
End Function
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
End Function
Private blnLoading As Boolean = False
Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles CheckBox1.CheckedChanged
Form1.HideFilesExtension(Me.CheckBox1.Checked)
If Not blnLoading Then NotifyFileAssociationChanged()
RefreshExplorer()
End Sub
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim name As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey(name, False)
blnLoading = True
Me.CheckBox1.Checked = CBool(key.GetValue("Hidden"))
key.Close()
blnLoading = False
End Sub
Private Shared Sub HideFilesExtension(ByVal Hide As Boolean)
Dim name As String = "Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey(name, True)
key.SetValue("Hidden", If(Hide, 1, 0))
key.Close()
End Sub
Public Shared Sub RefreshExplorer()
Dim clsid As New Guid("13709620-C279-11CE-A49E-444553540000")
Dim typeFromCLSID As Type = Type.GetTypeFromCLSID(clsid, True)
Dim objectValue As Object = Activator.CreateInstance(typeFromCLSID)
Dim obj4 As Object = typeFromCLSID.InvokeMember("Windows", BindingFlags.InvokeMethod, Nothing, objectValue, New Object(0 - 1) {})
Dim type1 As Type = obj4.GetType
Dim obj2 As Object = type1.InvokeMember("Count", BindingFlags.GetProperty, Nothing, obj4, Nothing)
If (CInt(obj2) <> 0) Then
Dim num2 As Integer = (CInt(obj2) - 1)
Dim i As Integer = 0
Do While (i <= num2)
Dim obj5 As Object = type1.InvokeMember("Item", BindingFlags.InvokeMethod, Nothing, obj4, New Object() {i})
Dim type3 As Type = obj5.GetType
Dim str As String = CStr(type3.InvokeMember("Name", BindingFlags.GetProperty, Nothing, obj5, Nothing))
If (str = "File Explorer") Then
type3.InvokeMember("Refresh", BindingFlags.InvokeMethod, Nothing, obj5, Nothing)
End If
i += 1
Loop
End If
End Sub
Public Shared Sub NotifyFileAssociationChanged()
'Find the actual window...
Dim hwnd As IntPtr = FindWindow("Progman", "Program Manager")
'Get the window handle and refresh option...
Dim j = GetWindow(hwnd, 3)
'Finally post the message...
PostMessage(j, 256, KeyboardFlag.KEYBOARDF_5, 3)
End Sub
End Class
Here's a solution for everything excepting the refreshing of the explorer.
I've translated the code, but I'm unable to find how to refresh the explorer/desktop without restarting it.
Const keyName As String = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced"
Const Hidden As String = "Hidden"
Const SHidden As String = "ShowSuperHidden"
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim St As Integer = GetRegValue(Hidden)
If St = 2 Then
SetRegValue(Hidden, 1)
SetRegValue(SHidden, 1)
Else
SetRegValue(Hidden, 2)
SetRegValue(SHidden, 0)
End If
End Sub
Private Function GetRegValue(valueName As String) As Integer
Return CInt(My.Computer.Registry.GetValue(keyName, valueName, 0))
End Function
Private Sub SetRegValue(valueName As String, value As Integer)
My.Computer.Registry.SetValue(keyName, valueName, value, Microsoft.Win32.RegistryValueKind.DWord)
End Sub
I have a few ideas to refresh the desktop :
Send a key to a running process. I tried this (source) :
Dim pp As Process() = Process.GetProcessesByName("explorer")
If pp.Length > 0 Then
For Each p In pp
AppActivate(p.Id)
SendKeys.SendWait("{F5}")
Next
End If
Refresh using SHChangeNotify (source),
Refresh broadcasting a WM_SETTINGCHANGE message (source),
etc.
I think you'll be forced to manually refresh or restart the explorer.