• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

programadorvb6

[VB6] Remover Flash Drives em segurança via código.

1 mensagem neste tópico

Olá a todos.

Venho colocar aqui uma maneira de desactivar Flash Drives via código.

Option Explicit
      Private Declare Function CM_Get_DevNode_Status Lib "setupapi.dll" (lStatus As Long, lProblem As Long, ByVal hDevice As Long, ByVal dwFlags As Long) As Long
  
      Private Declare Function CM_Get_Parent Lib "setupapi.dll" (hParentDevice As Long, ByVal hDevice As Long, ByVal dwFlags As Long) As Long

      Private Declare Function CM_Locate_DevNodeA Lib "setupapi.dll" (hDevice As Long, ByVal lpDeviceName As Long, ByVal dwFlags As Long) As Long

      Private Declare Function CM_Request_Device_EjectA Lib "setupapi.dll" (ByVal hDevice As Long, lVetoType As Long, ByVal lpVetoName As Long, ByVal cbVetoName As Long, ByVal dwFlags As Long) As Long

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

      Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long

      Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, lpcbData As Long) As Long

       

      ' Safely remove USB flash drive

      Public Function SafelyRemove(ByVal pstrDrive As String) As Boolean

          Const DN_REMOVABLE = &H4000
  
          Dim strDeviceInstance As String

          Dim lngDevice As Long
  
          Dim lngStatus As Long

          Dim lngProblem As Long

          Dim lngVetoType As Long

          Dim strVeto As String * 255

         
          pstrDrive = UCase$(Left$(pstrDrive, 1)) & ":"

          strDeviceInstance = StrConv(GetDeviceInstance(pstrDrive), vbFromUnicode)
  
          If CM_Locate_DevNodeA(lngDevice, StrPtr(strDeviceInstance), 0) = 0 Then
  
              If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) = 0 Then
  
                  Do While Not (lngStatus And DN_REMOVABLE) > 0
  
                      If CM_Get_Parent(lngDevice, lngDevice, 0) <> 0 Then Exit Do
  
                      If CM_Get_DevNode_Status(lngStatus, lngProblem, lngDevice, 0) <> 0 Then Exit Do
  
                  Loop
  
                  If (lngStatus And DN_REMOVABLE) > 0 Then SafelyRemove = (CM_Request_Device_EjectA(lngDevice, lngVetoType, StrPtr(strVeto), 255, 0) = 0)
  
              End If
  
          End If
  
      End Function
  
       
  
      Private Function GetDeviceInstance(pstrDrive As String) As String
  
          Const HKEY_LOCAL_MACHINE = &H80000002
  
          Const KEY_QUERY_VALUE = &H1
  
          Const REG_BINARY = &H3
  
          Const ERROR_SUCCESS = 0&
  
          Dim strKey As String
  
          Dim strValue As String
  
          Dim lngHandle As Long
  
          Dim lngType As Long
  
          Dim strBuffer As String
  
          Dim lngLen As Long
  
          Dim bytArray() As Byte
  
         
  
          strKey = "SYSTEM\MountedDevices"
  
          strValue = "\DosDevices\" & pstrDrive
  
          If RegOpenKeyEx(HKEY_LOCAL_MACHINE, strKey, 0&, KEY_QUERY_VALUE, lngHandle) = ERROR_SUCCESS Then
  
              If RegQueryValueEx(lngHandle, strValue, 0&, lngType, 0&, lngLen) = 234 Then
  
                  If lngType = REG_BINARY Then
  
                      strBuffer = Space$(lngLen)
  
                      If RegQueryValueEx(lngHandle, strValue, 0&, 0&, ByVal strBuffer, lngLen) = ERROR_SUCCESS Then
  
                          If lngLen > 0 Then
  
                              ReDim bytArray(lngLen - 1)
  
                              bytArray = Left$(strBuffer, lngLen)
  
                              strBuffer = StrConv(bytArray, vbFromUnicode)
  
                              Erase bytArray
  
                              If Left$(strBuffer, 4) = "\??\" Then
  
                                  strBuffer = Mid$(strBuffer, 5, InStr(1, strBuffer, "{") - 6)
  
                                  GetDeviceInstance = Replace(strBuffer, "#", "\")
  
                              End If
  
                          End If
  
                      End If
  
                  End If
  
              End If
  
              RegCloseKey lngHandle
  
          End If
  
      End Function

Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then Unload Me

End Sub

Private Sub Form_Unload(Cancel As Integer)
    If SafelyRemove("F:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Remover Pen Driver"

    End If

    If SafelyRemove("G:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Remover Pen Driver"

    End If
   
    If SafelyRemove("H:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Notice"

  End If

End Sub

Private Sub Timer1_Timer()
    If SafelyRemove("F:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Remover Pen Driver"

    End If

    If SafelyRemove("G:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Remover Pen Driver"

    End If
   
    If SafelyRemove("H:") Then
    MsgBox "O Pen Driver Já pode ser remolvido com segurança", vbInformation, "Notice"

  End If
Unload Me
End Sub

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora