Public Function GetProductKey(ByVal KeyPath As String, ByVal ValueName As _
  String) As String
 
        Dim HexBuf As Object = My.Computer.Registry.GetValue(KeyPath, _
          ValueName, 0)
 
        If HexBuf Is Nothing Then Return "N/A"
 
        Dim tmp As String = ""
 
        For l As Integer = LBound(HexBuf) To UBound(HexBuf)
            tmp = tmp & " " & Hex(HexBuf(l))
        Next
 
        Dim StartOffset As Integer = 52
        Dim EndOffset As Integer = 67
        Dim Digits(24) As String
 
        Digits(0) = "B" : Digits(1) = "C" : Digits(2) = "D" : Digits(3) = "F"
        Digits(4) = "G" : Digits(5) = "H" : Digits(6) = "J" : Digits(7) = "K"
        Digits(8) = "M" : Digits(9) = "P" : Digits(10) = "Q" : Digits(11) = "R"
        Digits(12) = "T" : Digits(13) = "V" : Digits(14) = "W" : Digits(15) = _
          "X"
        Digits(16) = "Y" : Digits(17) = "2" : Digits(18) = "3" : Digits(19) = _
        "4"
        Digits(20) = "6" : Digits(21) = "7" : Digits(22) = "8" : Digits(23) = _
        "9"
 
        Dim dLen As Integer = 29
        Dim sLen As Integer = 15
        Dim HexDigitalPID(15) As String
        Dim Des(30) As String
 
        Dim tmp2 As String = ""
 
        For i = StartOffset To EndOffset
            HexDigitalPID(i - StartOffset) = HexBuf(i)
            tmp2 = tmp2 & " " & Hex(HexDigitalPID(i - StartOffset))
        Next
 
        Dim KEYSTRING As String = ""
 
        For i As Integer = dLen - 1 To 0 Step -1
            If ((i + 1) Mod 6) = 0 Then
                Des(i) = "-"
                KEYSTRING = KEYSTRING & "-"
            Else
                Dim HN As Integer = 0
                For N As Integer = (sLen - 1) To 0 Step -1
                    Dim Value As Integer = ((HN * 2 ^ 8) Or HexDigitalPID(N))
                    HexDigitalPID(N) = Value \ 24
                    HN = (Value Mod 24)
 
                Next
 
                Des(i) = Digits(HN)
                KEYSTRING = KEYSTRING & Digits(HN)
            End If
        Next
 
        Return StrReverse(KEYSTRING)
 
    End Function

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist

    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) _
        Handles Button1.Click
 
        TextBox1.Text = WindowsCDKey()
 
    End Sub
 
    Private Function WindowsCDKey() As String
        Dim BaseKey As RegistryKey
        Dim SubKey As RegistryKey
 
        If Environment.Is64BitOperatingSystem = True Then
            BaseKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, _
              RegistryView.Registry64)
            SubKey = BaseKey.OpenSubKey("SOFTWARE\Microsoft\Windows" & _
            "NT\CurrentVersion", False)
        Else
            SubKey = Registry.LocalMachine.OpenSubKey( _
              "SOFTWARE\Microsoft\Windows NT\CurrentVersion", False)
        End If
 
        Dim rpk As Byte() = DirectCast(SubKey.GetValue("DigitalProductId", New _
          Byte(-1) {}), Byte())
 
        Dim strKey As String = ""
 
        Const iRPKOffset As Integer = 52
        Const strPossibleChars As String = "BCDFGHJKMPQRTVWXY2346789"
        Dim i As Integer = 28
 
        Do
            Dim lAccu As Long = 0
            Dim j As Integer = 14
 
            Do
 
                lAccu *= 256
 
                lAccu += Convert.ToInt64(rpk(iRPKOffset + j))
 
                rpk(iRPKOffset + j) = Convert.ToByte(Convert.ToInt64(Math.Floor( _
                  CSng(lAccu) / 24.0F)) And Convert.ToInt64(255))
 
                lAccu = lAccu Mod 24
 
                j -= 1
            Loop While j >= 0
 
            i -= 1
            strKey = strPossibleChars(CInt(lAccu)).ToString() & strKey
 
            If (0 = ((29 - i) Mod 6)) AndAlso (-1 <> i) Then
                i -= 1
 
                strKey = "-" & strKey
            End If
        Loop While i >= 0
 
        Return strKey
 
    End Function

Dim rpk As Byte() = DirectCast(SubKey.GetValue("DigitalProductId", New _
          Byte(-1) {}), Byte())

    SubKey = BaseKey.OpenSubKey("SOFTWARE\Microsoft\Windows" & _
    "NT\CurrentVersion", False)

    SubKey = BaseKey.OpenSubKey("SOFTWARE\Microsoft\Windows" & _
    " NT\CurrentVersion", False)