Mensajes

segun te leo la respuesta ya la tienes ¬¬ solo piensa como?

bien si eso es hacer 2 donexiones a las 2 bases de datos despues enlistas las tablas y de estas los campos y despues un bucle que vacia los datos X a la otra base de datos.

1 Enlista las tablas
2 Enlista los Campos
3.0--> inicia un bucle de la 1ra tabla hasta la ultima pero dentro de este bucle has = uno de los campos y dentro de este los campos que se depositan de una tabla a la otra

variabledebd1=variabledebd2

No se si aya otra forma por medio de SQL si es asi entonces buscarias algo de SQL para implementarlo en VB

P.D.: creo que tendras que buscar alo de lenguaje Sql para crear los campos en la otra tabla si es que no los tiene la tabla destino si no te apareceria un error.

Solo es cuestion de pensar un poco e informasece...

Estoy haciendo un programa que recorra webs automaticamente y necesito saber como puedo hacer que tome el destino de un hipervinculo seleccionado con tabulador y lo guarde en una variable.
No se si me explico bien.
Mas o menos en crudo seria algo como esto..
Tabulando se iria saltando por los hipervinculos del sitio, y cuando se llegue al hipervinculo que contiene el enlace a http://foro.elhacker.net realize una determinada accion, por ejemplo.
Muchas gracias.

es algo asi como enlistar los links a donde te liga x pagina no? si es asi...

busca el texto en el codigo fuente  <a href=   y lo que esta enfrente de esta lo sacas ya sea con spli() o idenfiticando el termino de la liga...  Nesesitas saber el formato de HTML para hacer esto

<a href="" target ....> texto </a>

reafirmo nesesitas saber el formato completo de una liga en HTML (<a href=></a>)

Buscar en una Carpeta pero no en subacaretas:

Código (vb) [Seleccionar] Expandir


Tambien con Like mas la funcion Dir() puedes buscar no recuerdo bien je.


Buscar en un director X y tambien en subcarpetas

Código (vb) [Seleccionar] Expandir


'   Variable que utilizare para cancelar la busqueda de los archivos
Public Cancelar As Boolean

'   Para las busquedas de todos los archivos
Dim Spli, Count, Total  '   Lo que se Busca, Cuantos, Total de los archivos encontrados
Dim Cant()              '   Cantidad de cada archivo encontrado (en ste caso lo que sea parcial o extensiones)

Public Sub Buscar1(Formulario As Object, Directorio As String, A_buscar As String, Optional No_Directorios As String)
    Dim i, ass
    i = 0
    Spli = Split(A_buscar, ",")
    On Error GoTo Ok:
    For i = 0 To 101
        ass = Spli(i)
        Count = i
    Next i
Ok:
    ReDim Cant(0 To Count)
    Formulario.Label1(1).Caption = ""
    Total = 0
    For i = 0 To Count
        'Cant(i) = Spli(i)
        Cant(i) = 0
        Formulario.Label1(1).Caption = frm_main.Label1(1).Caption & Spli(i) & ": " & Cant(i) & " "
        Total = Total + Cant(i)
    Next
    frm_main.Label1(1).Caption = frm_main.Label1(1).Caption & " |" & Total & " Encontrados"
    Archivos (Directorio)
End Sub
Public Sub Archivos(Directorio As String)
    Dim FSO, F, sf, F1
    Set FSO = CreateObject("Scripting.FileSystemObject")    '   Creo el objeto
    Set F = FSO.getfolder(Directorio)                       '   Obtenemos el directorio plano
    Set sf = F.SubFolders                                   '   Obtenemos los subfolders del directorio plano actual
    'SubDirectorios (Directorio)                            '   obtenemos los archivos del directorio a scanear

    '   Apartir de aqui se empiesan a explorar todos los SubDirectorios (SubCarpetas)
    On Error Resume Next
    For Each F1 In sf
        DoEvents
        frm_dat.lbl_ruta(0).Caption = F1.Path
If Cancelar = True Then Exit Sub                            '   Codigo para cancelar la busqueda de archivos y todo en general
        SubDirectorios (F1.Path)                            '   Obtengo el SubDirectorio y lo cambio
