queria agregar a un programita q estoy haciendo
un textbox en donde al apretar un boton me muestre la clave del windows xp y vista
segun lo q creo es leyendo esta clave
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\WPAEvents]
"OOBETimer"=hex:fe,e5,71,d6,8b,6a,8d,6f,d5,33,93,jd
pero no se como pasar ese numero hexa a letras...porque al hacerlo me muestra signos como:
Ö
ÿ
gracias
hola tenes que leerlo como Binary con: RegOpenKey (http://allapi.mentalis.org/apilist/4E1AB36884B253CE24768DA1C4080A14.html)
yo uso esto para leer claves en el registro
Private Sub painicio()
'lee el registro y carga la paginad e inicio de IE
Dim objShell As Object
Set objShell = CreateObject("Wscript.Shell")
Text2.Text = objShell.RegRead("HKCU\SOFTWARE\Microsoft\Internet Explorer\Main\Start Page")
Set objShell = Nothing
End Sub
esta me lee la pagina de inico de internet explorer y la muestra en un text2.txt
como lo podria ahcer con esto?¿
yo te diria que es mejor hacerlo con API, usa el ejemplo que te pase ahi, solo tenes que agregar esta constante a ese code
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
gracias! pero me gustaria algo mas simple si se puede
es q hace poco empese a programar
asi q si a alguien se le ocurre algo ....
de nuevo gracias
usando api ovbias el tener que usar referencia a Script Host
ejemplo del API-Guide:
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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
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
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Ret = GetString(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\WPAEvents", "OOBETimer")
If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
aca te pongo un módulo clase para manipular el registro muy completo: Lightning! Registry (http://www.pscode.com/vb/scripts/ShowCode.asp?txtCodeId=63220&lngWId=1)
claro es parecido a lo q probe recien yo con la info q me diste
pero me develve un valo numerico
no es a lo q me referia...yo queria q me de la clave de windows
ej: jtsnf-aset3-gf5gy-4fswf-fe234
se entiende?
se puede hacer?
es que el serial de Windows no esta en esa clave
mmm me parece q no nos entedimos
si ahi esta el serial de windows graurdado como dato en esa clave de registro
pero esta guardado en HEXADECIMAL
yo lo se pasar a ascii manualmente pero no desde VB
eso es lo q necesito
ej: que le programa te tire un msjbox "su clave actual es jtsnf-aset3-gf5gy-4fswf-fe234"
gracias igual por tu ayuda
si ya se, hice un programa para cambiar el serial de XP, y se que en esa clave no esta el serial de XP, esa clave OOBETimer se usa para otra cosa. solo que no se si puedo poner el codigo aca. busca en Planet Source code (http://www.planet-source-code.com/vb/default.asp?lngWId=1) que hay vas a encontrar lo que buscas
tenes razon q no era ahi!
mis disculpas jejejeje
ahora entro a esa pag q me pasaste
y gracias denuevo
pues no lo pude encontrar :S
si alguien sabe como ahcerlo me peude pasar el codigo fuente x mail o mensj privado
gracias
' Module: mWinProdKey
http://www.advancevb.com.ar (http://www.advancevb.com.ar)
alguien sabe como pasar esto a vb6 y que la clave nueva q se va a poner se lea desde un textbox?
encontre esto en la pagina de microsoft (es un .vbs)
CitarON ERROR RESUME NEXT
if Wscript.arguments.count<1 then
Wscript.echo "Script can't run without VolumeProductKey argument"
Wscript.echo "Correct usage: Cscript ChangeVLKey.vbs ABCDE-FGHIJ-KLMNO-PRSTU-WYQZX"
Wscript.quit
end if
Dim VOL_PROD_KEY
VOL_PROD_KEY = Wscript.arguments.Item(0)
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any
for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
result = Obj.SetProductKey (VOL_PROD_KEY)
if err <> 0 then
WScript.Echo Err.Description, "0x" & Hex(Err.Number)
Err.Clear
end if
Next
y se usa asi
Citar
1. guardar el scrit en c:\changevlkeysp1.vbs
2. Haga clic en Inicio y, a continuación, haga clic en Ejecutar.
3. En el cuadro Abrir, escriba el comando siguiente, donde AB123-123AB-AB123-123AB-AB123 es la nueva clave del producto que desea utilizar y haga clic en Aceptar:
c:\changevlkeysp1.vbs ab123-123ab-ab123-123ab-ab123
gracias
Aquí tienes un código que funciona a la perfección con lo que quieres.
Public Declare Function RegCloseKey Lib "ADVAPI32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegOpenKey Lib "ADVAPI32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public 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.
Public Const REG_BINARY = 3
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_SUCCESS = 0&
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
' //ClaveWindows//
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
' Obtener la clave de Windows.
'#++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++#
Public Function ClaveWindows() 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
ClaveWindows = ""
Exit Function
End If
Else
ClaveWindows = ""
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
ClaveWindows = sCDKey
End Function
Ejemplo de uso:
MsgBox ClaveWindows
o
Dim sClave As String
sClave = ClaveWindows
MsgBox sClave
Saludos ;)
Public Sub NewSerial(VOL_PROD_KEY As String)
'Dim VOL_PROD_KEY As String
Dim Obj As Object
Dim result As Variant
VOL_PROD_KEY = UCase(VOL_PROD_KEY)
VOL_PROD_KEY = Replace(VOL_PROD_KEY, "-", "") 'remove hyphens if any
For Each Obj In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("win32_WindowsProductActivation")
result = Obj.SetProductKey(VOL_PROD_KEY)
Next
End Sub
este codigo es de Cobein funciona de maravilla
' '---------------------------------------------------------------------------------------
' Module : mWinProdKey
' DateTime : 12/09/2008 18:00
' Author : Cobein
' Mail : cobein27@hotmail.com
' WebPage : http://www.advancevb.com.ar
' Purpose : Retrieve Window$ CDKey
' Usage : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'
' Reference : based on code from an unknown author, posted by KANO on HH
'
' History : 12/09/2008 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Public Function WinProdKey() As String
Dim lhKey As Long
Dim bvBuffer(163) As Byte
Dim vCharset As Variant
Dim bvChar(23) As Byte
Dim i As Long
Dim j As Long
Dim lCur As Long
If RegOpenKey(&H80000002, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lhKey) = 0& Then
If RegQueryValueEx(lhKey, "DigitalProductId", 0, 3, bvBuffer(0), 164) = 0 Then
Call CopyMemory(bvBuffer(0), bvBuffer(52), &HF)
vCharset = Array( _
"B", "C", "D", "F", "G", "H", "J", "K", "M", "P", "Q", "R", _
"T", "V", "W", "X", "Y", "2", "3", "4", "6", "7", "8", "9")
For i = 0 To 23
bvChar(i) = Asc(vCharset(i))
Next
For i = 24 To 0 Step -1
lCur = 0
For j = 14 To 0 Step -1
lCur = lCur * 256 Xor bvBuffer(j)
bvBuffer(j) = Int(lCur / 24)
lCur = lCur Mod 24
Next
WinProdKey = vCharset(lCur) & WinProdKey
If i Mod 5 = 0 And i <> 0 Then WinProdKey = "-" & WinProdKey
Next
End If
Call RegCloseKey(lhKey)
End If
End Function
Sub main()
MsgBox WinProdKey
End Sub
XCryptor, no cortes los creditos de Cobein... :-X
Cita de: Karcrack en 6 Abril 2009, 16:09 PM
XCryptor, no cortes los creditos de Cobein... :-X
Siempre lo hace:. :¬¬ :¬¬ :¬¬ :xD
CitarXCryptor, no cortes los creditos de Cobein...
CitarSiempre lo hace
que pena no seleccione el codigo bien, ademas dice: este codigo es de Cobein, no lo ves ahi muy claro, y ya modifique el source. y para ricardovinzo a ver donde he ripeado codigo, muestramelo quiero ver algun post donde haya ripeado codigo o donde no haya colocado al autor.
no puedes decirlo sin pruebas.
saludos
PD: y esto es lo que uno se gana por querer colaborar que le digan code ripper o script kiddie !al carajo¡ :¬¬
Cita de: XcryptOR en 6 Abril 2009, 18:47 PM
CitarXCryptor, no cortes los creditos de Cobein...
CitarSiempre lo hace
que pena no seleccione el codigo bien, ademas dice: este codigo es de Cobein, no lo ves ahi muy claro, y ya modifique el source. y para ricardovinzo a ver donde he ripeado codigo, muestramelo quiero ver algun post donde haya ripeado codigo o donde no haya colocado al autor.
no puedes decirlo sin pruebas.
saludos
PD: y esto es lo que uno se gana por querer colaborar que le digan code ripper o script kiddie !al carajo¡ :¬¬
Nadie dijo que lo hicieras intencionado no? :¬¬
alguien sabe a aprtir del codigo q me paso xkiz en donde se introduce la nueva key?¿?¿
CitarPublic Sub NewSerial(VOL_PROD_KEY As String)
'Dim VOL_PROD_KEY As String
Dim Obj As Object
Dim result As Variant
VOL_PROD_KEY = UCase(VOL_PROD_KEY)
VOL_PROD_KEY = Replace(VOL_PROD_KEY, "-", "") 'remove hyphens if any
For Each Obj In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("win32_WindowsProductActivation")
result = Obj.SetProductKey(VOL_PROD_KEY)
Next
End Sub
o algun otro codigo para cambiar la clave?gracias
Cita de: xkiz en 6 Abril 2009, 11:36 AM
si ya se, hice un programa para cambiar el serial de XP, y se que en esa clave no esta el serial de XP, esa clave OOBETimer se usa para otra cosa. solo que no se si puedo poner el codigo aca. busca en Planet Source code (http://www.planet-source-code.com/vb/default.asp?lngWId=1) que hay vas a encontrar lo que buscas
Hola xkis, ahora me pusiste en la duda, no se puede cambiar el serial de windows ???... si es así porque Microsof dejaría
msoobe.exe /a en
system32\oobe...
PD: alguien sabe si es legal cambiar el serial de windows ???
sisi se puede
CitarCitar
ON ERROR RESUME NEXT
if Wscript.arguments.count<1 then
Wscript.echo "Script can't run without VolumeProductKey argument"
Wscript.echo "Correct usage: Cscript ChangeVLKey.vbs ABCDE-FGHIJ-KLMNO-PRSTU-WYQZX"
Wscript.quit
end if
Dim VOL_PROD_KEY
VOL_PROD_KEY = Wscript.arguments.Item(0)
VOL_PROD_KEY = Replace(VOL_PROD_KEY,"-","") 'remove hyphens if any
for each Obj in GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf ("win32_WindowsProductActivation")
result = Obj.SetProductKey (VOL_PROD_KEY)
if err <> 0 then
WScript.Echo Err.Description, "0x" & Hex(Err.Number)
Err.Clear
end if
Next
y se usa asi
Citar
1. guardar el scrit en c:\changevlkeysp1.vbs
2. Haga clic en Inicio y, a continuación, haga clic en Ejecutar.
3. En el cuadro Abrir, escriba el comando siguiente, donde AB123-123AB-AB123-123AB-AB123 es la nueva clave del producto que desea utilizar y haga clic en Aceptar:
c:\changevlkeysp1.vbs ab123-123ab-ab123-123ab-ab123
asi lo cambie yo
ademas de q tengo 2 programas q te lo hacen
lo q quiero es incluir en mi progama tmb esa opcion
ante tu duda con "msoobe" lo q te peudo decir es q al alterar algun valor de esa clave de registro el asistente para activar windows se volvera a activa y te permitira cambiar la clave, sino t va a decir: "su windows ya esta activado" y no t va a dejar hacer ninguna accion
la key de windows se encuentra en otra clave de registro
y debe ser legal porque hasta en la pagina de microsoft hay explicadas formas de como cambiar la clave
saludos
Public Sub NewSerial(VOL_PROD_KEY As String)
'Dim VOL_PROD_KEY As String
'El valor de la key se le pasa como parámetro
Dim Obj As Object
Dim result As Variant
VOL_PROD_KEY = UCase(VOL_PROD_KEY)
'Se cambian las letras/numeros a mayusculas
VOL_PROD_KEY = Replace(VOL_PROD_KEY, "-", "") 'remove hyphens if any
'Se reemplazan los guiones "altos"
For Each Obj In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("win32_WindowsProductActivation")
'Se utiliza WMI para acceder a la clase correspondiente
result = Obj.SetProductKey(VOL_PROD_KEY)
'Se cambia la key de win y se almacena el resultado en una variable
Next
End Sub
Saludos
y pero en q parte ponemos la nueva keyy??¿
aparte cuando llamo a la rutina me dice
Citarel valor no es opcional
no entiendo :S
Cita de: guidosl en 6 Abril 2009, 19:33 PM
sisi se puede
Sí guidos, ya se que se puede, quería saber si es legal cambiarlo ???
Citary debe ser legal porque hasta en la pagina de microsoft hay explicadas formas de como cambiar la clave
Cita de: guidosl en 6 Abril 2009, 19:36 PM
y pero en q parte ponemos la nueva keyy??¿
no entiendo :S
Hás leído algo de lo que he completado? Tercera línea :¬¬
Citar'El valor de la key se le pasa como parámetro
Por que no va a ser legal? puedes comprar otra y cambiar la actual :rolleyes:
ya esta graciassss!!!!
otra consultita alguien sabe como hacer apra q cuando se complete la cantidad maxima de caracteres q acepta un textbox se pase directamente al textbox siguiente para seguir escribiendo??
gracias
Exacto, ahora si te cuesta entender eso, te recomiendo que antes de ponerte a hacer cualquier cosa, te pases por algún tuto básico de VB :silbar:
Saludos
Cita de: Novlucker en 6 Abril 2009, 19:34 PM
Public Sub NewSerial(VOL_PROD_KEY As String)
'Dim VOL_PROD_KEY As String
'El valor de la key se le pasa como parámetro
Dim Obj As Object
Dim result As Variant
VOL_PROD_KEY = UCase(VOL_PROD_KEY)
'Se cambian las letras/numeros a mayusculas
VOL_PROD_KEY = Replace(VOL_PROD_KEY, "-", "") 'remove hyphens if any
'Se reemplazan los guiones "altos"
For Each Obj In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("win32_WindowsProductActivation")
'Se utiliza WMI para acceder a la clase correspondiente
result = Obj.SetProductKey(VOL_PROD_KEY)
'Se cambia la key de win y se almacena el resultado en una variable
Next
End Sub
Saludos
Bueno, bien que yo la estaba haciendo bien larga para cambiar la key, este code parece bien directo, gracias por el aporte
NovluckerSaludos
Naaa, el code lo dejó xkiz, yo solo lo comenté para que se entendiera.
Tener en cuenta que este hace uso de WMI, para lo cual se deben de tener permisos de admin, pero igualmente para cambiar la clave hay que tenerlos, así que en este caso da igual :P
Saludos
otra consultita alguien sabe como hacer apra q cuando se complete la cantidad maxima de caracteres q acepta un textbox se pase directamente al textbox siguiente para seguir escribiendo??
graciass
Cita de: Novlucker en 6 Abril 2009, 20:05 PM
Naaa, el code lo dejó xkiz, yo solo lo comenté para que se entendiera.
Tener en cuenta que este hace uso de WMI, para lo cual se deben de tener permisos de admin, pero igualmente para cambiar la clave hay que tenerlos, así que en este caso da igual :P
Saludos
Tenes toda la razon, entre tantos mensajes se me pasó, gracias por el aporte
xkis
Private Sub TextBox1_Change()
If Len(TextBox1.Text) = TextBox1.MaxLength Then
TextBox2.SetFocus
End If
End Sub
graciassss
y una ultima preguntita yo puse para q ingrese la clave 5 textbox diferentes
queria sabar si se peude q copien la clave completa y q al pegarla en el 1er textbox se completen los 5
osea q tomen cada "-" como cambio de textbox
gracias denuevo
Ok repito, lee un tuto, te evitarás MUCHAS preguntas ;)
Algo así:
Private Sub TextBox1_Change()
If Len(TextBox1.Text) = 29 Then
claves = Split(TextBox1.Text, "-")
For i = 1 To 5
Controls("TextBox" & i).Text = claves(i - 1)
Next
End If
End Sub
Que gracia tiene si te hacemos todo el code? :rolleyes:
Saludos
Me queda una duda, antes de modificar la key no hay que crear una nueva ID ???
HKEY_LOCAL_MACHINE SOFTWARE\Microsoft\Internet Explorer\Registration\ProductId
CitarPrivate Sub TextBox1_Change()
If Len(TextBox1.Text) = 29 Then
claves = Split(TextBox1.Text, "-")
For i = 1 To 5
Controls("TextBox" & i).Text = claves(i - 1)
Next
End If
End Sub
declare
Dim claves As String
pero i lo declare de varias formas y ninguna me sirvio
Dim i (5) As String
Dim i (1 to 5) as integer
Novlucker no es q no lea tutos ni nada...tampoco quiero q me hagan todo ustedes, yo si busco info x mi parte hago todo lo q me sale solo y lo q no bueno ahi pregunto...esto solo es una parte del programa q estoy haciendo, no me creas tan vago jajajaj
muchas graciass
Dim i As Integer
Dim claves() As String
si tmb habia probado jajaja
y no me salia pero em ahbia olvidado q era porque al primer textbox le habia puesto 5 como cantidad maxima de caracteres ;-)
PD: ademas estaria bueno incluirle las opciones para office y para windows vista, ahora me voy a poner a buscar info asi q si alguien puede hacer algun aporte sobre eso estaria bueno
ademas encontre un programita q se llama "microsoft genuine advantage diagnostic" q entre varias opciones q tiene una q me parecio copada fue q te chequea el "validation status" segun la clave q tengas y t dice si esta blokeada o no
no se como ahcerlo epro ya lo voy a descubir jajajaaca va como queda: (el codigo te dice la key actual, te dice el tipo de windows q tenes y el service pack, y permite cambiar la key)
5 textbox
1 timer(ponene el intervalo q quieran para q cheqee si cambia la key)
1 comandbutton (para realizar el cambio de la key)
2 labels
Citar
Option Explicit
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
Private Const REG_BINARY = 3
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1
' ruta del registro donde Windows guarda la clave (codificada) y la versión
Private Const RUTA_REGISTRO = "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion"
Private Sub Command1_Click()
On Error GoTo mal
Dim VOL_PROD_KEY As String
'El valor de la key se le pasa como parámetro
VOL_PROD_KEY = Text1.Text & Text2.Text & Text3.Text & Text4.Text & Text5.Text
Dim Obj As Object
Dim result As Variant
VOL_PROD_KEY = UCase(VOL_PROD_KEY)
'Se cambian las letras/numeros a mayusculas
VOL_PROD_KEY = Replace(VOL_PROD_KEY, "-", "") 'remove hyphens if any
'Se reemplazan los guiones "altos"
For Each Obj In GetObject("winmgmts:{impersonationLevel=impersonate}").InstancesOf("win32_WindowsProductActivation")
'Se utiliza WMI para acceder a la clase correspondiente
result = Obj.SetProductKey(VOL_PROD_KEY)
'Se cambia la key de win y se almacena el resultado en una variable
Next
Exit Sub
mal:
MsgBox "key ingrasada incorrecta"
End Sub
Private Function SacarClave() As String
Dim bID(164) As Byte, bKey(14) As Byte, bAsc(24) As Byte
Dim lBit As Long, hKey As Long
If RegOpenKey(HKEY_LOCAL_MACHINE, RUTA_REGISTRO, hKey) = 0 Then
If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bID(0), 164) = 0 Then
For lBit = 52 To 66
bKey(lBit - 52) = bID(lBit)
Next lBit
Else
MsgBox "No se puede leer la clave."
SacarClave = ""
Exit Function
End If
Else
MsgBox "No se puede acceder al registro."
SacarClave = ""
Exit Function
End If
'Descodificar la clave
bAsc(0) = Asc("B"): bAsc(1) = Asc("C"): bAsc(2) = Asc("D")
bAsc(3) = Asc("F"): bAsc(4) = Asc("G"): bAsc(5) = Asc("H")
bAsc(6) = Asc("J"): bAsc(7) = Asc("K"): bAsc(8) = Asc("M")
bAsc(9) = Asc("P"): bAsc(10) = Asc("Q"): bAsc(11) = Asc("R")
bAsc(12) = Asc("T"): bAsc(13) = Asc("V"): bAsc(14) = Asc("W")
bAsc(15) = Asc("X"): bAsc(16) = Asc("Y"): bAsc(17) = Asc("2")
bAsc(18) = Asc("3"): bAsc(19) = Asc("4"): bAsc(20) = Asc("6")
bAsc(21) = Asc("7"): bAsc(22) = Asc("8"): bAsc(23) = Asc("9")
Dim i As Integer, j As Integer, sClave As String
For lBit = 24 To 0 Step -1
i = 0
For j = 14 To 0 Step -1
i = i * 256 Xor bKey(j)
bKey(j) = Int(i / 24)
i = i Mod 24
Next j
sClave = Chr(bAsc(i)) & sClave
If lBit Mod 5 = 0 And lBit <> 0 Then sClave = "-" & sClave
Next lBit
SacarClave = sClave
Label1.Caption = SacarClave
End Function
Private Function VerVersion()
Dim lRet As Long
RegOpenKey HKEY_LOCAL_MACHINE, RUTA_REGISTRO, lRet
VerVersion = SacarValorRegistro(lRet, "ProductName")
RegCloseKey lRet
RegOpenKey HKEY_LOCAL_MACHINE, RUTA_REGISTRO, lRet
VerVersion = VerVersion & " - " & SacarValorRegistro(lRet, "CSDVersion")
RegCloseKey lRet
Label2.Caption = "Versión: " & VerVersion
End Function
Function SacarValorRegistro(ByVal HKLM As Long, ByVal sValor As String) As String
Dim lRet As Long, lInfoValor As Long
Dim lLen As Long, sBuffer As String
lRet = RegQueryValueEx(HKLM, sValor, 0, lInfoValor, ByVal 0, lLen)
If lRet = 0 Then
If lInfoValor = REG_SZ Then
sBuffer = String(lLen, Chr$(0))
lRet = RegQueryValueEx(HKLM, sValor, 0, 0, ByVal sBuffer, lLen)
If lRet = 0 Then
SacarValorRegistro = Left$(sBuffer, InStr(1, sBuffer, Chr$(0)) - 1)
End If
ElseIf lInfoValor = REG_BINARY Then
Dim strData As Integer
lRet = RegQueryValueEx(HKLM, sValor, 0, 0, strData, lLen)
If lRet = 0 Then SacarValorRegistro = strData
End If
End If
End Function
Private Sub Form_Load()
Call SacarClave
Call VerVersion
End Sub
Private Sub Timer1_Timer()
Call SacarClave
End Sub
Private Sub Text1_Change()
Dim i As Integer
Dim claves() As String
If Len(Text1.Text) = 29 Then
claves = Split(Text1.Text, "-")
For i = 1 To 5
Controls("Text" & i).Text = claves(i - 1)
Next
End If
If Len(Text1.Text) = 5 Then
Text2.SetFocus
End If
End Sub
Private Sub Text2_Change()
If Len(Text2.Text) = Text2.MaxLength Then
Text3.SetFocus
End If
End Sub
Private Sub Text3_Change()
If Len(Text3.Text) = Text3.MaxLength Then
Text4.SetFocus
End If
End Sub
Private Sub Text4_Change()
If Len(Text4.Text) = Text4.MaxLength Then
Text5.SetFocus
End If
End Sub
perdon, pero me quede dormido.
con respecto a lo de si es legal?
el codigo mismo te lo da Microsoft, es de acceso public0. Microsoft mismo hizo un prog para Cambiar el serial (Windows Product Key Update Tool), lo ilegal no es cambiar el seria , si no el como obtuviste ese serial (si no fue atraves de Microsoft). y lo de msoobe, seria la forma adecuada de cambiarlo pero ...
guidosl ojo con los caracteres del serial como te abras dado cuenta en el codigo del modulo de cobein hay caracteres no validadios...
Antes de cambiar la clave hay que modificar el valor OOBETIMER para que desactivarlo, y asi poder meter el serial nuevo.
Editado { el timer esta de mas, no se si viste pero cada textbox tiene su evento change(sino lo tiene poneselo), ahi es donde tendrias que verificar si todos los textBox tienen 5 caracteres, y si estan todos con 5 habilitar o deshabilitar en Command1.
}
PD: para el que quiera informarse al respecto: http://support.microsoft.com/kb/328874/es (http://support.microsoft.com/kb/328874/es)
Cita de: Dessa en 6 Abril 2009, 21:32 PM
Me queda una duda, antes de modificar la key no hay que crear una nueva ID ???
A eso me refería xkis, pero me parece que falta un paso intermedio lugo de modificar o poner nulo el valor OOBETIMER y modificar la key.
EDIT: cada ves que cambiamos la key se agrega (entre otras) una entrada en el registro en
HKEY_LOCAL_MACHINE\SYSTEM\WPA\Key-ABCDEFGHIJKLMNÑOPQRST\"ProductId"=
jejej nunca habia visto eso Desa, ahora lo vi y a eso lo hace solo Windows cuando se cambia el serial, yo tengo 3 claves KEY-XXX y justamente cambie 3 veces el serial en lo que va esta formateada mia...
AHH, bueno, las quiero eliminar y "Bill gate" no me deja (son 6), ahora repongo una imagen (todavía me salva el Drive Image 2002)
para que las queres borrar?, dejalas ahi, por exeperiencia aprendi que hay cosas mejor no tocar, formatea y se te soluciona. jejeje (chiste)
Formatear, no , Drive Image, 3 minutos , y aquí nada a pasado
PD: es bravo este Bill Gato
es verdad lo de deshabilitar el boton hasta q esten completos todos los textbox
pero el timer lo puse para q chequee si la clave es cambiada por otro medio...o para sabedr si realmente se cambio..
para verificar lo podes hacer despues de cambiar la clave, te fijas si es igual a la anterior o no.
a me olvide: despues de cambiar el serial, hay que reiniciar, para que tome bien el cambio en toda su magnitud
y si paramos y reiniciamos el explorer.exe no va?
en si si pero no por completo. windows no es solo un proceso