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


 


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo, raul338)
| | |-+  [SRC] getShareSubFolders
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [SRC] getShareSubFolders  (Leído 471 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
[SRC] getShareSubFolders
« en: 26 Noviembre 2012, 18:55 »

Bueno, estos códigos los he sacado para un proyecto en curso.
Devuelven un array con las subcarpetas de un servidor local.

OPCIÓN 1:

Código
  1. Option Explicit
  2. '===========================================================================
  3. ' º Name        : GetSharedSubFolders
  4. ' º Author      : Psyke1
  5. ' º Mail        : vbpsyke1@mixmail.com
  6. ' º Explanation : Returns an array with the subfolders of a shared folder.
  7. ' º Date        : 26/11/12
  8. ' º Reference   : http://goo.gl/sgDVX
  9. ' º Greets      : LeandroA
  10. ' º Visit       :
  11. '    * http://foro.h-sec.org
  12. '    * http://infrangelux.sytes.net
  13. '===========================================================================
  14.  
  15. Public Function getSharedSubFolders(ByVal sServer As String) As Collection
  16. Dim oShell                  As Object
  17. Dim oItem                   As Variant
  18.  
  19.    If PathIsNetworkPath(sServer) Then
  20.       Set oShell = CreateObject("Shell.Application")
  21.  
  22.       If Not oShell.NameSpace(CVar(sServer)) Is Nothing Then
  23.          Set getSharedSubFolders = New Collection
  24.  
  25.          For Each oItem In oShell.NameSpace(CVar(sServer)).Items
  26.              getSharedSubFolders.Add oItem.Path
  27.          Next oItem
  28.       End If
  29.    End If
  30. End Function
  31.  

Ejemplo de uso:
Código
  1. Private Sub Form_Load()
  2. Dim vFolder                 As Variant
  3. Dim cTmp                    As Collection
  4.  
  5.    Set cTmp = getSharedSubFolders("\\CARLOS-PC")
  6.    If cTmp Is Nothing Then
  7.        MsgBox "El servidor local no existe"
  8.    Else
  9.        For Each vFolder In cTmp
  10.            Debug.Print vFolder
  11.        Next
  12.    End If
  13. End Sub



OPCIÓN 2:

Código
  1. Option Explicit
  2. '===========================================================================
  3. ' º Name        : mGetSharedSubFolders.bas
  4. ' º Author      : Psyke1
  5. ' º Mail        : vbpsyke1@mixmail.com
  6. ' º Explanation : Returns an array with the subfolders of a shared folder.
  7. ' º Date        : 26/11/12
  8. ' º Visit       :
  9. '    * http://foro.h-sec.org
  10. '    * http://infrangelux.sytes.net
  11. '===========================================================================
  12.  
  13. 'Type
  14. Private Type NETRESOURCE
  15.  dwScope       As Long
  16.  dwType        As Long
  17.  dwDisplayType As Long
  18.  dwUsage       As Long
  19.  lpLocalName   As Long
  20.  lpRemoteName  As Long
  21.  lpComment     As Long
  22.  lpProvider    As Long
  23. End Type
  24.  
  25. 'kernel32.dll
  26. Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal pString As Long) As Long
  27. Private Declare Function lstrcpyA Lib "kernel32.dll" (ByVal lpString1 As String, ByVal pString As Long) As Long
  28.  
  29. 'mpr.dll
  30. Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As NETRESOURCE, lphEnum As Long) As Long
  31. Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
  32. Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long
  33.  
  34. 'shlwapi.dll
  35. Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathA" (ByVal pszPath As String) As Long
  36.  
  37. 'Consts
  38. Private Const RESOURCE_GLOBALNET        As Long = &H2
  39. Private Const RESOURCETYPE_DISK         As Long = &H1
  40. Private Const MAX_RESOURCES             As Long = &H100
  41.  
  42. 'Function
  43. Public Function getShareSubFolders(ByVal sNameServer As String) As String()
  44. Dim hEnum                               As Long
  45. Dim lLen                                As Long
  46. Dim lTotal                              As Long
  47. Dim lpRName                             As Long
  48. Dim sRet()                              As String
  49. Dim tNet(0 To MAX_RESOURCES)            As NETRESOURCE
  50.  
  51.    If PathIsNetworkPath(sNameServer) Then
  52.        lTotal = -1
  53.        lLen = &H1000 '(UBound(tNet) * Len(tNet(0))) / 2
  54.  
  55.        tNet(0).lpRemoteName = StrPtr(StrConv(sNameServer, vbFromUnicode))
  56.  
  57.        If Not WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNet(0), hEnum) Then
  58.            If Not WNetEnumResource(hEnum, lTotal, tNet(0), lLen) Then
  59.                If lTotal > 0 Then
  60.                    lTotal = lTotal - 1
  61.                    ReDim sRet(0 To lTotal) As String
  62.  
  63.                    For lLen = 0 To lTotal
  64.                        lpRName = tNet(lLen).lpRemoteName
  65.  
  66.                        sRet(lLen) = Space(lstrlenA(lpRName))
  67.                        lstrcpyA sRet(lLen), lpRName
  68.                    Next lLen
  69.                End If
  70.            End If
  71.  
  72.            WNetCloseEnum hEnum
  73.        End If
  74.    End If
  75.  
  76.    getShareSubFolders = sRet()
  77. End Function

Ejemplo de uso:
Código
  1. Private Sub Form_Load()
  2. Dim vSubFolder                          As Variant
  3. Dim sSF()                               As String
  4.  
  5.    sSF = getShareSubFolders("\\CARLOS-PC")
  6.  
  7.    If Not Not sSF Then
  8.  
  9.        For Each vSubFolder In sSF
  10.            Debug.Print vSubFolder
  11.        Next vSubFolder
  12.    End If
  13.  
  14.    'fix NotNot hack :)
  15.    Debug.Assert App.hInstance
  16. End Sub

DoEvents! :P


« Última modificación: 27 Noviembre 2012, 01:14 por Psyke1 » En línea

Danyfirex


Desconectado Desconectado

Mensajes: 490


My Dear Mizuho


Ver Perfil
Re: [SRC] getShareSubFolders
« Respuesta #1 en: 26 Noviembre 2012, 20:11 »

Gracias Psyke1 por el código esta muy bueno.
saludos


En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.086



Ver Perfil WWW
Re: [SRC] getShareSubFolders
« Respuesta #2 en: 26 Noviembre 2012, 20:43 »

Me ha dado dolores de cabeza porque hay muy poca documentación.
La idea de la primera función fue de LeandroA... (tiene solución para todo)

DoEvents! :P
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  
Powered by SMF 1.1.19 | SMF © 2006-2008, Simple Machines