If Cancelar = True Then Exit Sub                            '   Codigo para cancelar la busqueda de archivos y todo en general
        Archivos (F1.Path)                                  '   Obtengo los archivos del subDirectorio actual
If Cancelar = True Then Exit Sub                            '   Codigo para cancelar la busqueda de archivos y todo en general
    Next
    '   Fin
End Sub
Public Sub SubDirectorios(Directorio As String)
    Dim FSO, F, sf, F1, ext, i, a
    i = 0
    Set FSO = CreateObject("Scripting.FileSystemObject")    '   Creo el objeto
    Set F = FSO.getfolder(Directorio)                       '   Obtengo el directorio Plano
    Set sf = F.Files                                        '   Obtengo TODOS los archivos del directorio plano sin ecepción
    '   Apartir de aquí obtengo Todos los archivos sin ecepción
    On Error Resume Next
    For Each F1 In sf
        ext = FSO.GetExtensionName(F1.Path)
If Cancelar = True Then Exit Sub                            '   Codigo para cancelar la busqueda de archivos y todo en general
        For i = 0 To Count
            If Spli(i) = ext Then
                Total = Total + 1
                Set NodX = frm_main.List.ListItems.Add(, , F1.Name) '   Visualiso los archivos en el formulario
                NodX.Tag = F1.Path                                  '   Visualiso los archivos en el formulario
                Cant(i) = Cant(i) + 1
                frm_main.Label1(1).Caption = ""
                For a = 0 To Count
                    frm_main.Label1(1).Caption = frm_main.Label1(1).Caption & Spli(a) & ": " & Cant(a) & " "
                Next a
                frm_main.Label1(1).Caption = frm_main.Label1(1).Caption & " |" & Total & " Encontrados"
            End If
        Next i
    Next
    'fin
End Sub


Si no te satisfacen estos ejemplos con objectos aca uno por via Api sacado de la WinApi

Código (vb) [Seleccionar] Expandir


'Create a form with a command button (command1), a list box (list1)
'and four text boxes (text1, text2, text3 and text4).
'Type in the first textbox a startingpath like c:\
'and in the second textbox you put a pattern like *.* or *.txt

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function

Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    'KPD-Team 1999
    'E-Mail: KPDTeam@Allapi.net
    'URL: http://www.allapi.net/

    Dim FileName As String ' Walking filename variable...
    Dim DirName As String ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer ' Number of directories in this path
    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "\" Then path = path & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD) '<------ el * es un comodin y buscara TODO igual busca archivos Zip sustituyendo el * por *.zip y de igual forma lo que sea tu desides ok espefimenta ja
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = StripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                dirNames(nDir) = DirName
                DirCount = DirCount + 1
                nDir = nDir + 1
                ReDim Preserve dirNames(nDir)
            End If
        End If
        Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
        Loop
        Cont = FindClose(hSearch)
    End If
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + 1
                List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
        ' Recursively walk into them...
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
        Next i
    End If
End Function
Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Text1.Text
    FindStr = Text2.Text
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub


bueno gente queria saber que necesito (API o le que sea) para comprobar si una cadena en el registro (Como en el registro parte del registro Run) exciste!?

Gracias!

mmm si mas no recuerdo es retornar un valor pero si no me devuelve nada o me da un error es que no existe.

PAra verificar que exteste llama a QueryValue

Espero te sirva...

En Un Modulo Clase:

Código (vb) [Seleccionar] Expandir


Option Explicit

Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4

'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003

Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259

Const KEY_ALL_ACCESS = &H3F

Const REG_OPTION_NON_VOLATILE = 0

Private Type FILETIME
            dwLowDateTime As Long
            dwHighDateTime As Long
