Click here to Skip to main content
13,768,884 members
Click here to Skip to main content

Stats

12.4K views
696 downloads
12 bookmarked
Posted 15 Apr 2012
Licenced CPOL

VB.NET wrappers for much of the Windows API

, 15 Apr 2012
Includes most API functions except for graphics.
UtilitiesLib
bin
Debug
sclib.dll
sclib.pdb
Release
sclib.dll
sclib.pdb
My Project
Application.myapp
vssver2.scc
obj
Debug
DesignTimeResolveAssemblyReferencesInput.cache
Salience.Library.Resources.resources
sclib.dll
sclib.pdb
TempPE
My Project.Resources.Designer.vb.dll
UtilitiesLib.vbproj.GenerateResource.Cache
Release
DesignTimeResolveAssemblyReferencesInput.cache
GenerateResource-ResGen.read.1.tlog
GenerateResource-ResGen.write.1.tlog
Salience.Library.Resources.resources
sclib.dll
sclib.pdb
TempPE
My Project.Resources.Designer.vb.dll
UtilitiesLib.suo
Imports System
Imports System.IO
Imports System.Text
Imports System.Management
Imports System.Environment
Imports Microsoft.Win32
Imports System.Threading
Imports System.Security.Principal
Imports System.Security.AccessControl
Imports System.ComponentModel
Imports System.Runtime.InteropServices
Imports System.Security

