Autor
|
Tema: (ayuda) product key de windows (Leído 13,157 veces)
|
Novlucker
Ninja y
Colaborador
Desconectado
Mensajes: 10.683
Yo que tu lo pienso dos veces
|
Dim i As Integer Dim claves() As String
|
|
|
En línea
|
Contribuye con la limpieza del foro, reporta los "casos perdidos" a un MOD XD "Hay dos cosas infinitas: el Universo y la estupidez humana. Y de la primera no estoy muy seguro." Albert Einstein
|
|
|
guidosl
Desconectado
Mensajes: 75
|
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 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
|
|
« Última modificación: 6 Abril 2009, 22:41 pm por guidosl »
|
En línea
|
|
|
|
xkiz ™
|
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
|
|
« Última modificación: 7 Abril 2009, 00:20 am por xkiz »
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
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"=
|
|
« Última modificación: 7 Abril 2009, 00:20 am por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
xkiz ™
|
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...
|
|
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
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)
|
|
|
En línea
|
Adrian Desanti
|
|
|
xkiz ™
|
para que las queres borrar?, dejalas ahi, por exeperiencia aprendi que hay cosas mejor no tocar, formatea y se te soluciona. jejeje (chiste)
|
|
|
En línea
|
|
|
|
Dessa
Desconectado
Mensajes: 624
|
Formatear, no , Drive Image, 3 minutos , y aquí nada a pasado
PD: es bravo este Bill Gato
|
|
« Última modificación: 7 Abril 2009, 00:59 am por Dessa »
|
En línea
|
Adrian Desanti
|
|
|
guidosl
Desconectado
Mensajes: 75
|
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..
|
|
|
En línea
|
|
|
|
xkiz ™
|
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
|
|
« Última modificación: 7 Abril 2009, 02:42 am por xkiz »
|
En línea
|
|
|
|
|
|