End Type
'Public Enum ClavePredefinida
'    HKEY_CLASSES_ROOT = &H80000000
'    HKEY_CURRENT_USER = &H80000001
'    HKEY_LOCAL_MACHINE = &H80000002
'    HKEY_USERS = &H80000003
'End Enum

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition 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 RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData() As Byte, lpcbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String) As Boolean
' Descripción:
'   Esta función borra una clave y devuelve true si pudo borrarla o false si no pudo
'
' Sintaxis:
'   variable = DeleteKey (ClaveRaíz, NombreDeClave)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave que queremos borrar,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
' Nota :
'   En W95 borrará todas las subclaves de la clave eliminada, en NT no se puede borrar
'   una clave que tenga subclaves


    Dim lRetVal As Long      'resultado de la función SetValueEx
    Dim hKey As Long         'handle de la clave abierta
   
    'para borrar una clave debe estar abierta
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    'borramos la clave
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    DeleteKey = IIf(lRetVal = 0, True, False)
End Function
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String) As Boolean
' Descripción:
'   Esta función borra un valor y devuelve true si pudo borrarlo y false si no pudo
'
' Sintaxis:
'   variable = DeleteValue (ClaveRaíz, NombreDeClave, NombreDeValor)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave que contiene el valor que queremos borrar,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
'   NombreDeValor es el nombre del valor que queremos borrar

       Dim lRetVal As Long      'resultado de la función SetValueEx
       Dim hKey As Long         'handle de la clave abierta

       'abrimos la clave especificada
       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       'borramos el valor
       lRetVal = RegDeleteValue(hKey, sValueName)
       DeleteValue = IIf(lRetVal = 0, True, False)
       'la cerramos
       RegCloseKey (hKey)
End Function

Public Function EnumKey(lPredefinedKey As Long, sKeyName As String, vSubKeys As Variant) As Long
' Descripción:
'   Esta función busca todas las subclaves de una dada y forma una matriz con ellas en
'   el parámetro vSubKeys.
'
'   Si queremos saber las subclaves de una de las principales debemos dejar en blanco
'   el parámetro sKeyName
'
'   Devuelve el número de subclaves o -1 si hubo algún error
'
' Sintaxis:
'   variable = EnumKey (ClaveRaíz, NombreDeClave,SubClaves)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave cuyas subclaves queremos obtener,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
'   SubClaves es un variant que recogerá la matriz de subclaves obtenida

    Dim lRetVal As Long             'resultado de las funciones del API
    Dim hKey As Long                'handle de la clave abierta
    Dim sSubKeyName As String       'nombre de la subclave
    Dim lSubKeyLen As Long          'tamaño del nombre de la subclave
    Dim lMaxSubKeyLen As Long       'tamaño del nombre de subclave más grande
    Dim lNumSubKeys As Long         'número de subclaves existentes
    Dim ftLastWriteTime As FILETIME 'fecha última modif. de la clave (sólo NT)
    Dim lIndex As Long              'índice de la subclave
    Dim sSubClaves() As String      'matriz para contener las subclaves
   
    EnumKey = -1
    'si tenemos nombre de clave la abrimos
    If sKeyName <> "" Then
        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    Else
        hKey = lPredefinedKey
    End If
    'obtenemos el nº de subclaves y el tamaño máximo de sus nombres
    lRetVal = RegQueryInfoKey(hKey, 0&, 0&, 0&, lNumSubKeys, lMaxSubKeyLen, 0&, 0&, 0&, 0&, 0&, ftLastWriteTime)
    If lRetVal = 0 Then
        'si no encontré subclaves
        If lNumSubKeys = 0 Then
            EnumKey = 0
        Else
            EnumKey = lNumSubKeys
            lNumSubKeys = lNumSubKeys - 1       ' va de 0 a n-1
            lMaxSubKeyLen = lMaxSubKeyLen + 1   ' dejar sitio para el 0 de fin de string en c
            'dimensionamos la matriz
            ReDim sSubClaves(lNumSubKeys)
            'recorremos las subclaves (en orden inverso, como dice la ayuda ¿?)
            For lIndex = lNumSubKeys To 0 Step -1
                lSubKeyLen = lMaxSubKeyLen
                sSubKeyName = String(lMaxSubKeyLen, 0)
                lRetVal = RegEnumKeyEx(hKey, lIndex, sSubKeyName, lSubKeyLen, 0&, 0&, 0&, ftLastWriteTime)
                If lRetVal = 0 Then
                    sSubClaves(lIndex) = Left$(sSubKeyName, lSubKeyLen)
                Else
                    EnumKey = -1
                End If
            Next lIndex
        End If
    Else
        EnumKey = -1
    End If
    'devolvemos el resultado
    vSubKeys = sSubClaves()
    'cerramos la clave
    If sKeyName <> "" Then RegCloseKey (hKey)
