Eject كردن USB

[shahram_g]

سلام.
چطوري ميتونم با استفاده از كد ،فلاش يا كول ديسكي كه به كامپيوتر وصل هست رو Eject كنم؟

مرسي

[shahram_g]

خودم پيدا كرم براي استفاده دوستان قرار ميدم:

Option Explicit
Dim boTimeOut As Boolean

Private Const DRIVE_CDROM As Long = 5
Private Const DRIVE_REMOVABLE As Long = 2

Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000

Private Const OPEN_EXISTING As Long = 3
Private Const FILE_DEVICE_FILE_SYSTEM As Long = 9
Private Const FILE_DEVICE_MASS_STORAGE As Long = &H2D&
Private Const METHOD_BUFFERED As Long = 0
Private Const FILE_ANY_ACCESS As Long = 0
Private Const FILE_READ_ACCESS As Long = 1
Private Const LOCK_VOLUME As Long = 6
Private Const DISMOUNT_VOLUME As Long = 8
Private Const EJECT_MEDIA As Long = &H202
Private Const MEDIA_REMOVAL As Long = &H201
Private Const INVALID_HANDLE_VALUE As Long = -1

Private Const LOCK_TIMEOUT As Long = 1000
Private Const LOCK_RETRIES As Long = 20

Private Declare Function GetDriveType Lib "kernel32.dll" _
Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long

Private Declare Function CloseHandle Lib "kernel32.dll" _
(ByVal hObject As Long) As Long

Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByRef lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As Long

Private Declare Function DeviceIoControl Lib "kernel32.dll" _
(ByVal hDevice As Long, _
ByRef dwIoControlCode As Long, _
ByRef lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
ByRef lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
ByRef lpBytesReturned As Long, _
ByRef lpOverlapped As Long) As Long
Private Function CTL_CODE(lngDevFileSys As Long, lngFunction As Long, _
lngMethod As Long, lngAccess As Long) As Long
CTL_CODE = (lngDevFileSys * (2 ^ 16)) Or (lngAccess * (2 ^ 14)) Or (lngFunction * (2 ^ 2)) Or lngMethod
End Function

Private Function OpenVolume(strLetter As String, lngVolHandle As Long) As Boolean
Dim lngDriveType As Long
Dim lngAccessFlags As Long
Dim strVolume As String
lngDriveType = GetDriveType(strLetter)
Select Case lngDriveType
Case DRIVE_REMOVABLE
lngAccessFlags = GENERIC_READ Or GENERIC_WRITE
Case DRIVE_CDROM
lngAccessFlags = GENERIC_READ
Case Else
OpenVolume = False
Exit Function
End Select
strVolume = "\\.\" & strLetter
lngVolHandle = CreateFile(strVolume, lngAccessFlags, 0, _
ByVal CLng(0), OPEN_EXISTING, ByVal CLng(0), ByVal CLng(0))
If lngVolHandle = INVALID_HANDLE_VALUE Then
OpenVolume = False
Exit Function
End If
OpenVolume = True
End Function

Private Function CloseVolume(lngVolHandle As Long) As Boolean
Dim lngReturn As Long
lngReturn = CloseHandle(lngVolHandle)
If lngReturn = 0 Then
CloseVolume = False
Else
CloseVolume = True
End If
End Function

Private Function LockVolume(ByRef lngVolHandle As Long) As Boolean
Dim lngBytesReturned As Long
Dim intCount As Integer
Dim intI As Integer
Dim boLocked As Boolean
Dim lngFunction As Long
lngFunction = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, LOCK_VOLUME, METHOD_BUFFERED, FILE_ANY_ACCESS)
intCount = LOCK_TIMEOUT / LOCK_RETRIES
boLocked = False
For intI = 0 To LOCK_RETRIES
boTimeOut = False
Timer1.Interval = intCount
Timer1.Enabled = True
Do Until boTimeOut = True Or boLocked = True
boLocked = DeviceIoControl(lngVolHandle, ByVal lngFunction, _
CLng(0), 0, CLng(0), 0, lngBytesReturned, ByVal CLng(0))
DoEvents
Loop
If boLocked = True Then
LockVolume = True
Timer1.Enabled = False
Exit Function
End If
Next intI
LockVolume = False
End Function
Private Function DismountVolume(lngVolHandle As Long) As Boolean
Dim lngBytesReturned As Long
Dim lngFunction As Long
lngFunction = CTL_CODE(FILE_DEVICE_FILE_SYSTEM, DISMOUNT_VOLUME, METHOD_BUFFERED, FILE_ANY_ACCESS)
DismountVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, _
0, 0, 0, 0, lngBytesReturned, ByVal 0)
End Function
Private Function PreventRemovalofVolume(lngVolHandle As Long) As Boolean
Dim boPreventRemoval As Boolean
Dim lngBytesReturned As Long
Dim lngFunction As Long
boPreventRemoval = False
lngFunction = CTL_CODE(FILE_DEVICE_MASS_STORAGE, MEDIA_REMOVAL, METHOD_BUFFERED, FILE_READ_ACCESS)
PreventRemovalofVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, _
boPreventRemoval, Len(boPreventRemoval), 0, 0, lngBytesReturned, ByVal 0)
End Function
Private Function AutoEjectVolume(lngVolHandle As Long) As Boolean
Dim lngFunction As Long
Dim lngBytesReturned As Long
lngFunction = CTL_CODE(FILE_DEVICE_MASS_STORAGE, EJECT_MEDIA, METHOD_BUFFERED, FILE_READ_ACCESS)
AutoEjectVolume = DeviceIoControl(lngVolHandle, ByVal lngFunction, _
0, 0, 0, 0, lngBytesReturned, ByVal 0)
End Function

Private Sub Eject(strVol As String)
Dim lngVolHand As Long
Dim boResult As Boolean
Dim boSafe As Boolean
strVol = strVol & ":"
'
' Open and get a Handle for the Volume
'
boResult = OpenVolume(strVol, lngVolHand)
If boResult = False Then
MsgBox "Error Opening Volume " & Err.LastDllError
Exit Sub
End If
'
' Lock the Volume
'
boResult = LockVolume(lngVolHand)
If boResult = False Then
MsgBox "Error Dismounting Volume " & Err.LastDllError
CloseVolume (lngVolHand)
Exit Sub
End If
'
'Dismount the Volume
'
boResult = DismountVolume(lngVolHand)
If boResult = False Then
MsgBox "Error Dismounting Volume " & Err.LastDllError
CloseVolume (lngVolHand)
Exit Sub
End If
'
' Set to allow the Volume to be Removed
'
boResult = PreventRemovalofVolume(lngVolHand)
If boResult = False Then
MsgBox "Error Allowing Removal of Volume " & Err.LastDllError
CloseVolume (lngVolHand)
Exit Sub
End If
boSafe = True
'
' Eject the Volume
'
boResult = AutoEjectVolume(lngVolHand)
If boSafe = True Then
MsgBox "Media may be Safely Removed from Drive " & UCase(strVol)
End If
'
' Close the Handle
'
boResult = CloseVolume(lngVolHand)
If boResult = False Then
MsgBox "Error Closing Volume " & Err.LastDllError
Exit Sub
End If
Unload Me
End Sub

Private Sub Timer1_Timer()
boTimeOut = True
End Sub

[shahram_g]

اين يكي خيلي بهتره:



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
End Function