تبلیغات
ویژوال بیسیك 6 - Eject فلش مموری
شنبه 2 بهمن 1389

Eject فلش مموری

   نوشته شده توسط: شهرام    نوع مطلب :سورس كد ،

با قطعه كد زیر می توان نام درایو فلش مموری را به تابع داد و تابع فلش مموری را 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


برچسب ها: eject ، فلش مموری ، usb ،