End Function

Public Function EnumValue(lPredefinedKey As Long, sKeyName As String, vValues As Variant) As Long
' Descripción:
'   Esta función busca todos los valores de una clave y forma una matriz con ellos
'   en el parámetro vValues.
'
'   Si queremos saber las subclaves de una de las principales debemos dejar en blanco
'   el parámetro sKeyName
'
'   Devuelve el número de valores o -1 si hubo algún error
'
' Sintaxis:
'   variable = EnumValue (ClaveRaíz, NombreDeClave,Valores)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave cuyos valores y datos queremos obtener,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
'   Valores es un variant que recogerá la matriz de valores y datos obtenida

    Dim lRetVal As Long             'resultado de las funciones del API
    Dim hKey As Long                'handle de la clave abierta
    Dim sValueName As String        'nombre del valor
    Dim lValueNameLen As Long       'tamaño del nombre del valor
    Dim lMaxValueNameLen As Long    'tamaño del nombre de valor más grande
    Dim lNumValues As Long          'número de valores existentes
    Dim bValueData(500) As Byte     'byte para obtener el dato del valor, no funciona?
    Dim lValueSize As Long          'longitud del array anterior
    Dim ftLastWriteTime As FILETIME 'fecha última modif. del valor (sólo NT)
    Dim lIndex As Long              'índice del valor
    Dim vValores() As String        'matriz para contener los valores
   
    EnumValue = -1
    'si tenemos nombre de clave la abrimos
    If sKeyName <> "" Then
        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    Else
        hKey = lPredefinedKey
    End If
   
    'obtenemos el nº de valores y el tamaño máximo de sus nombres
    lRetVal = RegQueryInfoKey(hKey, 0&, 0&, 0&, 0&, 0&, 0&, lNumValues, lMaxValueNameLen, 0&, 0&, ftLastWriteTime)
    If lRetVal = 0 Then
        'si no encontré valores
        If lNumValues = 0 Then
            EnumValue = 0
        Else
            EnumValue = lNumValues
            lNumValues = lNumValues - 1 'va de 0 a n-1
            lMaxValueNameLen = lMaxValueNameLen + 1 'para que quepa el 0 de fin de cadena en C
            'dimensionamos la matriz
            ReDim vValores(lNumValues)
            'recorremos los valores (en orden inverso, como dice la ayuda ¿?)
            For lIndex = lNumValues To 0 Step -1
                lValueNameLen = lMaxValueNameLen
                sValueName = String(lMaxValueNameLen, 0)
                lValueSize = 500
                'no me funciona si no pongo un array de bytes para recoger el resultado,
                'aunque luego no me lo da¿?. Si pones una longitud menor de lo que ocupa
                'el dato tampoco funciona, por eso puse 500 bytes
                lRetVal = RegEnumValue(hKey, lIndex, sValueName, lValueNameLen, 0&, 0&, bValueData(), lValueSize)
                If lRetVal = 0 Then
                    vValores(lIndex) = Left$(sValueName, lValueNameLen)
                Else
                    EnumValue = -1
                End If
            Next lIndex
        End If
    Else
        EnumValue = -1
    End If
    'devolvemos el resultado
    vValues = vValores()
    'cerramos la clave
    If sKeyName <> "" Then RegCloseKey (hKey)

End Function
Private Function SetValueEx(ByVal hKey As Long, sValueName As String, ltype As Long, vValue As Variant) As Long
'
' Función utilizada por SetValue, no debemos llamarla directamente
'
    Dim lValue As Long
    Dim sValue As String

    Select Case ltype
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, ltype, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, ltype, lValue, 4)
    End Select

