怎样判断机器上有没有光驱?  如何得到光驱的盘符 并且打开光盘上的文件?

解决方案 »

  1.   

    API函数long GetDriveType(string driveLetter)
    根据返回值可判断盘符类型:光驱,软驱,硬盘等
    n=GetDriveType("e:\")
    if (n and 5)=5 then '是光驱
      

  2.   

    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