Mensajes

[PRUEBA UNO:]

Mirad, hice unas pruebas con esta función:

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Const HKEY_CURRENT_USER     As Long = &H80000001
Private Const KEY_WRITE             As Long = &H20006
Private Const REG_SZ                As Long = &H1

Public Function PutOnStartUp(ByVal sPath As String) As Boolean
Dim hRegkey                         As Long

    If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", 0, KEY_WRITE, hRegkey) = 0 Then
        sPath = sPath & vbNullChar
        PutOnStartUp = RegSetValueEx(hRegkey, "My App", 0, REG_SZ, ByVal sPath, Len(sPath)) = 0
        RegCloseKey hRegkey
    End If
End Function



PRUEBA UNO:

Código (vb,6) [Seleccionar] Expandir

Private Sub Form_Load()
Dim sPath      As String

    sPath = App.Path & "\" & App.EXEName & ".exe"
   
    If PutOnStartUp(sPath) Then
        Me.BackColor = vbGreen
    Else
        Me.BackColor = vbRed
    End If
   
    Me.AutoRedraw = True
    Me.Print sPath
End Sub

• Compilo en el escritorio.
• Lo ejecuto.
• Reinicio y efectivamente, se ha ejecutado correctamente desde mi escritorio

PRUEBA DOS:

Código (vb,10) [Seleccionar] Expandir

Private Sub Form_Load()
Dim sPath      As String
Dim sDest      As String

    sPath = App.Path & "\" & App.EXEName & ".exe"
    sDest = Environ("tmp") & "\Test.exe"
   
    FileCopy sPath, sDest
   
    If PutOnStartUp(sDest) Then
        Me.BackColor = vbGreen
    Else
        Me.BackColor = vbRed
    End If
   
    Me.AutoRedraw = True
    Me.Print sPath
End Sub

• Compilo en el escritorio.
• Lo ejecuto.
• Compruebo que se ha copiado en la carpeta temporal
• Borro el del escritorio por si las moscas.
• Reinicio y... ¡CRASH!

Error 70: Permiso denegado

¿Qué pasa aquí?

DoEvents!

Tengo Windows 7.

Copio mi exe en la carpeta de inicio, reinicio, pero no se ejecuta.
También he probado a añadir una clave en el registro y nada...
Puede ser porque mi exe requiere permisos de administrador pues si creo un programa que tan sólo te muestre un MsgBox funciona con cualquiera de los métodos anteriores...

¿Alguna solución? ???

DoEvents!

[C&P]

o quizas el error esta dentro de la funcion RC4 que llamas.

No creo, en ese caso le saltaría en dicha función.

Y si es:

Código [Seleccionar] Expandir

Error 424 en tiempo de ejecución. Se requiere un objeto.

Lo más seguro es que haya hecho C&P y se haya olvidado de cambiar el nombre del Textbox.

DoEvents!

[txtkey]

Seguramente no tienes un TextBox llamado txtkey...

DoEvents!

Es que casi necesito un ábaco para contar las líneas que quiero destacar. 

DoEvents!

¿Dónde se localiza ese objeto que se mueve?, ¿es de un juego?, ¿está en tu navegador? ...

DoEvents!

[LeandroA]

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!

Lo solucioné y comparto el código porque soy buena persona.

Código [Seleccionar] Expandir

http://foro.elhacker.net/programacion_visual_basic/src_getsharesubfolders-t377004.0.html

DoEvents!

[OPCIÓN 1:]

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 (vb) [Seleccionar] Expandir


Option Explicit
'===========================================================================
' º Name        : GetSharedSubFolders
' º Author      : Psyke1
' º Mail        : vbpsyke1@mixmail.com
' º Explanation : Returns an array with the subfolders of a shared folder.
' º Date        : 26/11/12
' º Reference   : http://goo.gl/sgDVX
' º Greets      : LeandroA
' º Visit       :
'    * http://foro.h-sec.org
'    * http://infrangelux.sytes.net
'===========================================================================