End Function
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
'
' Función utilizada por QueryValue, no debemos llamarla directamente
'
    Dim cch As Long
    Dim lrc As Long
    Dim ltype As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError


    ' Determinar el tipo de datos y el tamaño que debemos leer

    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, ltype, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case ltype
        ' Para strings
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, ltype, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch - 1)
            Else
                vValue = Empty
            End If

        ' Para DWORDS (long)
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, ltype, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'no están soportados otros tipos
            lrc = -1
    End Select

QueryValueExExit:

    QueryValueEx = lrc
    Exit Function

QueryValueExError:

    Resume QueryValueExExit

End Function
Public Function SetValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long) As Boolean
' Descripción:
'   Esta función crea y/o modifica el dato contenido en un valor y devuelve true si lo
'   modificó o false si no pudo
'   Si no existen la clave y/o subclaves las crea
'
' Sintaxis:
'   variable = SetValue (ClaveRaíz, NombreDeClave, NombreDeValor, NuevoDato, TipoDeDato)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave que contiene el valor que queremos recuperar,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
'   NombreDeValor es el nombre del valor que queremos crear o modificar

'   NuevoDato es el dato que queremos introducir en el valor
'
'   TipoDeDato debe ser REG_SZ (un string) o REG_DWORD (un long)

        Dim lRetVal As Long      'resultado de la función SetValueEx
        Dim hKey As Long         'handle de la clave abierta
       
        'abrimos la clave
        lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
        'si no pudimos abrirla la creamos
        If lRetVal <> 0 Then
             lRetVal = CreateNewKey(lPredefinedKey, sKeyName)
             lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
         End If
        'modificamos el dato del valor
        lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
        SetValue = IIf(lRetVal = 0, True, False)
        'cerramos la clave
        RegCloseKey (hKey)

End Function
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, Optional vDefault)
' Descripción:
'   Esta función devuelve los datos de un valor o Empty si no lo encontró
'   Si no existe el valor devuelve el de por defecto
'
' Sintaxis:
'   variable = QueryValue(ClaveRaíz, NombreDeClave, NombreDeValor)
'
'   ClaveRaíz debe ser HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave que contiene el valor que queremos recuperar,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")
'
'   NombreDeValor es el nombre del valor que queremos recuperar, si es null devolverá
'   el valor predeterminado de la clave (si existe)

    Dim lRetVal As Long      'resultado de las funciones del API
    Dim hKey As Long         'handle de la clave abierta
    Dim vValue As Variant    'datos del valor requerido
   
    'abrimos la clave
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    'obtenemos los datos del valor
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    If Not IsMissing(vDefault) And IsEmpty(vValue) Then
        QueryValue = vDefault
    Else
        QueryValue = vValue
    End If
    'cerramos la clave
    RegCloseKey (hKey)
End Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String) As Boolean
' Descripción:
'   Esta función crea una nueva clave y devuelve true si pudo crearla o false si no pudo
'
' Sintaxis:
'   variable = CreateNewKey (ClaveRaíz, NombreDeClave)
'
'   ClaveRaíz debe ser igual a HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   o HKEY_USERS
'
'   NombreDeClave es el nombre de la clave que queremos crear,
'   puede incluir subclaves (por ejemplo "Clave1\SubClave1")

    Dim hNewKey As Long         'handle a la nueva clave
    Dim lRetVal As Long         'resultado de la función RegCreateKeyEx
   
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    CreateNewKey = IIf(lRetVal = 0, True, False)
    'cerramos la clave
    RegCloseKey (hNewKey)
End Function
Public Property Get HKEY_USERS() As Long
    HKEY_USERS = &H80000003
End Property
Public Property Get HKEY_LOCAL_MACHINE() As Long
    HKEY_LOCAL_MACHINE = &H80000002
End Property
Public Property Get HKEY_CURRENT_USER() As Long
    HKEY_CURRENT_USER = &H80000001
End Property
Public Property Get TIPO_STRING() As Long
    TIPO_STRING = REG_SZ
End Property
Public Property Get TIPO_LONG() As Long
    TIPO_LONG = REG_DWORD
End Property
Public Property Get HKEY_CLASSES_ROOT() As Long
    HKEY_CLASSES_ROOT = &H80000000
End Property


