你是不是定错了？ 应该是DeviceIoControl吧Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long 'Example Name: Using DeviceIoControl'------------------------------------------------------------------------------'BAS Module Code '------------------------------------------------------------------------------
Option ExplicitPublic Const DRIVE_REMOVABLE = 2 Public Const DRIVE_CDROM = 5 Public Const INVALID_HANDLE_VALUE As Long = -1& Public Const GENERIC_READ As Long = &H80000000 Public Const FILE_SHARE_READ As Long = &H1 Public Const FILE_SHARE_WRITE As Long = &H2 Public Const FILE_ANY_ACCESS As Long = &H0 Public Const FILE_READ_ACCESS As Long = &H1 Public Const FILE_WRITE_ACCESS As Long = &H2 Public Const OPEN_EXISTING As Long = 3 Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804Public Type PREVENT_MEDIA_REMOVAL PreventMediaRemoval As Byte End TypePublic Declare Function GetLogicalDriveStrings Lib "kernel32" _ Alias "GetLogicalDriveStringsA" _ (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" _ Alias "GetDriveTypeA" _ (ByVal lpRootPathName As String) As Long
Public Declare Function DeviceIoControl Lib "kernel32" _ (ByVal hDevice As Long, _ ByVal dwIoControlCode As Long, _ lpInBuffer As Any, _ ByVal nInBufferSize As Long, _ lpOutBuffer As Any, _ ByVal nOutBufferSize As Long, _ lpBytesReturned As Long, _ lpOverlapped As Any) As LongPublic Declare Function CreateFile Lib "kernel32" _ Alias "CreateFileA" _ (ByVal lpFileName As String, _ ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, _ lpSecurityAttributes As Any, _ ByVal dwCreationDisposition As Long, _ ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As LongPublic Declare Function CloseHandle Lib "kernel32" _ (ByVal hObject As Long) As LongPublic Function DeviceLock(sDrive As String, fLock As Boolean) As Boolean Dim hDevice As Long Dim PMR As PREVENT_MEDIA_REMOVAL Dim bytesReturned As Long Dim success As Long
'the drive letter has to be passed 'to CreateFile without a trailing slash (ie 'G:') sDrive = UnQualifyPath(sDrive)
'obtain a handle to the device 'using the correct device syntax hDevice = CreateFile("\\.\" & sDrive, _ GENERIC_READ, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, _ ByVal 0&, _ OPEN_EXISTING, _ 0&, 0&) If hDevice <> INVALID_HANDLE_VALUE Then 'assign the fLock value to the 'PREVENT_MEDIA_REMOVAL type PMR.PreventMediaRemoval = CByte(Abs(fLock))
'If the operation succeeds, 'DeviceIoControl returns a nonzero value success = DeviceIoControl(hDevice, _ IOCTL_STORAGE_MEDIA_REMOVAL, _ PMR, _ Len(PMR), _ ByVal 0&, _ 0&, _ bytesReturned, _ ByVal 0&)
End If
Call CloseHandle(hDevice) DeviceLock = success
End Function Private Function UnQualifyPath(ByVal sPath As String) As String 'removes any trailing slash from the path sPath = Trim$(sPath)
If Right$(sPath, 1) = "\" Then UnQualifyPath = Left$(sPath, Len(sPath) - 1) Else: UnQualifyPath = sPath End If
End Function '--end block--' '------------------------------------------------------------------------------ 'Form Code ' 'Add a listbox (List1), a command button array (Command1(0), Command1(1)), 'and a label (Label1) to a form. The third button shown (End) is optional. 'Add the following code to the form: '------------------------------------------------------------------------------
Option ExplicitPrivate Sub Form_Load() 'load the removable drives and 'disable the command buttons until 'a drive is selected LoadAvailableDrives List1 Command1(0).Enabled = False Command1(1).Enabled = False
End Sub Private Sub List1_Click() Command1(0).Enabled = List1.ListIndex > -1 Command1(1).Enabled = List1.ListIndex > -1
End Sub Private Sub Command1_Click(Index As Integer) Dim fLock As Boolean Dim result As Boolean Dim sDrive As String
'nothing to do if a drive's not selected If List1.ListIndex > -1 Then
'get the selected drive sDrive = List1.List(List1.ListIndex)
'DeviceIoControl requires the 'IOCTL_STORAGE_MEDIA_REMOVAL 'control code and a Boolean 'indicating the lock state. 'Passing False unlocks the device; 'passing True locks it. This handily 'corresponds to the 0/1 indices of 'the Command button array. fLock = CBool(Index) result = DeviceLock(sDrive, fLock)
'display result If result Then
Select Case Index Case 0: Label1.Caption = "Device " & sDrive & " is unlocked." Case 1: Label1.Caption = "Device " & sDrive & " is locked." End Select
Else: Label1.Caption = "Call failed - perhaps no media in device." End If
End If
End Sub Private Sub LoadAvailableDrives(lst As ListBox) Dim lpBuffer As String Dim drvType As Long Dim currDrive As String 'get list of available drives lpBuffer = GetDriveString() 'Separate the drive strings 'and add to the combo. StripNulls 'will continually shorten the 'string. Loop until a single 'remaining terminating null is 'encountered. Do Until lpBuffer = Chr(0)
'strip off one drive item 'and check for removable (or CD) status, 'and add to the combo currDrive = StripNulls(lpBuffer) drvType = GetDriveType(currDrive)
If (drvType = DRIVE_CDROM) Or _ (drvType = DRIVE_REMOVABLE) Then
lst.AddItem currDrive
End If
Loop
End Sub Private Function StripNulls(startstr As String) As String 'Take a string separated by chr$(0) 'and split off 1 item, shortening the 'string so next item is ready for removal. Dim pos As Long pos = InStr(startstr, Chr$(0))
应该是DeviceIoControl吧Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As OVERLAPPED) As Long
'Example Name: Using DeviceIoControl'------------------------------------------------------------------------------'BAS Module Code
'------------------------------------------------------------------------------
Option ExplicitPublic Const DRIVE_REMOVABLE = 2
Public Const DRIVE_CDROM = 5
Public Const INVALID_HANDLE_VALUE As Long = -1&
Public Const GENERIC_READ As Long = &H80000000
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const FILE_ANY_ACCESS As Long = &H0
Public Const FILE_READ_ACCESS As Long = &H1
Public Const FILE_WRITE_ACCESS As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804Public Type PREVENT_MEDIA_REMOVAL
PreventMediaRemoval As Byte
End TypePublic Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal lpRootPathName As String) As Long
Public Declare Function DeviceIoControl Lib "kernel32" _
(ByVal hDevice As Long, _
ByVal dwIoControlCode As Long, _
lpInBuffer As Any, _
ByVal nInBufferSize As Long, _
lpOutBuffer As Any, _
ByVal nOutBufferSize As Long, _
lpBytesReturned As Long, _
lpOverlapped As Any) As LongPublic Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
lpSecurityAttributes As Any, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) As LongPublic Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As LongPublic Function DeviceLock(sDrive As String, fLock As Boolean) As Boolean Dim hDevice As Long
Dim PMR As PREVENT_MEDIA_REMOVAL
Dim bytesReturned As Long
Dim success As Long
'the drive letter has to be passed
'to CreateFile without a trailing slash (ie 'G:')
sDrive = UnQualifyPath(sDrive)
'obtain a handle to the device
'using the correct device syntax
hDevice = CreateFile("\\.\" & sDrive, _
GENERIC_READ, _
FILE_SHARE_READ Or FILE_SHARE_WRITE, _
ByVal 0&, _
OPEN_EXISTING, _
0&, 0&)
If hDevice <> INVALID_HANDLE_VALUE Then 'assign the fLock value to the
'PREVENT_MEDIA_REMOVAL type
PMR.PreventMediaRemoval = CByte(Abs(fLock))
'If the operation succeeds,
'DeviceIoControl returns a nonzero value
success = DeviceIoControl(hDevice, _
IOCTL_STORAGE_MEDIA_REMOVAL, _
PMR, _
Len(PMR), _
ByVal 0&, _
0&, _
bytesReturned, _
ByVal 0&)
End If
Call CloseHandle(hDevice)
DeviceLock = success
End Function
Private Function UnQualifyPath(ByVal sPath As String) As String 'removes any trailing slash from the path
sPath = Trim$(sPath)
If Right$(sPath, 1) = "\" Then
UnQualifyPath = Left$(sPath, Len(sPath) - 1)
Else: UnQualifyPath = sPath
End If
End Function
'--end block--'
'------------------------------------------------------------------------------
'Form Code
'
'Add a listbox (List1), a command button array (Command1(0), Command1(1)),
'and a label (Label1) to a form. The third button shown (End) is optional.
'Add the following code to the form:
'------------------------------------------------------------------------------
Option ExplicitPrivate Sub Form_Load() 'load the removable drives and
'disable the command buttons until
'a drive is selected
LoadAvailableDrives List1
Command1(0).Enabled = False
Command1(1).Enabled = False
End Sub
Private Sub List1_Click() Command1(0).Enabled = List1.ListIndex > -1
Command1(1).Enabled = List1.ListIndex > -1
End Sub
Private Sub Command1_Click(Index As Integer) Dim fLock As Boolean
Dim result As Boolean
Dim sDrive As String
'nothing to do if a drive's not selected
If List1.ListIndex > -1 Then
'get the selected drive
sDrive = List1.List(List1.ListIndex)
'DeviceIoControl requires the
'IOCTL_STORAGE_MEDIA_REMOVAL
'control code and a Boolean
'indicating the lock state.
'Passing False unlocks the device;
'passing True locks it. This handily
'corresponds to the 0/1 indices of
'the Command button array.
fLock = CBool(Index)
result = DeviceLock(sDrive, fLock)
'display result
If result Then
Select Case Index
Case 0: Label1.Caption = "Device " & sDrive & " is unlocked."
Case 1: Label1.Caption = "Device " & sDrive & " is locked."
End Select
Else: Label1.Caption = "Call failed - perhaps no media in device."
End If
End If
End Sub
Private Sub LoadAvailableDrives(lst As ListBox) Dim lpBuffer As String
Dim drvType As Long
Dim currDrive As String 'get list of available drives
lpBuffer = GetDriveString() 'Separate the drive strings
'and add to the combo. StripNulls
'will continually shorten the
'string. Loop until a single
'remaining terminating null is
'encountered.
Do Until lpBuffer = Chr(0)
'strip off one drive item
'and check for removable (or CD) status,
'and add to the combo
currDrive = StripNulls(lpBuffer)
drvType = GetDriveType(currDrive)
If (drvType = DRIVE_CDROM) Or _
(drvType = DRIVE_REMOVABLE) Then
lst.AddItem currDrive
End If
Loop
End Sub
Private Function StripNulls(startstr As String) As String 'Take a string separated by chr$(0)
'and split off 1 item, shortening the
'string so next item is ready for removal.
Dim pos As Long pos = InStr(startstr, Chr$(0))
If pos Then
StripNulls = Mid$(startstr, 1, pos - 1)
startstr = Mid$(startstr, pos + 1, Len(startstr))
End IfEnd Function
Private Function GetDriveString() As String 'returns of available drives each
'separated by a null
Dim sBuffer As String
'possible 26 drives, three characters each, plus trailing null
sBuffer = Space$(26 * 4)
If GetLogicalDriveStrings(Len(sBuffer), sBuffer) Then 'trim string but do not
'remove trailing null
GetDriveString = Trim$(sBuffer)
End IfEnd Function