API函数long GetDriveType(string driveLetter) 根据返回值可判断盘符类型:光驱,软驱,硬盘等 n=GetDriveType("e:\") if (n and 5)=5 then '是光驱
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Sub Form_Load() 'KPD-Team 1998 'URL: http://www.allapi.net/ 'E-Mail: [email protected] 'Set the graphic mode to persistent Me.AutoRedraw = True 'Get information about the C:\ Select Case GetDriveType("h:\") Case 2 Me.Print "Removable" Case 3 Me.Print "Drive Fixed" Case Is = 4 Me.Print "Remote" Case Is = 5 Me.Print "Cd-Rom" Case Is = 6 Me.Print "Ram disk" Case Else Me.Print "Unrecognized" End Select End Sub---------------------------------------------------------------- Const SHGFI_ICONLOCATION = &H1000 Const MB_ICONASTERISK = &H40& Const MB_ICONEXCLAMATION = &H30& Const MAX_PATH = 260 Private Type MSGBOXPARAMS cbSize As Long hwndOwner As Long hInstance As Long lpszText As String lpszCaption As String dwStyle As Long lpszIcon As String dwContextHelpId As Long lpfnMsgBoxCallback As Long dwLanguageId As Long End Type Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Private Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long Private Declare Function MessageBoxIndirect Lib "user32" Alias "MessageBoxIndirectA" (lpMsgBoxParams As MSGBOXPARAMS) As Long Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) Private Sub Form_Paint() 'KPD-Team 1999,2001 'URL: http://www.allapi.net/ 'E-Mail: [email protected] Dim MBP As MSGBOXPARAMS, LDs As Long, Cnt As Long, sDrives As String 'get the available drives LDs = GetLogicalDrives sDrives = "Available drives:" For Cnt = 0 To 25 If (LDs And 2 ^ Cnt) <> 0 Then sDrives = sDrives + " " + Chr$(65 + Cnt) End If Next Cnt 'Show the commandline MessageBoxEx Me.hwnd, "The command line: " + GetCommLine, "Command Line ...", MB_ICONEXCLAMATION, 0 'Set the structure size MBP.cbSize = Len(MBP) 'Set the icon style MBP.dwStyle = MB_ICONASTERISK 'set the owner wndow MBP.hwndOwner = Me.hwnd 'set teh text MBP.lpszText = sDrives 'set the caption MBP.lpszCaption = "Available drives" 'Show the messagebox MessageBoxIndirect MBP 'end our application PostQuitMessage 0 End Sub Private Function GetCommLine() As String Dim RetStr As Long, SLen As Long Dim Buffer As String 'Get a pointer to a string, which contains the command line RetStr = GetCommandLine 'Get the length of that string SLen = lstrlen(RetStr) If SLen > 0 Then 'Create a buffer GetCommLine = Space$(SLen) 'Copy to the buffer CopyMemory ByVal GetCommLine, ByVal RetStr, SLen End If End Function
根据返回值可判断盘符类型:光驱,软驱,硬盘等
n=GetDriveType("e:\")
if (n and 5)=5 then '是光驱
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: [email protected]
'Set the graphic mode to persistent
Me.AutoRedraw = True
'Get information about the C:\
Select Case GetDriveType("h:\")
Case 2
Me.Print "Removable"
Case 3
Me.Print "Drive Fixed"
Case Is = 4
Me.Print "Remote"
Case Is = 5
Me.Print "Cd-Rom"
Case Is = 6
Me.Print "Ram disk"
Case Else
Me.Print "Unrecognized"
End Select
End Sub----------------------------------------------------------------
Const SHGFI_ICONLOCATION = &H1000
Const MB_ICONASTERISK = &H40&
Const MB_ICONEXCLAMATION = &H30&
Const MAX_PATH = 260
Private Type MSGBOXPARAMS
cbSize As Long
hwndOwner As Long
hInstance As Long
lpszText As String
lpszCaption As String
dwStyle As Long
lpszIcon As String
dwContextHelpId As Long
lpfnMsgBoxCallback As Long
dwLanguageId As Long
End Type
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Private Declare Function MessageBoxEx Lib "user32" Alias "MessageBoxExA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As Long, ByVal wLanguageId As Long) As Long
Private Declare Function MessageBoxIndirect Lib "user32" Alias "MessageBoxIndirectA" (lpMsgBoxParams As MSGBOXPARAMS) As Long
Private Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Sub Form_Paint()
'KPD-Team 1999,2001
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim MBP As MSGBOXPARAMS, LDs As Long, Cnt As Long, sDrives As String
'get the available drives
LDs = GetLogicalDrives
sDrives = "Available drives:"
For Cnt = 0 To 25
If (LDs And 2 ^ Cnt) <> 0 Then
sDrives = sDrives + " " + Chr$(65 + Cnt)
End If
Next Cnt
'Show the commandline
MessageBoxEx Me.hwnd, "The command line: " + GetCommLine, "Command Line ...", MB_ICONEXCLAMATION, 0
'Set the structure size
MBP.cbSize = Len(MBP)
'Set the icon style
MBP.dwStyle = MB_ICONASTERISK
'set the owner wndow
MBP.hwndOwner = Me.hwnd
'set teh text
MBP.lpszText = sDrives
'set the caption
MBP.lpszCaption = "Available drives"
'Show the messagebox
MessageBoxIndirect MBP
'end our application
PostQuitMessage 0
End Sub
Private Function GetCommLine() As String
Dim RetStr As Long, SLen As Long
Dim Buffer As String
'Get a pointer to a string, which contains the command line
RetStr = GetCommandLine
'Get the length of that string
SLen = lstrlen(RetStr)
If SLen > 0 Then
'Create a buffer
GetCommLine = Space$(SLen)
'Copy to the buffer
CopyMemory ByVal GetCommLine, ByVal RetStr, SLen
End If
End Function