Sharing is caring, here's some code I wrote.

Discussion in 'Mixed Languages' started by QuantumBug, Jun 7, 2012.

  1. QuantumBug

    QuantumBug MDL Developer

    Mar 7, 2012
    1,488
    1,328
    60
    #1 QuantumBug, Jun 7, 2012
    Last edited by a moderator: Apr 20, 2017
    Seems it took me a long time to write some of these and the tutorials online are a bit iffy and rubbish, I thought I'd share some of my code with you. If anything looks like it needs changing, or any suggestions, please leave a post :)

    Edit: Added the option for 'Take Ownership' to have an LUA shield and removed some unnessesary code.

    Here is how to add and remove 'Take Ownership' from the Windows context menu. This does exactly the same job as the TakeOwnership.reg that you can aquire online...

    Installing Take Ownership...

    Code:
    
    Imports Microsoft.Win32
    
        Private Sub InstallTakeOwnership(sender As System.Object, e As System.EventArgs) Handles cmd_InstallTakeown.Click
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\*\shell\takeown", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\*\shell\takeown", "", "Take Ownership", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\*\shell\takeown", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\*\shell\takeown", "NoWorkingDirectory", "", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\*\shell\takeown", True).GetValue("HasLUAShield")
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\*\shell\takeown", "HasLUAShield", "", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As InvalidCastException
                'Continue code
            Catch Ex As Exception
                MessageBox.Show(Ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\*\shell\takeown\command", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\*\shell\takeown\command", "", "cmd.exe /c takeown /f ""%1"" && icacls ""%1"" /grant administrators:F", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\*\shell\takeown\command", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\*\shell\takeown\command", "IsolatedCommand", "cmd.exe /c takeown /f ""%1"" && icacls ""%1"" /grant administrators:F", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\Directory\shell\takeown", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\Directory\shell\takeown", "", "Take Ownership", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Coninue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\Directory\shell\takeown", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\Directory\shell\takeown", "NoWorkingDirectory", "", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\Directory\shell\takeown", True).GetValue("HasLUAShield")
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\Directory\shell\takeown", "HasLUAShield", "", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As InvalidCastException
                'Continue code
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\Directory\shell\takeown\command", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\Directory\shell\takeown\command", "", "cmd.exe /c takeown /f ""%1"" /r /d y && icacls ""%1"" /grant administrators:F /t", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
    
            Try
                Dim RegKeyRegedit As Microsoft.Win32.RegistryKey
                RegKeyRegedit = My.Computer.Registry.ClassesRoot.OpenSubKey("\Directory\shell\takeown\command", True)
                If RegKeyRegedit Is Nothing Then
                    My.Computer.Registry.SetValue("HKEY_CLASSES_ROOT\Directory\shell\takeown\command", "IsolatedCommand", "cmd.exe /c takeown /f ""%1"" /r /d y && icacls ""%1"" /grant administrators:F /t", Microsoft.Win32.RegistryValueKind.String)
                Else
                    'Continue code
                End If
    
                MessageBox.Show("'Take Ownership' was added to the Windows context menu.", "Information", _
                                MessageBoxButtons.OK, MessageBoxIcon.Information)
            Catch ex As Exception
                MessageBox.Show(ex.Message)
            End Try
        End Sub
    
    Removing Take Ownership...

    Code:
    
    Imports Microsoft.Win32
    
            Try
                My.Computer.Registry.ClassesRoot.DeleteSubKeyTree("\*\Shell\takeown")
            Catch ex As ArgumentException
                'Your error
            Catch ex As Exception
                'Your error
            End Try
    
            Try
                My.Computer.Registry.ClassesRoot.DeleteSubKeyTree("\Directory\Shell\takeown")
                MessageBox.Show("'Take Ownership' was removed from the Windows context menu.", "Information", _
                                MessageBoxButtons.OK, MessageBoxIcon.Information)
            Catch ex As ArgumentException
                MessageBox.Show("'Take Ownership' is already disabled.", "Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
            Catch ex As Exception
                'Your error
            End Try
        End Sub
    
    The biggest problem that occured when coding the take ownership was writing to the (Default) registry key, but this key can be accessed by using "" double quotes. If you try writing the key using (Default) it will just create a dud key.
    ------

    Here is how to read full WEI(Windows Experience index) scores and tell the last assessment time and date.

    Read WEI Scores...

    Code:
    
    Imports System.XML
    
            'This code can go into the form load event, button, etc.
            
            Try
                Dim document As New XmlDocument
                Dim file As New IO.DirectoryInfo("C:\WINDOWS\Performance\WinSAT\DataStore")
                Dim filedir() As IO.FileInfo
                Dim fmst As IO.FileInfo
                Dim accesstime As Date
                Dim lastaccesspath As String
                filedir = file.GetFiles
    
                For Each fmst In filedir
                    If fmst.LastAccessTime >= accesstime Then
                        accesstime = fmst.LastAccessTime
                        lastaccesspath = fmst.FullName
                    End If
                Next
    
                'Anything with 'lb' in front  of it is a label, but you can use a textbox, richtextbox or anything  else you like that holds a text property
                 document.Load(lastaccesspath)
                Dim elementsByTagName As XmlNodeList = document.GetElementsByTagName("WinSPR")
                Dim basescore As String = elementsByTagName.ItemOf(0).FirstChild.InnerXml
                lbbasescore.Text = basescore.ToString
                Dim cpuscore As String = elementsByTagName.ItemOf(0).Item("CpuScore").InnerText
                lbprocessorscore.Text = cpuscore.ToString
                Dim memoryscore As String = elementsByTagName.ItemOf(0).Item("MemoryScore").InnerText
                lbmemoryscore.Text = memoryscore.ToString
                Dim graphicsscore As String = elementsByTagName.ItemOf(0).Item("GraphicsScore").InnerText
                lbgraphicsscore.Text = graphicsscore.ToString
                Dim gaminggraphicsscore As String = elementsByTagName(0).Item("GamingScore").InnerText
                lbgamingscore.Text = gaminggraphicsscore.ToString
                Dim diskscore As String = elementsByTagName(0).Item("DiskScore").InnerText
                lbdiskscore.Text = diskscore.ToString
                lbunrated.Text = "Last rating: " + accesstime
            Catch ex As Exception
                MessageBox.Show("An error occured when processing WEI scores", "Error", MessageBoxButtons.Ok, MessageBoxIcon.Error)
            End Try
    
    This was relatively easy to write, the one I found online only read the base score which is determined by your lowest rated component.

    How I execute code depending on OS architecture and build.

    The below code is compatible for Windows Vista and 7, but it's easy to add support for Windows XP etc. Also the code can be used almost anywhere for example, a button click, form load event or even a sub that's called from a certain event.

    Code:
            Select Case IntPtr.Size
                Case "4" '32-Bit
                    Select Case Environment.OSVersion.Version.Build
    
                        Case "6000"
                            MessageBox.Show("Window build 6000 x86", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "6001"
                            MessageBox.Show("Window build 6001 x86", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "6002"
                            MessageBox.Show("Window build 6002 x86", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "7600"
                            MessageBox.Show("Window build 7600 x86", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "7601"
                            MessageBox.Show("Window build 7601 x86", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    End Select
    
                Case "8" '64-Bit
                    Select Case Environment.OSVersion.Version.Build
    
                        Case "6000"
                            MessageBox.Show("Window build 6000 x64", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "6001"
                            MessageBox.Show("Window build 6001 x64", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "6002"
                            MessageBox.Show("Window build 6002 x64", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "7600"
                            MessageBox.Show("Window build 7600 x64", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                        Case "7601"
                            MessageBox.Show("Window build 7601 x64", "Info", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    End Select
            End Select
    

    Example of IntPtr.Size for detecting os architecture:


    Code:
    
            'Getting os architecture via IntPtr.Size
            Select Case IntPtr.Size
                Case "4" '32-bit
                    Me.Text = "My application (32-Bit)"
                Case "8" '64-Bit
                    Me.Text = "My application (64-Bit)"
                Case Else
                    Me.Text = My application
            End Select
    
    
    If you need any help at all using this code, feel free to ask!

    Enjoy :D
     
    Stop hovering to collapse... Click to collapse... Hover to expand... Click to expand...
  2. master131

    master131 MDL Novice

    Apr 12, 2011
    45
    22
    0
    I'm not sure why exactly you put the Is Nothing check there, you seem to be doing the same thing anyway... You can also simply each chunk by creating another sub to create more efficient code. Just pointing out how you can make it better if you don't know how to already.

    Anyway, nice job. ;)
     
  3. QuantumBug

    QuantumBug MDL Developer

    Mar 7, 2012
    1,488
    1,328
    60
    #3 QuantumBug, Jun 13, 2012
    Last edited: Jun 13, 2012
    (OP)
    I know it's written a bit silly, I have changed it now but have yet to correct it on here. Also have some additions.

    Thanks, Dave :)

    Edit: The code should look and work better now.
     
    Stop hovering to collapse... Click to collapse... Hover to expand... Click to expand...
  4. QuantumBug

    QuantumBug MDL Developer

    Mar 7, 2012
    1,488
    1,328
    60
    Edit: added some more code to learn from.
     
    Stop hovering to collapse... Click to collapse... Hover to expand... Click to expand...
  5. petok

    petok MDL Member

    May 4, 2009
    183
    58
    10
    This codes is good but please write more code in VB.NET if you have. Thanks
     
  6. QuantumBug

    QuantumBug MDL Developer

    Mar 7, 2012
    1,488
    1,328
    60
    This code is all VB.NET... :)
     
    Stop hovering to collapse... Click to collapse... Hover to expand... Click to expand...