Public Function getSharedSubFolders(ByVal sServer As String) As Collection
Dim oShell                  As Object
Dim oItem                   As Variant
   
   If PathIsNetworkPath(sServer) Then
      Set oShell = CreateObject("Shell.Application")
   
      If Not oShell.NameSpace(CVar(sServer)) Is Nothing Then
         Set getSharedSubFolders = New Collection
       
         For Each oItem In oShell.NameSpace(CVar(sServer)).Items
             getSharedSubFolders.Add oItem.Path
         Next oItem
      End If
   End If
End Function


Ejemplo de uso:

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
Dim vFolder                 As Variant
Dim cTmp                    As Collection

   Set cTmp = getSharedSubFolders("\\CARLOS-PC")
   If cTmp Is Nothing Then
       MsgBox "El servidor local no existe"
   Else
       For Each vFolder In cTmp
           Debug.Print vFolder
       Next
   End If
End Sub



OPCIÓN 2:

Código (vb) [Seleccionar] Expandir


Option Explicit
'===========================================================================
' º Name        : mGetSharedSubFolders.bas
' º Author      : Psyke1
' º Mail        : vbpsyke1@mixmail.com
' º Explanation : Returns an array with the subfolders of a shared folder.
' º Date        : 26/11/12
' º Visit       :
'    * http://foro.h-sec.org
'    * http://infrangelux.sytes.net
'===========================================================================

'Type
Private Type NETRESOURCE
 dwScope       As Long
 dwType        As Long
 dwDisplayType As Long
 dwUsage       As Long
 lpLocalName   As Long
 lpRemoteName  As Long
 lpComment     As Long
 lpProvider    As Long
End Type

'kernel32.dll
Private Declare Function lstrlenA Lib "kernel32.dll" (ByVal pString As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32.dll" (ByVal lpString1 As String, ByVal pString As Long) As Long

'mpr.dll
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
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As NETRESOURCE, lpBufferSize As Long) As Long

'shlwapi.dll
Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" Alias "PathIsNetworkPathA" (ByVal pszPath As String) As Long

'Consts
Private Const RESOURCE_GLOBALNET        As Long = &H2
Private Const RESOURCETYPE_DISK         As Long = &H1
Private Const MAX_RESOURCES             As Long = &H100

'Function
Public Function getShareSubFolders(ByVal sNameServer As String) As String()
Dim hEnum                               As Long
Dim lLen                                As Long
Dim lTotal                              As Long
Dim lpRName                             As Long
Dim sRet()                              As String
Dim tNet(0 To MAX_RESOURCES)            As NETRESOURCE

   If PathIsNetworkPath(sNameServer) Then
       lTotal = -1
       lLen = &H1000 '(UBound(tNet) * Len(tNet(0))) / 2
       
       tNet(0).lpRemoteName = StrPtr(StrConv(sNameServer, vbFromUnicode))
       
       If Not WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, tNet(0), hEnum) Then
           If Not WNetEnumResource(hEnum, lTotal, tNet(0), lLen) Then
               If lTotal > 0 Then
                   lTotal = lTotal - 1
                   ReDim sRet(0 To lTotal) As String
                   
                   For lLen = 0 To lTotal
                       lpRName = tNet(lLen).lpRemoteName
                       
                       sRet(lLen) = Space(lstrlenA(lpRName))
                       lstrcpyA sRet(lLen), lpRName
                   Next lLen
               End If
           End If
           
           WNetCloseEnum hEnum
       End If
   End If
   
   getShareSubFolders = sRet()
End Function

Ejemplo de uso:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Load()
Dim vSubFolder                          As Variant
Dim sSF()                               As String

   sSF = getShareSubFolders("\\CARLOS-PC")

   If Not Not sSF Then

       For Each vSubFolder In sSF
           Debug.Print vSubFolder
       Next vSubFolder
   End If
   
   'fix NotNot hack :)
   Debug.Assert App.hInstance
End Sub

DoEvents!

Pues eso... me es muy cómodo a la hora de buscar una sección concreta en un código.
¿Qué opináis?

DoEvents!