elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Tutorial básico de Quickjs


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  detectar otras unidades(?)
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: detectar otras unidades(?)  (Leído 1,536 veces)
vivachapas


Desconectado Desconectado

Mensajes: 612



Ver Perfil
detectar otras unidades(?)
« 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


En línea

CamaleonB

Desconectado Desconectado

Mensajes: 92


Chameleon Rock's


Ver Perfil WWW
Re: detectar otras unidades(?)
« Respuesta #1 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

Código:
'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



En línea

foobar

Desconectado Desconectado

Mensajes: 47


Ver Perfil
Re: detectar otras unidades(?)
« Respuesta #2 en: 15 Enero 2008, 15:37 pm »

Versión minimizada:

Código
  1. Option Explicit
  2.  
  3. Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
  4. Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
  5.  
  6. Function fGetDrives() As String
  7.    Dim lStrLen&
  8.    Dim sDrives As String * 255
  9.  
  10.    lStrLen = GetLogicalDriveStrings(255, sDrives)
  11.    fGetDrives = Left$(sDrives, lStrLen)
  12. End Function
  13.  
  14. Function fDriveType(strDriveName As String) As String
  15.    Dim lDrvType&
  16.    Dim strDrive()
  17.  
  18.    lDrvType = GetDriveType(strDriveName)
  19.    strDrive = Array( _
  20.        "Unknown Drive Type", "Drive does not exist", "Removable Media", _
  21.        "Fixed Drive", "Network Drive", "CD Rom", "Ram Disk" _
  22.    )
  23.    fDriveType = strDrive(lDrvType)
  24. End Function
  25.  
  26.  
  27. Sub sListAllDrives()
  28.    Dim sAllDrives$, sDrive$()
  29.    Dim strTmp As String
  30.  
  31.    sAllDrives = fGetDrives()
  32.    sDrive = Split(sAllDrives, vbNullChar)
  33.  
  34.    For i = 0 To UBound(sDrive)
  35.        If (sDrive(i) <> vbNullString) Then
  36.            Debug.Print Spc(2); fDriveType(sDrive(i)) & ": " & sDrive(i)
  37.        End If
  38.    Next
  39. End Sub
  40.  
  41. Private Sub Form_Load()
  42.    Debug.Print "All available drives: "
  43.  
  44.    Call sListAllDrives
  45. End Sub
  46.  
En línea

vivachapas


Desconectado Desconectado

Mensajes: 612



Ver Perfil
Re: detectar otras unidades(?)
« Respuesta #3 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:

Código:
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
« Última modificación: 15 Enero 2008, 20:48 pm por vivachapas » En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
¿No solo cambia el kilogramo?: Otras tres unidades de medida que también se ...
Noticias
wolfbcn 0 1,417 Último mensaje 18 Noviembre 2018, 02:10 am
por wolfbcn
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines