'Código para el Modulo
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public ReturnCode As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

'Creamos una función en el Modulo, que nos devolvera True si hay una conexión, o False si no la hay
Public Function ActiveConnection() As Boolean
   Dim hKey As Long
   Dim lpSubKey As String
   Dim phkResult As Long
   Dim lpValueName As String
   Dim lpReserved As Long
   Dim lpType As Long
   Dim lpData As Long
   Dim lpcbData As Long
   ActiveConnection = False
   lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
   ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)

   If ReturnCode = ERROR_SUCCESS Then
      hKey = phkResult
      lpValueName = "Remote Connection"
      lpReserved = APINULL
      lpType = APINULL
      lpData = APINULL
      lpcbData = APINULL
      ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
      lpcbData = Len(lpData)
      ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)

      If ReturnCode = ERROR_SUCCESS Then
         If lpData = 0 Then
            ActiveConnection = False
         Else
            ActiveConnection = True
         End If
      End If

      RegCloseKey (hKey)
   End If
End Function

'Codigo para el procedimiento
'Declaramos la variable
CadenaResultante as long

'La CedenaResultante, nos indicara si se esta conectado o no.
CadenaResultante = ActiveConnection()

'Código para el Modulo
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Const APINULL = 0&
Public Const HKEY_LOCAL_MACHINE = &H80000002

'Creamos una función en el Modulo, que nos devolvera True si esta activo, o False si no lo esta
Public Function ActiveMAPI() As Boolean
   Dim hKey As Long
   Dim lpSubKey As String
   Dim phkResult As Long
   Dim lpValueName As String
   Dim lpReserved As Long
   Dim lpType As Long
   Dim lpData As Long
   Dim lpcbData As Long
   ActiveConnection = False
   lpSubKey = "Software\Microsoft\Outlook Express\"
   ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)

   If ReturnCode = ERROR_SUCCESS Then
      hKey = phkResult
      lpValueName = "SMapi"
      lpReserved = APINULL
      lpType = APINULL
      lpData = APINULL
      lpcbData = APINULL
      ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, ByVal lpData, lpcbData)
      lpcbData = Len(lpData)
      ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, lpData, lpcbData)

      If ReturnCode = ERROR_SUCCESS Then
         If lpData = 0 Then
            ActiveMAPI = False
         Else
            ActiveMAPI = True
         End If
      End If

      RegCloseKey (hKey)
   End If
End Function

'Codigo para el procedimiento
'Declaramos la variable
CadenaResultante as long

'La CedenaResultante, nos indicara si se esta activado o no.
CadenaResultante = ActiveConnection()

'Código para el Modulo
'Devuelve el manejador de la barra de menus
Public Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
'Elimina una opcion del menu
Public Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
'Inserta una opcion del menu
Public Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
'redibuja el menu
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Public Const SC_CLOSE = &HF060& 'Botón Cerrar
Public Const SC_MAXIMIZE = &HF030& 'Botón Maximizar
Public Const SC_MINIMIZE = &HF020& 'Botón Minimizar
Public Const SC_MOVE = &HF010& 'Botón Mover
Public Const SC_RESTORE = &HF120& 'Botón Restaurar
Public Const SC_SIZE = &HF000& 'Botón Tamaño
Public Const MF_BYPOSITION = &H400& 'Se utiliza para indicar una posición en vez de una constante. La primera posición es 0.
Public Const MF_BYCOMMAND = &H0& 'Se utiliza con las constantes
Public Const MF_SEPARATOR = &H800& 'Separador

'Para deshabilitar o habilitar otro botón del formulario, cambiar SC_CLOSE

'Función para deshabilitar el botón Cerrar
Public Function DeshabilitarBotonCerrar(Formulario As Form)
   Dim ValorResultante As Long
   Dim ManejadorMenu As Long
   ManejadorMenu = GetSystemMenu(Formulario.hwnd, False)
   ValorResultante = DeleteMenu(ManejadorMenu, SC_CLOSE, MF_BYCOMMAND)
   ValorResultante = DrawMenuBar(Formulario.hwnd)
End Function

'Función para habilitar el botón Cerrar
Public Function HabilitarBotonCerrar(Formulario As Form)
   Dim ValorResultante As Long
   Dim ManejadorMenu As Long
   ManejadorMenu = GetSystemMenu(Formulario.hwnd, False)
   ValorResultante = InsertMenu(ManejadorMenu, 6, MF_BYCOMMAND, SC_CLOSE, "Cerrar")
   ValorResultante = DrawMenuBar(Formulario.hwnd)
End Function

'Codigo para el procedimiento
'Para deshabilitar el botón cerrar del formulario
Call DeshabilitarBotonCerrar(Me)

'Para habilitar el botón cerrar
Call HabilitarBotonCerrar(Me)

Dim x As Double
x = Shell("c:\windows\rundll32.exe shell32.dll,SHFormatDrive", 1)

Dim x As Double
'Muestra información sobre la fuente Arial.
x = Shell("C:\WINDOWS\fontview.exe c:\windows\fonts\Arial.ttf", 1)

Dim x As Double
x = Shell("C:\WINDOWS\cdplayer.exe -play", 1)