Início
Convidad 19/1/2011, 11:49Option Explicit
'API do Windows
Private Declare Function apiGetLogicalDrives Lib "kernel32" Alias "GetLogicalDrives" () As Long
Private Declare Function apiGetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function apiWNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Sub sListDrives()
'Processo para listar todas as unidades ligadas a um computador, bem como o tipo e, se necessário Nome da UNC
Dim lngReturn As Long
Dim intLoop As Integer
Dim strDrive As String
lngReturn = apiGetLogicalDrives
For intLoop = 0 To 25 ' Drive letters can only be A-Z
If (lngReturn And (2 ^ intLoop)) <> 0 Then
strDrive = Chr(65 + intLoop) & ":"
Debug.Print strDrive & vbTab & fDriveType(strDrive & "") & IIf(fDriveType(strDrive) = "Network Drive", "(" & fConvertNetworkDriveToUNC(strDrive) & ")", "")
End If
Next intLoop
End Sub
Function fDriveType(strDriveLetter As String) As String
'Função para retornar o tipo de unidade (ou seja removível, Local Network)
'Aceita uma letra de unidade no formato de "C:"
Dim lngReturn As Long
lngReturn = apiGetDriveType(strDriveLetter)
fDriveType = Switch(lngReturn = 0, "Unknown", lngReturn = 1, "No root", lngReturn = 2, "Removeable", _
lngReturn = 3, "Local Hard Drive", lngReturn = 4, "Network Drive", _
lngReturn = 5, "CD-ROM Drive", lngReturn = 6, "RAM Disk")
End Function
Function fConvertNetworkDriveToUNC(strDrive As String) As String
'Função para retornar o nome UNC de uma unidade de rede
'Aceita uma letra de unidade no formato de "G"
'Note que os resultados imprevisíveis podem acontecer se passou uma letra de unidade para
'um outro tipo de movimentação - aparentemente, uma sequência de comprimento zero.
Dim strReturn As String
strReturn = Space(255)
Dim lngReturn As Long
lngReturn = apiWNetGetConnection(strDrive, strReturn, Len(strReturn))
If lngReturn = 0 Then
fConvertNetworkDriveToUNC = Left(strReturn, InStr(strReturn, vbNullChar) - 1)
End If
End Function
Fonte: AllAPis.Net
'API do Windows
Private Declare Function apiGetLogicalDrives Lib "kernel32" Alias "GetLogicalDrives" () As Long
Private Declare Function apiGetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function apiWNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Sub sListDrives()
'Processo para listar todas as unidades ligadas a um computador, bem como o tipo e, se necessário Nome da UNC
Dim lngReturn As Long
Dim intLoop As Integer
Dim strDrive As String
lngReturn = apiGetLogicalDrives
For intLoop = 0 To 25 ' Drive letters can only be A-Z
If (lngReturn And (2 ^ intLoop)) <> 0 Then
strDrive = Chr(65 + intLoop) & ":"
Debug.Print strDrive & vbTab & fDriveType(strDrive & "") & IIf(fDriveType(strDrive) = "Network Drive", "(" & fConvertNetworkDriveToUNC(strDrive) & ")", "")
End If
Next intLoop
End Sub
Function fDriveType(strDriveLetter As String) As String
'Função para retornar o tipo de unidade (ou seja removível, Local Network)
'Aceita uma letra de unidade no formato de "C:"
Dim lngReturn As Long
lngReturn = apiGetDriveType(strDriveLetter)
fDriveType = Switch(lngReturn = 0, "Unknown", lngReturn = 1, "No root", lngReturn = 2, "Removeable", _
lngReturn = 3, "Local Hard Drive", lngReturn = 4, "Network Drive", _
lngReturn = 5, "CD-ROM Drive", lngReturn = 6, "RAM Disk")
End Function
Function fConvertNetworkDriveToUNC(strDrive As String) As String
'Função para retornar o nome UNC de uma unidade de rede
'Aceita uma letra de unidade no formato de "G"
'Note que os resultados imprevisíveis podem acontecer se passou uma letra de unidade para
'um outro tipo de movimentação - aparentemente, uma sequência de comprimento zero.
Dim strReturn As String
strReturn = Space(255)
Dim lngReturn As Long
lngReturn = apiWNetGetConnection(strDrive, strReturn, Len(strReturn))
If lngReturn = 0 Then
fConvertNetworkDriveToUNC = Left(strReturn, InStr(strReturn, vbNullChar) - 1)
End If
End Function
Fonte: AllAPis.Net