Public Class Profile

    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
    Public Structure PROFILEINFO
        Public dwSize As Integer
        Public dwFlags As Integer
        Public lpUserName As String
        Public lpProfilePath As String
        Public lpDefaultPath As String
        Public lpServerName As String
        Public lpPolicyPath As String
        Public hProfile As Integer
    End Structure

    <DllImport("userenv.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
    Private Shared Function LoadUserProfile( _
        ByVal hUserToken As IntPtr, _
        ByRef lpProfileInfo As PROFILEINFO) As Integer
    End Function

    <DllImport("userenv.dll", SetLastError:=True, CharSet:=CharSet.Unicode)> _
    Private Shared Function UnloadUserProfile( _
        ByVal hUserToken As IntPtr, _
        ByVal hProfile As IntPtr) As Integer
    End Function

    Public Sub New()
    End Sub

    Public Shared Function CreateUserProfile(ByVal username As String, ByVal password As String) As String
        Dim token As IntPtr = IntPtr.Zero
        Dim result As Integer
        Dim profilePath As String

        Try
            token = KernelApi.LogonUser(username, password, KernelApi.LogonType.LOGON32_LOGON_NETWORK)

            'if this key exists, LoadUserProfile renames it to bak.  so delete it first
            DeleteProfileListRegistryKey(Utilities.GetSidForUser(username))

            Dim pi As New PROFILEINFO()
            pi.lpUserName = username
            pi.dwSize = Marshal.SizeOf(GetType(PROFILEINFO))

            result = LoadUserProfile(token, pi)
            If result = 0 Then
                Throw New Win32Exception(Marshal.GetLastWin32Error())
            End If

            result = UnloadUserProfile(token, CType(pi.hProfile, IntPtr))
            If result = 0 Then
                Throw New Win32Exception(Marshal.GetLastWin32Error())
            End If

            profilePath = Utilities.ReadProfilePath(username)
            Return profilePath
        Finally
            If token <> IntPtr.Zero Then
                KernelApi.CloseHandle(token)
            End If
        End Try
    End Function


    Private Shared Sub UpdateCredentialFolders(ByVal profilePath As String, ByVal sid As SecurityIdentifier)
        Dim name As String
        Dim info As DirectoryInfo
        Dim dirs() As DirectoryInfo

        If Utilities.IsVista() Then
            name = "AppData\Roaming\Microsoft\Protect"
            info = New DirectoryInfo(Path.Combine(profilePath, name))
            If info.Exists Then
                dirs = info.GetDirectories("S-1-5*")
                If dirs.Length > 0 Then
                    dirs(dirs.Length - 1).MoveTo(Path.Combine(info.FullName, sid.Value))
                End If
            End If
        Else
            name = "Application Data\Microsoft\Protect"
            info = New DirectoryInfo(Path.Combine(profilePath, name))
            If info.Exists Then
                dirs = info.GetDirectories("S-1-5*")
                If dirs.Length > 0 Then
                    dirs(dirs.Length - 1).MoveTo(Path.Combine(info.FullName, sid.Value))
                End If
            End If

            name = "Application Data\Microsoft\Credentials"
            info = New DirectoryInfo(Path.Combine(profilePath, name))
            If info.Exists Then
                dirs = info.GetDirectories("S-1-5*")
                If dirs.Length > 0 Then
                    dirs(dirs.Length - 1).MoveTo(Path.Combine(info.FullName, sid.Value))
                End If
            End If

            name = "Local Settings\Application Data\Microsoft\Credentials"
            info = New DirectoryInfo(Path.Combine(profilePath, name))
            If info.Exists Then
                dirs = info.GetDirectories("S-1-5*")
                If dirs.Length > 0 Then
                    dirs(dirs.Length - 1).MoveTo(Path.Combine(info.FullName, sid.Value))
                End If
            End If
        End If
    End Sub

    Public Shared Function OpenUserHive(ByVal keyname As String, ByVal profilePath As String, ByRef unloadHive As Boolean) As RegistryKey
        unloadHive = False
        Dim key As RegistryKey = Registry.Users.OpenSubKey(keyname, True)
        If key Is Nothing Then
            'not loaded, so load from file
            Dim regFile As String = profilePath + "\NTUSER.DAT"
            If Not File.Exists(regFile) Then
                Logger.WriteEntry("Error loading user's hive.  File not found: " + profilePath, EventLogEntryType.Error)
                Throw New ArgumentException("User's registry hive not found: " + profilePath)
            End If

            KernelApi.AddPrivilege(KernelApi.SE_BACKUP_NAME)
            KernelApi.AddPrivilege(KernelApi.SE_RESTORE_NAME)
            Dim result As Integer
            result = AclApi.RegLoadKey(AclApi.Hives.HKEY_USERS, keyname, profilePath + "\NTUSER.DAT")
            If result <> 0 Then
                Logger.WriteEntry("Error loading user's hive: " + CStr(Marshal.GetLastWin32Error()), EventLogEntryType.Error)
                Throw New Exception("Unable to load the user's registry hive.  Please reboot and try again.")
            End If
            unloadHive = True
            key = Registry.Users.OpenSubKey(keyname, True)
        End If
        Return key
    End Function

    Public Shared Sub CloseUserHive(ByVal keyname As String)
        Dim result As Integer
        result = AclApi.RegUnLoadKey(AclApi.Hives.HKEY_USERS, keyname)
        If result <> 0 Then
            Logger.WriteEntry("Error unloading user's hive: " + CStr(result), EventLogEntryType.Error)
        End If
    End Sub

    Public Shared Function GetOpenUserHiveByUsername(ByVal username As String) As String
        For Each keyName As String In Registry.Users.GetSubKeyNames()
            Using key As RegistryKey = Registry.Users.OpenSubKey(keyName + "\Volatile Environment")
                If key IsNot Nothing Then
                    Dim value As Object
                    value = key.GetValue("USERNAME")
                    If value IsNot Nothing Then
                        If CStr(value).ToLower() = username.ToLower() Then
                            Return keyName
                        End If
                    End If
                    value = key.GetValue("HOMEPATH")
                    If value IsNot Nothing Then
                        If CStr(value).ToLower().Contains(username.ToLower()) Then
                            Return keyName
                        End If
                    End If
                End If
            End Using
        Next
        Return Nothing
    End Function

    'Public Shared Sub CloseUserHive(ByVal username As String)
    '    'attempt to unload the hive when the username/sid is mismatched
    '    Dim keyName As String = GetOpenUserHiveByUsername(username)
    '    If String.IsNullOrEmpty(keyName) Then
    '        Exit Sub
    '    End If
    '    KernelApi.AddPrivilege(KernelApi.SE_RESTORE_NAME)
    '    KernelApi.AddPrivilege(KernelApi.SE_BACKUP_NAME)
    '    Dim result As Integer
    '    result = AclApi.RegUnLoadKey(AclApi.HKEY_USERS, keyName)
    '    If result = 0 Then
    '        'success
    '    ElseIf result = 1314 Then
    '        Throw New PrivilegeNotHeldException("SE_RESTORE_NAME and SE_BACKUP_NAME are required")
    '    Else
    '        Throw New Win32Exception(Marshal.GetLastWin32Error())
    '    End If
    '    keyName += "_Classes"
    '    For Each name As String In Registry.Users.GetSubKeyNames()
    '        If name = keyName Then
    '            result = AclApi.RegUnLoadKey(AclApi.HKEY_USERS, keyName)
    '            If result <> 0 Then
    '                Throw New AccessViolationException("Unable to load the hive: " + keyName)
    '            End If
    '        End If
    '    Next
    'End Sub

    Private Shared Sub SetProfileRegistryPermissions(ByVal profilePath As String, ByVal sid As SecurityIdentifier)
        Logger.WriteEntry("Restoring registry permissions")

        Dim key As RegistryKey = Nothing
        Dim unloadHive As Boolean
        Try
            key = OpenUserHive(sid.Value, profilePath, unloadHive)
            If key Is Nothing Then
                Throw New Exception("An error occurred while loading the user's registry.  Please reboot and try again.")
            End If

            AclApi.SetFullControl(key, sid, True)
            AclApi.SetFullControl(key, "Software\Policies", sid, True)
            AclApi.SetFullControl(key, "Software\Microsoft\Windows\CurrentVersion\Policies", sid, True)
            AclApi.SetFullControl(key, "Software\Microsoft\Windows\CurrentVersion\Group Policy", sid, True)
            AclApi.SetFullControl(key, "Software\Microsoft\Windows\CurrentVersion\Group Policy\GroupMembership", sid, True)

            If Utilities.IsVista() Then
                AclApi.SetFullControl(key, "Software\Microsoft\Internet Explorer\Toolbar\WebBrowser", sid, True)
                AclApi.SetFullControl(key, "Software\Microsoft\Internet Explorer\LowRegistry\DontShowMeThisDialogAgain", sid, True)
                AclApi.SetFullControl(key, "Software\Microsoft\EventSystem", sid, True)
                AclApi.SetFullControl(key, "Software\Microsoft\EventSystem\{26c409cc-ae86-11d1-b616-00805fc79216}", sid, True)
            End If
        Finally
            If key IsNot Nothing Then
                key.Close()
                key = Nothing
            End If
            If unloadHive Then
                CloseUserHive(sid.Value)
            End If
        End Try
    End Sub

    Public Shared Sub DeleteProfileListRegistryKey(ByVal sid As SecurityIdentifier)
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_ProfileList, True)
            If key Is Nothing Then
                Throw New Exception("Registry key not found: " + RegConstants.Key_ProfileList)
            End If
            For Each subKeyName As String In key.GetSubKeyNames()
                If subKeyName Like sid.Value + "*" Then
                    key.DeleteSubKeyTree(subKeyName)
                End If
            Next
        End Using
    End Sub

    Public Shared Sub GroupPolicyDisableForceUnload()
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_GP_System, True)
            If key IsNot Nothing Then
                key.DeleteValue("DisableForceUnload", False)
            End If
        End Using
    End Sub

    Private Shared Function GetProfileState(ByVal sid As SecurityIdentifier) As Integer
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_ProfileList + "\" + sid.Value, False)
            If key IsNot Nothing Then
                Dim val As Object = key.GetValue("State")
                If val IsNot Nothing AndAlso IsNumeric(val) Then
                    Return CInt(val)
                End If
            End If
            Return 0
        End Using
    End Function

    'Hex Mask   State
    '0001       Profile is mandatory.
    '0002       Update the locally cached profile.
    '0004       New local profile.
    '0008       New central profile.
    '0010       Update the central profile.
    '0020       Delete the cached profile.
    '0040       Upgrade the profile.
    '0080       Using Guest user profile.
    '0100       Using Administrator profile.
    '0200       Default net profile is available and ready.
    '0400       Slow network link identified.
    '0800       Temporary profile loaded.

    Private Shared Sub DeleteRegistryValues(ByVal keyName As String, ByVal searchString As String)
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(keyName, True)
            If key IsNot Nothing Then
                For Each name As String In key.GetValueNames()
                    If CStr(key.GetValue(name)).ToUpper().Contains(searchString.ToUpper()) Then
                        key.DeleteValue(name)
                    End If
                Next
            End If
        End Using

        Using key As RegistryKey = Utilities.RegistryCurrentUserOpenSubKey(keyName, True)
            If key IsNot Nothing Then
                For Each name As String In key.GetValueNames()
                    If CStr(key.GetValue(name)).ToUpper().Contains(searchString.ToUpper()) Then
                        key.DeleteValue(name)
                    End If
                Next
            End If
        End Using
    End Sub

    Private Shared Sub DeleteGroupPolicyKeys(ByVal sid As SecurityIdentifier)
        'Group Policy
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_GroupPolicy, True)
            If key IsNot Nothing Then
                For Each subKeyName As String In key.GetSubKeyNames()
                    If subKeyName = sid.Value Then
                        key.DeleteSubKeyTree(sid.Value)
                        Exit For
                    End If
                Next
            End If
        End Using

        'Group Policy State
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_GroupPolicy + "\State", True)
            If key IsNot Nothing Then
                For Each subKeyName As String In key.GetSubKeyNames()
                    If subKeyName = sid.Value Then
                        key.DeleteSubKeyTree(sid.Value)
                        Exit For
                    End If
                Next
            End If
        End Using

        'Group Policy Status
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_GroupPolicy + "\Status", True)
            If key IsNot Nothing Then
                For Each subKeyName As String In key.GetSubKeyNames()
                    If subKeyName = sid.Value Then
                        key.DeleteSubKeyTree(sid.Value)
                        Exit For
                    End If
                Next
            End If
        End Using
    End Sub

    Private Shared Sub ClearLastLogonValues(ByVal username As String)
        Using key As RegistryKey = Registry.LocalMachine.OpenSubKey(RegConstants.Key_Winlogon, True)
            If key Is Nothing Then Exit Sub

            Dim value As String
            value = CStr(key.GetValue("DefaultUserName"))
            If Not String.IsNullOrEmpty(value) AndAlso value.Contains(username) Then
                key.SetValue("DefaultUserName", "")
            End If
            value = CStr(key.GetValue("AltDefaultUserName"))
            If Not String.IsNullOrEmpty(value) AndAlso value.Contains(username) Then
                key.SetValue("AltDefaultUserName", "")
            End If
        End Using
    End Sub

    Private Shared Sub DeleteUserFiles(ByVal username As String)
        Dim info As FileInfo
        Dim path As String
        path = Environment.GetFolderPath(SpecialFolder.CommonApplicationData)
        path += "\Microsoft\User Account Pictures"

        info = New FileInfo(path + "\" + username + ".dat")
        If info.Exists() Then info.Delete()

        info = New FileInfo(path + "\" + username + ".bmp")
        If info.Exists() Then info.Delete()

    End Sub

    Public Shared Sub ConfigureProfile(ByVal profilePath As String, ByVal username As String)
        Dim key As RegistryKey = Nothing
        Dim unloadHive As Boolean
        Dim keyName As String
        Try
            key = OpenUserHive(username, profilePath, unloadHive)
            If key Is Nothing Then
                Throw New Exception("An error occurred while loading the user's registry.  Please reboot and try again.")
            End If

            'save the username with the profile
            Using subKey As RegistryKey = key.CreateSubKey("Volatile Environment")
                subKey.SetValue("USERNAME", username)
            End Using

            'disable the phishing dialog
            keyName = "Software\Microsoft\Internet Explorer\PhishingFilter"
            Using subKey As RegistryKey = key.CreateSubKey(keyName)
                subKey.SetValue("Enabled", 0, RegistryValueKind.DWord)
                subKey.SetValue("ShownVerifyBalloon", 3, RegistryValueKind.DWord)
            End Using

            'disable welcome center
            keyName = "Software\Microsoft\Windows\CurrentVersion\Run"
            Using subKey As RegistryKey = key.OpenSubKey(keyName, True)
                If subKey IsNot Nothing Then
                    subKey.DeleteValue("WindowsWelcomeCenter", False)
                    subKey.DeleteValue("Sidebar", False)
                End If
            End Using

            'disable IE information bar notification
            keyName = "Software\Microsoft\Internet Explorer\InformationBar"
            Using subKey As RegistryKey = key.OpenSubKey(keyName, True)
                If subKey IsNot Nothing Then
                    subKey.SetValue("FirstTime", 0, RegistryValueKind.DWord)
                End If
            End Using

            'set wallpaper
            keyName = "Control Panel\Desktop"
            Using subKey As RegistryKey = key.OpenSubKey(keyName, True)
                If subKey IsNot Nothing Then
                    subKey.SetValue("WallpaperStyle", 2, RegistryValueKind.ExpandString)
                    subKey.SetValue("WallpaperOriginX", 0, RegistryValueKind.DWord)
                    subKey.SetValue("WallpaperOriginY", 0, RegistryValueKind.DWord)
                End If
            End Using

            KernelApi.AddPrivilege(KernelApi.SE_SECURITY_PRIVILEGE)

            Dim p As New Process
            p.StartInfo.FileName = Utilities.GetActualSystemPath("Subinacl.exe", False)
            p.StartInfo.UseShellExecute = False
            p.StartInfo.CreateNoWindow = True
            p.StartInfo.Arguments = _
                "/verbose /subkeyreg ""HKEY_LOCAL_MACHINE\Software\Microsoft\Security Center\Svc"" /grant=BUILTIN\Administrators=F"
            p.Start()
            p.WaitForExit()
            If p.ExitCode = 0 Then
                keyName = "Software\Microsoft\Security Center\Svc\"
                keyName += Utilities.GetSidForUser(username).Value
                Using subKey As RegistryKey = Registry.LocalMachine.CreateSubKey(keyName)
                    subKey.SetValue("EnableNotifications", 0, RegistryValueKind.DWord)
                    subKey.SetValue("EnableNotificationsRef", 1, RegistryValueKind.DWord)
                End Using
            End If
        Finally
            If key IsNot Nothing Then
                key.Close()
                key = Nothing
            End If
            If unloadHive Then
                CloseUserHive(username)
            End If
        End Try
    End Sub

    Public Shared Function GetDesktopFolder(ByVal sid As SecurityIdentifier) As String

        Dim desktopPath As String

        'if looking up the current user, use .NET
        If sid.Value = System.Security.Principal.WindowsIdentity.GetCurrent().Owner.Value Then
            desktopPath = Environment.GetFolderPath(SpecialFolder.DesktopDirectory)
            If desktopPath <> "" AndAlso Directory.Exists(desktopPath) Then
                Return desktopPath
            End If
        End If

        'build the path manually
        Dim profilePath As String = Utilities.ReadProfilePath(sid)
        desktopPath = Path.Combine(profilePath, "Desktop")
        If Directory.Exists(desktopPath) Then
            Return desktopPath
        End If

        'open his registry and read it
        desktopPath = Utilities.GetSpecialFolder(sid, "Desktop")
        If Directory.Exists(desktopPath) Then
            Return desktopPath
        End If
        Throw New DirectoryNotFoundException("Unable to find Desktop folder for: " + Utilities.GetUserName(sid))
    End Function

    Public Shared Function GetFavoritesFolder(ByVal sid As SecurityIdentifier) As String

        Dim favoritesPath As String

        'if looking up the current user, use .NET
        If sid.Value = System.Security.Principal.WindowsIdentity.GetCurrent().Owner.Value Then
            favoritesPath = Environment.GetFolderPath(SpecialFolder.Favorites)
            If favoritesPath <> "" AndAlso Directory.Exists(favoritesPath) Then
                Return favoritesPath
            End If
        End If

        'build the path manually
        Dim profilePath As String = Utilities.ReadProfilePath(sid)
        favoritesPath = Path.Combine(profilePath, "Favorites")
        If Directory.Exists(favoritesPath) Then
            Return favoritesPath
        End If

        'open his registry and read it
        favoritesPath = Utilities.GetSpecialFolder(sid, "Favorites")
        If Directory.Exists(favoritesPath) Then
            Return favoritesPath
        End If
        Throw New DirectoryNotFoundException("Unable to find Favorites folder for: " + Utilities.GetUserName(sid))
    End Function

    Public Shared Function GetStartMenuFolder(ByVal sid As SecurityIdentifier) As String

        Dim startMenuPath As String

        'if looking up the current user, use .NET
        If sid.Value = System.Security.Principal.WindowsIdentity.GetCurrent().Owner.Value Then
            startMenuPath = Environment.GetFolderPath(SpecialFolder.StartMenu)
            If startMenuPath <> "" AndAlso Directory.Exists(startMenuPath) Then
                Return startMenuPath
            End If
        End If

        'build the path manually
        Dim profilePath As String = Utilities.ReadProfilePath(sid)
        If Utilities.IsVista() Then
            startMenuPath = Path.Combine(profilePath, "AppData\Roaming\Microsoft\Windows\Start Menu")
        Else
            startMenuPath = Path.Combine(profilePath, "Start Menu")
        End If
        If Directory.Exists(startMenuPath) Then
            Return startMenuPath
        End If

        'open his registry and read it
        startMenuPath = Utilities.GetSpecialFolder(sid, "Start Menu")
        If Directory.Exists(startMenuPath) Then
            Return startMenuPath
        End If
        Throw New DirectoryNotFoundException("Unable to find Desktop folder for: " + Utilities.GetUserName(sid))
    End Function
End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

andrewbb@gmail.com
Architect
United States United States
No Biography provided

You may also be interested in...

Permalink | Advertise | Privacy | Cookies | Terms of Use | Mobile
Web01-2016 | 2.8.181117.1 | Last Updated 15 Apr 2012
Article Copyright 2012 by andrewbb@gmail.com
Everything else Copyright © CodeProject, 1999-2018
Layout: fixed | fluid