(ayuda) product key de windows

[guidosl]

tenes razon q no era ahi!

mis disculpas jejejeje

ahora entro a esa pag q me pasaste

y gracias denuevo

[guidosl]

pues no lo pude encontrar :S

si alguien sabe como ahcerlo me peude pasar el codigo fuente x mail o mensj privado

gracias

[Dessa]

' Module: mWinProdKey
http://www.advancevb.com.ar

[guidosl]

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)

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

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

[aaronduran2]

Aquí tienes un código que funciona a la perfección con lo que quieres.

Código (vb) [Seleccionar] Expandir

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:

Código (vb) [Seleccionar] Expandir

MsgBox ClaveWindows

o

Código (vb) [Seleccionar] Expandir

Dim sClave As String
sClave = ClaveWindows
MsgBox sClave

Saludos 

[xkiz ™]

Código (vb) [Seleccionar] Expandir

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

[XcryptOR]

este codigo es de Cobein funciona de maravilla

Código (vb) [Seleccionar] Expandir

'              '---------------------------------------------------------------------------------------
' 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


[Karcrack]

XCryptor, no cortes los creditos de Cobein...

[ricardovinzo]

XCryptor, no cortes los creditos de Cobein...

Siempre lo hace:.       

[XcryptOR]

XCryptor, no cortes los creditos de Cobein...

Siempre 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¡