Listing af USB enheder ELLER identificere en Creative MuVo

Tjaa, men kan man regne med at man får point for det ??

http://www.eksperten.dk/spm/343449

//akj

Når du ser den i stifinder har den vel et navn.

Det navn kan du finde med denne kode på en form.

//akj

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As _
Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize _
As Long) As Long



Public Function VolumeName(Optional Drive As String = "C:\")
Dim sBuffer As String
sBuffer = Space$(255)

If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
    Then Drive = Drive & "\"

If GetVolumeInformation(Drive, sBuffer, Len(sBuffer), 0, 0, 0, _
Space$(255), 255) = 0 Then
    ' fejl
   
Else
    VolumeName = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
End If

End Function

Private Sub Form_Load()
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")

Dim dr
For Each dr In fso.Drives
  MsgBox "drev " & dr.driveletter & Chr(13) & "Navn  = " & VolumeName(dr.driveletter)
Next

End Sub

jeg undskylder for sidste og du kan få de 200 points for det stadig...

beklager... jeg laver et spørgsmål til dig m. 200 pts... hvis du skriver her at du stadig vil have dem...

med hensyn til den kode du har skrevet her kan men ikke regne med kun navn i stifinder da brugeren selv kan definere det :(

det er lidt kompliceret... det er et drev... og man skal kunne finde den med sit program og smide drev bogstav ind i en text / label control !!

Ja, jeg vil gerne have points for svaret.

2. Hvis du ikke kan bruge ovennævnte metode skal du se om creative har noget API eller activeX du kan bruge.

Alternativt kan du jo lave et check.

If Muvo ikke fundet then
  msgbox "Kunne ikke finde muvo. Check den er tilsluttet. Husk du ikke må ændre drevnavn, det skal hedde MuVo"
end if

//akj

hmm du siger noget

altså den ovenstående kode checker efter DREV NAVN ???

Ja, jeg får:
OS (c:)
Data (d:)
blank
blank
Canon(f:) USB kortlæser

//akj

hmm.. ok jeg prøver lige :D - så kan man evt. definere i en options ting hvad den hedder... som standard hedder den Removable Disk (i:)  -  men den hedder ikke noget når man højre klikker så det kan nok ikke bruges... jeg prøver lige...

kan du ikke lige lave det som det projekt jeg kan downloade fordi jeg ved ikke lige hvordan din kode skal strikkes ordenligt sammen med forms osv...

altså hvor den selv søger efter "MuVo" som drev navn også kommer den med en MSGBOX hvor der står fx: "MuVo fundet" så kan jeg selv udskifte det ;)

Kigger på det i aften.

//akj

thanks... er der mulighed for at jeg kan få det i aften ?

Jeg nåede det ikke i aftes :-(

Men her er det :-)

Opret en form med en textbox (text1) og en knap (command1)

Paste flg kode ind på formen.

//akj

' kode start

Option Explicit

Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As _
Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength _
As Long, lpFileSystemFlags As Long, ByVal _
lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize _
As Long) As Long



Public Function VolumeName(Optional Drive As String = "C:\")
Dim sBuffer As String
sBuffer = Space$(255)

If Len(Drive) = 1 Then Drive = Drive & ":\"
If Len(Drive) = 2 And Right$(Drive, 1) = ":" _
    Then Drive = Drive & "\"

If GetVolumeInformation(Drive, sBuffer, Len(sBuffer), 0, 0, 0, _
Space$(255), 255) = 0 Then
    ' fejl
   
Else
    VolumeName = Left$(sBuffer, InStr(sBuffer, Chr$(0)) - 1)
End If

End Function

Private Sub Command1_Click()

    Command1.Enabled = False

    If Len(Text1.Text) < 1 Then
        MsgBox "Indtast et drevnavn"
        Exit Sub
    End If
   
    Dim fso
    Dim done As Boolean
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim dr
    For Each dr In fso.Drives
        'MsgBox "drev " & dr.driveletter & Chr(13) & "Navn  = " & VolumeName(dr.driveletter)
        If LCase(VolumeName(dr.driveletter)) = LCase(Text1.Text) Then
            MsgBox ("'" & Text1.Text & "' fundet som drev " & dr.driveletter)
            done = True
            Exit For
        End If
    Next
   
    If done = False Then
        MsgBox ("Drevet blev ikke fundet")
    End If
   
    Command1.Enabled = True
   
End Sub

Private Sub Form_Load()
Command1.Caption = "Find drev"
Text1.Text = "MuVo"
End Sub

' kode slut

thanx :D

Takker for pts.

Du får lov at beholde de 200 fra det andet spørgsmål men husk det til en anden gang.

Held og lykke med projektet

//akj