Option Explicit

Public Sub Main()

    Call RemoveShares
    Call RefreshShell
    MsgBox "Shares Removed"
    
    'Call RestoreShares
    'Call RefreshShell
    'MsgBox "Shares Restored"
    
End Sub

Option Explicit

'declare sharing class
Private oShare As cSharing

'A: File and Printer Sharing
'B: Shared Documents from My Computer
'C: Automatic Hidden Shares

'remove sharing
Public Sub RemoveShares()
    Set oShare = New cSharing
        oShare.FileSharing = False             '.A
        oShare.SharedDocuments = False         '.B
        oShare.HiddenShares = False            '.C
    Set oShare = Nothing
End Sub

'restore sharing
Public Sub RestoreShares()
    Set oShare = New cSharing
        oShare.FileSharing = True             '.A
        oShare.SharedDocuments = True         '.B
        oShare.HiddenShares = True            '.C
    Set oShare = Nothing
End Sub

'terminate explorer shell
'should restart by itself
Public Sub RefreshShell()
    Dim Process As Object
    For Each Process In GetObject("winmgmts:").ExecQuery("Select Name from Win32_Process Where Name = 'explorer.exe'")
        Process.Terminate ' terminate explorer.exe process
    Next Process
    Call Delay_Timer(3) ' wait 3 seconds
End Sub

'terminate then restart explorer shell
'alternative to RefreshShell
Public Sub RestartShell()
    Call RefreshShell
    Shell "explorer.exe"
End Sub

'delay timer for refresh
Private Function Delay_Timer(nSeconds)
    Dim nStoptime As Single
    nStoptime = Timer + nSeconds
    Do While Timer <= nStoptime: DoEvents: Loop
End Function

Option Explicit

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long

Public Enum RegType
    REG_SZ = 1
    REG_EXPAND_SZ = 2
    REG_BINARY = 3
    REG_DWORD = 4
    REG_DWORD_LE = 4
    REG_DWORD_BE = 5
End Enum

Public Enum RegHive
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum
  
' FILE AND PRINT SHARING
Public Property Let FileSharing(ByVal inNew As Boolean)
    If inNew Then
        SaveReg HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Network", "NoFileSharing", 0, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Network", "NoPrintSharing", 0, REG_DWORD
    Else
        SaveReg HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Network", "NoFileSharing", 1, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Network", "NoPrintSharing", 1, REG_DWORD
    End If
End Property

' SHARED DOCS ON MY COMPUTER
Public Property Let SharedDocuments(ByVal inNew As Boolean)
    If inNew Then
        SaveReg HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSharedDocuments", 0, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSharedDocuments", 0, REG_DWORD
    Else
        SaveReg HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSharedDocuments", 1, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", "NoSharedDocuments", 1, REG_DWORD
    End If
End Property

' HIDDEN SHARES
Public Property Let HiddenShares(ByVal inNew As Boolean)
    If inNew Then
        SaveReg HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\LanmanServer\Parameters", "AutoShareServer", 1, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\LanmanServer\Parameters", "AutoShareWks", 1, REG_DWORD
    Else
        SaveReg HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\LanmanServer\Parameters", "AutoShareServer", 0, REG_DWORD
        SaveReg HKEY_LOCAL_MACHINE, "System\CurrentControlSet\Services\LanmanServer\Parameters", "AutoShareWks", 0, REG_DWORD
    End If
End Property

' SAVE / UPDATE REGISTRY VALUE
Private Function SaveReg(ByVal pKey As RegHive, ByVal pKeyName As String, ByVal pValue As String, ByVal pData As Variant, ByVal pType As RegType) As Boolean
    Dim keyhand As Long
    Dim lResult As Long
    Dim ordType As Long
    Dim c       As Long
On Error GoTo Error_Handler
    lResult = RegCreateKey(pKey, pKeyName, keyhand)
    If lResult Then 'error
        SaveReg = False
    Else
        Select Case pType
            Case REG_BINARY
                If (VarType(pData) = vbArray + vbByte) Then
                    Dim ab() As Byte
                    ab = pData
                    c = UBound(ab) - LBound(ab) + 1
                    lResult = RegSetValueExByte(keyhand, pValue, 0&, pType, ab(0), c)
                End If
            Case REG_DWORD, REG_DWORD_BE, REG_DWORD_LE
                If (VarType(pData) = vbInteger) Or (VarType(pData) = vbLong) Then
                    Dim i As Long
                    i = pData
                    ordType = REG_DWORD
                    lResult = RegSetValueExLong(keyhand, pValue, 0&, ordType, i, 4)
                End If
            Case REG_SZ, REG_EXPAND_SZ
                Dim s As String, iPos As Long
                s = pData
                ordType = REG_SZ
                iPos = InStr(s, "%")
                If iPos Then
                    If InStr(iPos + 2, s, "%") Then ordType = REG_EXPAND_SZ
                End If
                c = Len(s) + 1
                s = s & vbNullChar
                lResult = RegSetValueExString(keyhand, pValue, 0&, ordType, s, c)
        End Select
        RegCloseKey keyhand
        If lResult Then 'error
            SaveReg = False
        Else
            SaveReg = True
        End If
    End If
    Exit Function
Error_Handler:
    SaveReg = False
End Function