Es obligatorio siempre usar ese Directorio "Plugins" o puede ser cualquier otro?... ya que al carga una dll como plugin con:

La linea que se utiliza para cargar las dll como plugins...¡!

Código (vb) [Seleccionar] Expandir



set plug = creteobject("miplugin.plugin") '<-- siento esta linea por defecto la carga de plugin de la carpeta Plugins sin haber sido espesificada anteriormente... carga la libreria "miplugin.dll"

ya lo demas de plug.comando <--- eso ya no es problema...¡!

P.D.: Este ya lo lo pregunte y naaadie me contesto ¬¬ ---> post donde pregunte esto.... (Duda con Manejo de Plugins <--- aunque creo qe no puse bien mi pregunta ja [la de rojo de arribita])

bueno esta es mi gran duda:

cuando se manejan plugins o bueno la carga de librerias en vb6 afuerzas deberian estar dentro de una carpeta llamada plugins ¬¬?

Antiguo Post de manejo de plugins en VB6

bueno aca reduje el codigo a practicamente nada:

bueno aca esta Simplificado ¬¬

Código (vb) [Seleccionar] Expandir


    Set plug = CreateObject("miplugin.plugin")
    plug.AbrirPlugin Me


la parte del codigo original del ejemplo:

Código (vb) [Seleccionar] Expandir


Public Sub CargarPlugins()
'On Error GoTo error:
Dim dll$, temp$, obj
Dim i As Integer
Subfolders (App.path & "\plugins\") '<-------- si la cambio me salen errores y ademas no carga las dll como plugins ¬¬
  For i = 0 To a - 1
         dll = NplugIns(i)
         MsgBox dll
         dll = Left(dll, Len(dll) - 4) 'quita ".dll" del nombre
        temp = dll & "." & "plugin"
        Set obj = CreateObject(temp) 'se crea el plugin
        Call Agregar(ListaDePlugins, temp, obj.NombrePlugin)
         DoEvents
   Next i
ListaDePlugins(0).Visible = False 'Desaparecemos el primer elemento
Exit Sub
error:
    'MsgBox "Error al cargar un plugin. Puede que no esté corretamente registrado.", , "Error"
End Sub


---------------------------------

Y se supone que en ese ejemplo se cargan los plugins de la carpeta indicada (en este caso "directorioActual/plugins") bueno yo la cambio (por ejemplo a "D:\data\plugins" siendo que mi exe este en "D:\") y nada de nada ¬¬ afuerzas solo me agarran con la carpeta "plugins" y q esta este en el directorio de mi compilado.

mis interrogantes son:

¿?Se puede cambiar dicha carpeta¿?
¿?Si es asi como¿?

gracias de antemano.

vi un ejemplo de esto hace tiempo solo te dire que si se puede lo unico malo es que nesesitas otra computadora a lo que recuerdo...

Aca te dejo un Ejemplo: es lo mas sencillo que pude hacerlo ok...

Descargar Micro Chat

aa cuando lo ejecutes solo debes estabecer primeramente el servidor y el cliente primero enciendes el servidor y despues conectas el cliente y veras que pasa saludos...

Descargando...

Buen aporte me servira paragenerar algun dia yo mis seriales asi no tendre que llenar mi pc de keygens y demas. xD

La pongo por que no todos nos la podriamos saber ¬¬!.

Bueno esto lo acabo de entrontrar ojala y les sirva de algo en un futuro. ( Yo solo conocia la funcion Call no esta ja  )

Poner en un formulario o donde deseen.

3 Textbox llamados

Código [Seleccionar] Expandir


Text1
Text2
Text3
mas un Commanbutton llamado Command1


Código (vb) [Seleccionar] Expandir


Public Function Divide(arg1 As Long, arg2 As Long)
    Divide = arg1 / arg2
End Function
Public Function Multiplica(arg1 As Long, arg2 As Long)
    Multiplica = arg1 * arg2
End Function
Private Sub Command1_Click()
    MsgBox CallByName(Me, Text1.Text, VbMethod, Text2.Text, Text3.Text)
End Sub


  Escribir en el text1  el nombre de la Funcion y clickear en el boton