Título: detectar otras unidades(?)
Publicado por: vivachapas en 15 Enero 2008, 01:04 am
hice un filemanager... funciona todo bien... pero solo en C:\ o donde este el server... mi duda era como hacer a detectar si hay otras unidades... yo probe en mi computadora y si pongo F:\ tb me muestra sus archivos y cosas... pero no tengo como saber en una computadora remota... si existe o como se llaman las otras unidades...
aclaro q busque en el buscador.. pero siempre me decia q usara mas palabras.. xD y no sabia ya como combinarlas xD
SALUDOS
Título: Re: detectar otras unidades(?)
Publicado por: CamaleonB en 15 Enero 2008, 04:50 am
2 Funciones API, Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Con la primera obtiene la letra de las unidades y con la segunda el dipo, digase si es disco duro, unidad de cd, etc.. ejemplo del api Guide 'Example by Alexey (alexeyka2001@rambler.ru) Private Const DRIVE_UNKNOWN = 0 Private Const DRIVE_ABSENT = 1 Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6 ' returns errors for UNC Path Private Const ERROR_BAD_DEVICE = 1200& Private Const ERROR_CONNECTION_UNAVAIL = 1201& Private Const ERROR_EXTENDED_ERROR = 1208& Private Const ERROR_MORE_DATA = 234 Private Const ERROR_NOT_SUPPORTED = 50& Private Const ERROR_NO_NET_OR_BAD_PATH = 1203& Private Const ERROR_NO_NETWORK = 1222& Private Const ERROR_NOT_CONNECTED = 2250& Private Const NO_ERROR = 0
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _ "WNetGetConnectionA" (ByVal lpszLocalName As String, _ ByVal lpszRemoteName As String, cbRemoteName As Long) As Long 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 Function fGetDrives() As String 'Returns all mapped drives Dim lngRet As Long Dim strDrives As String * 255 Dim lngTmp As Long lngTmp = Len(strDrives) lngRet = GetLogicalDriveStrings(lngTmp, strDrives) fGetDrives = Left(strDrives, lngRet) End Function Private Function fGetUNCPath(strDriveLetter As String) As String On Local Error GoTo fGetUNCPath_Err
Dim Msg As String, lngReturn As Long Dim lpszLocalName As String Dim lpszRemoteName As String Dim cbRemoteName As Long lpszLocalName = strDriveLetter lpszRemoteName = String$(255, Chr$(32)) cbRemoteName = Len(lpszRemoteName) lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _ cbRemoteName) Select Case lngReturn Case ERROR_BAD_DEVICE Msg = "Error: Bad Device" Case ERROR_CONNECTION_UNAVAIL Msg = "Error: Connection Un-Available" Case ERROR_EXTENDED_ERROR Msg = "Error: Extended Error" Case ERROR_MORE_DATA Msg = "Error: More Data" Case ERROR_NOT_SUPPORTED Msg = "Error: Feature not Supported" Case ERROR_NO_NET_OR_BAD_PATH Msg = "Error: No Network Available or Bad Path"
Case ERROR_NO_NETWORK
Msg = "Error: No Network Available" Case ERROR_NOT_CONNECTED Msg = "Error: Not Connected" Case NO_ERROR ' all is successful... End Select If Len(Msg) Then MsgBox Msg, vbInformation Else fGetUNCPath = Left$(lpszRemoteName, cbRemoteName) End If fGetUNCPath_End: Exit Function fGetUNCPath_Err: MsgBox Err.Description, vbInformation Resume fGetUNCPath_End End Function
Private Function fDriveType(strDriveName As String) As String Dim lngRet As Long Dim strDrive As String lngRet = GetDriveType(strDriveName) Select Case lngRet Case DRIVE_UNKNOWN 'The drive type cannot be determined. strDrive = "Unknown Drive Type" Case DRIVE_ABSENT 'The root directory does not exist. strDrive = "Drive does not exist" Case DRIVE_REMOVABLE 'The drive can be removed from the drive. strDrive = "Removable Media" Case DRIVE_FIXED 'The disk cannot be removed from the drive. strDrive = "Fixed Drive" Case DRIVE_REMOTE 'The drive is a remote (network) drive. strDrive = "Network Drive" Case DRIVE_CDROM 'The drive is a CD-ROM drive. strDrive = "CD Rom" Case DRIVE_RAMDISK 'The drive is a RAM disk. strDrive = "Ram Disk" End Select fDriveType = strDrive End Function
Sub sListAllDrives() Dim strAllDrives As String Dim strTmp As String strAllDrives = fGetDrives If strAllDrives <> "" Then Do strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1) strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1) Select Case fDriveType(strTmp) Case "Removable Media": Debug.Print "Removable drive : " & strTmp Case "CD Rom": Debug.Print " CD Rom drive : " & strTmp Case "Fixed Drive": Debug.Print " Local drive : " & strTmp Case "Network Drive": Debug.Print " Network drive : " & strTmp Debug.Print " UNC Path : " & _ fGetUNCPath(Left$(strTmp, Len(strTmp) - 1)) End Select Loop While strAllDrives <> "" End If End Sub
Private Sub Form_Load() Debug.Print "All available drives: " sListAllDrives End Sub
ah, tambien estan los controles de vb pero no me gusta usarlos, de que sea mas facil si creo salu2
Título: Re: detectar otras unidades(?)
Publicado por: foobar en 15 Enero 2008, 15:37 pm
Versión minimizada: 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 Function fGetDrives() As String Dim lStrLen& Dim sDrives As String * 255 lStrLen = GetLogicalDriveStrings(255, sDrives) fGetDrives = Left$(sDrives, lStrLen) End Function Function fDriveType(strDriveName As String) As String Dim lDrvType& Dim strDrive() lDrvType = GetDriveType(strDriveName) strDrive = Array( _ "Unknown Drive Type", "Drive does not exist", "Removable Media", _ "Fixed Drive", "Network Drive", "CD Rom", "Ram Disk" _ ) fDriveType = strDrive(lDrvType) End Function Sub sListAllDrives() Dim sAllDrives$, sDrive$() Dim strTmp As String sAllDrives = fGetDrives() sDrive = Split(sAllDrives, vbNullChar) For i = 0 To UBound(sDrive) If (sDrive(i) <> vbNullString) Then Debug.Print Spc(2); fDriveType(sDrive(i)) & ": " & sDrive(i) End If Next End Sub Private Sub Form_Load() Debug.Print "All available drives: " Call sListAllDrives End Sub
Título: Re: detectar otras unidades(?)
Publicado por: vivachapas en 15 Enero 2008, 16:40 pm
muy buenas ambas respuestas :) ahora me voy a poner a adaptarlo a mi programa :P GRACIAS! SALUDOS --------------- modifico para no postear de nuevo y reabrir el tema... x si alguien lo lee en un futuro le digo como simplifique el codigo para lo q yo necesitaba: Private Declare Function GetLogicalDrives Lib "kernel32" () As Long Dim Drives As Long Dim i As Long Dim LasUnidades As String
Private Sub Form_Load() Drives = GetLogicalDrives For i = 0 To 25 If (Drives And 2 ^ i) <> 0 Then LasUnidades = LasUnidades + " " + Chr$(65 + i) End If Next i MsgBox LasUnidades End End Sub
|