| |
با قطعه كد زیر می توان نام درایو فلش مموری را به تابع داد و تابع فلش مموری را Eject میكند.در واقع همان كاری كه ما هنگام خارج كردن فلش مموری از سیستم انجام می دهیم و برق usb را قطع می كنیم.
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
Private Sub Command1_Click()
'~~> Type the Name of the USB Drive
Call SafelyRemove("h:")
' Label1.Caption = "DONE"
End Sub
'~~> Safely remove USB flash drive
Public Function SafelyRemove(ByVal pstrDrive As String) As Boolean
Const DN_REMOVABLE = &H4000
Dim strDeviceInstance As String, lngDevice As Long, lngStatus As Long
Dim lngProblem As Long, lngVetoType As Long, 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, strValue As String, lngHandle As Long
Dim lngType As Long, strBuffer As String, 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
|
|
