Newsgroup: it.comp.lang.visual-basic
Titolo: [?] VB6 Lettere delle periferiche disponibili

VB6: Giorni fa ho visto un msg che parlava di "ritrovare le lettere 
disponibili" delle periferiche sul proprio PC.
perso... vorrei proporre, come sotto scritto, la scelta delle periferiche da 
una lista di "lettere periferiche esistenti"
GRAZIE per un aiuto!!!!
Anto
----== Posted via Newsfeeds.Com - Unlimited-Unrestricted-Secure Usenet News==----
http://www.newsfeeds.com
 The #1 Newsgroup Service in the World! 120,000+ Newsgroups
----= East and West-Coast Server Farms - Total Privacy via Encryption =----

 Anto
il codice sotto non l'ho mai messo a punto, ma ti puo' servire.
ciao, a.
Option Explicit
'Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As
String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA"
(ByVal nDrive As String) As Long
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias
"GetDiskFreeSpaceExA" (ByVal lpRootPathName As String,
lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As
Currency, lpTotalNumberOfFreeBytes As Currency) As Long
Private Function DriveType(s)
    Select Case GetDriveType(s)
'        Case 0: DriveType = "Sconosciuto"
        Case 1: DriveType = "Non esistente"
        Case 2: DriveType = "Disco rimovibile"
        Case 3: DriveType = "Disco fisso"
        Case 4: DriveType = "Disco remoto"
        Case 5: DriveType = "CD-ROM"
        Case 6: DriveType = "Disco RAM"
        Case Else: DriveType = "Sconosciuto"
    End Select
End Function
Private Sub cmdGetDrives_Click()
    On Error GoTo errman
    Dim j As Long
    Dim r As Long, BytesFreeToCaller As Currency, TotalBytes As Currency
    Dim TotalFreeBytes As Currency, TotalBytesUsed As Currency
    Dim s As String
    For j = 65 To 90
        If (DriveType(Chr$(j) & ":") = "Sconosciuto") Or _
                (DriveType(Chr$(j) & ":") = "Non esistente") Then
            lstDrives.AddItem Chr$(j) & " - " & DriveType(Chr$(j) & ":")
        Else
            GetDiskFreeSpaceEx Chr$(j) & ":\", BytesFreeToCaller,
TotalBytes, TotalFreeBytes
            s = "TOT: " & Format$(TotalBytes * 10000, "###,###,###,##0") &
_
                " - FREE: " & Format$(TotalFreeBytes * 10000,
"###,###,###,##0") & _
                " - USED:" & Format$((TotalBytes - TotalFreeBytes) *
10000, "###,###,###,##0")
'                " - DISP: " & Format$(BytesFreeToCaller * 10000,
"###,###,###,##0") &
            lstDrives.AddItem Chr$(j) & " - " & DriveType(Chr$(j) & ":") &
" - " & s
        End If
    Next
    Exit Sub
errman:     lstErrors.AddItem Chr$(j) & " - " & Error: Resume Next
End Sub
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

> il codice sotto non l'ho mai messo a punto, ma ti puo' servire.
Urka.... grazie per la dritta... piuttosto arabo per me..sig...
Qui dentro non mi ci racapezzo.... per mia incapacità.... ci sto 
strusettando ma urka... mi sento proprio limitato :-((
qualche cosa di più semplice che solo faccia semplicemente una lista delle 
"solo lettere"?
Grazie!


 Anto
anto, non e' da oggi che frequenti vb...
apri un vbp
su un form metti un command, cmdGetDrives, e un listbox, lstDrives
2clic sul form
ctrl+a -> incolla il codice qui sotto
ho provato solo sul lap, che ha un virtual cd, e sembra vada.
ciao, a.
Option Explicit
Private Declare Function GetDriveType _
    Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long
Private Function DriveType(s)
    Select Case GetDriveType(s)
'        Case 0: DriveType = "Sconosciuto"
        Case 1: DriveType = "Non esistente"
        Case 2: DriveType = "Disco rimovibile"
        Case 3: DriveType = "Disco fisso"
        Case 4: DriveType = "Disco remoto"
        Case 5: DriveType = "CD-ROM"
        Case 6: DriveType = "Disco RAM"
        Case Else: DriveType = "Sconosciuto"
    End Select
End Function
Private Sub cmdGetDrives_Click()
    On Error GoTo errman
    lstDrives.Clear
    Dim j As Long
    For j = 65 To 90
        If (DriveType(Chr$(j) & ":") <> "Sconosciuto") And _
                (DriveType(Chr$(j) & ":") <> "Non esistente") Then
            lstDrives.AddItem Chr$(j) & ":"


 "solo lettere"?
TUTTO in vbs
'0
Set fso = CreateObject("Scripting.FileSystemObject")
    Set colDrives = fso.Drives
    sResults = "Drives found on this system: " & vbCrLf & vbCrLf
    For Each d in colDrives  ' (for each drive... )
      Select Case d.DriveType
        Case 0: t = "Unknown"
        Case 1: t = "Removable"
        Case 2: t = "Fixed"
        Case 3: t = "Network"
        Case 4: t = "CD-ROM"
        Case 5: t = "RAM Disk"
    End Select
    sResults = sResults & "    DriveLetter -  " & d.DriveLetter _
        & ", type: " & t & vbCrLf
    Next  ' drive
    MsgBox(sResults)
'MR Unreiable
'1
Dim fso, d, dc, s, n
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set dc = fso.Drives
   For Each d in dc
      n = ""
      s = s & d.DriveLetter & " - "
      If d.DriveType = Remote Then
         n = d.ShareName
      ElseIf d.IsReady Then
         n = d.VolumeName
      End If
      s = s & n & "  "
   Next
   ShowDriveList = s
msgbox s
'2.vbs
Dim str
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set Win = WScript.CreateObject("Shell.Application")
Set objFolder=Win.NameSpace(17)
For I=0 To 8
 str=str & objFolder.GetDetailsOf(, I) & vbTab
Next
str=str & vbCrLf
For Each obj In objFolder.Items
 For I=0 To 8
  str=str & objFolder.GetDetailsOf(obj, I) & vbTab
 Next
 str=str & vbCrLf
Next
Set ts=Fs.CreateTextFile("C:\windows\temp\SPACE.TXT")
ts.Write str
ts.Close
msgbox "done"
Wscript.Echo str
'Copia incolla su notepad e salva con estensione .vbs
'tutti i file (*.*)  poi ci clicchi sopra. (per esempio Test.vbs)
'se ti da' errore disattiva l'antivirus
--
Fosco

> TUTTO in vbs
grazie del listato... lo provo subito!
Ciao e grazie!


 anto, non e' da oggi che frequenti vb...
:-)) Ma i limiti restano... purtroppo... alla soglia dei 50 da autodidatta è 
dura... ma grazie al NG riesco a farmi cose incredibili!
Grazie, provo subito!
ciao e grazie mille dell'esempio!


 dura...
e lo dici proprio a me? dillo a gianluca, che pimpa apprendimento da tutti i
vs_pori :)