obtener el serial de windows xp pro

[Avellaneda]

Mira, con este ejemplo obtienes el serial y la versión con su SP

Coloca en el Form un CommandButton y dos Labels

Código:

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()
Label1.Caption = SacarClave
Label2.Caption = "Versión: " & VerVersion
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
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
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

Nota: Parte de éste ejemplo está basado en otros que encontré por la Red.

Un saludo