获取WINDOWS7的 KEY

[henrysap]

先需要对公司的电脑进行系统管理，需要使用程序自动读取计算机系统的KEY，
读取XP没有问题，但是读取WINDOWS 7时候就不能正确显示，要么显示全部是“B”，
要么显示一个错误的KEY，有没有哪位帮忙下提供读取正确KEY的方法？

[兔子-顾问]

贴出你的代码别人才好测试

[threenewbee]

打开C:\windows\system32\slmgr.vbs，自己看。

[winnowc]

一个可能的原因是你的程序是以32位方式在64位系统执行，这时原本想打开的HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\DigitalProductId会被定向到HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Windows NT\CurrentVersion\DigitalProductId就会不对了。如果是这个原因，改成Any CPU方式编译程序应该就能正常。

[henrysap]

没有人懂啊?

[楚狂歌]

Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load

        Dim WshShell As Object = CreateObject("WScript.Shell")
        Dim regKey As String = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"

        Dim DigitalProductId As Object = WshShell.RegRead(regKey & "DigitalProductId")

        Dim WindowsProductName As String = WshShell.RegRead(regKey & "ProductName") & vbNewLine
        Dim WindowsProductID As String = WshShell.RegRead(regKey & "ProductID") & vbNewLine
        Dim WindowsProductKey As String = ConvertToKey(DigitalProductId)

        WName.Text = WindowsProductName
        ID.Text = WindowsProductID
        Key.Text = WindowsProductKey
        Me.Text = Me.Text & "  计算机名：" & My.Computer.Name & "  物理内存：" & My.Computer.Info.TotalPhysicalMemory & "  可用内存：" & My.Computer.Info.AvailablePhysicalMemory
        Me.Focus()
    End Sub

    Function ConvertToKey(regKey As Object)
        Dim KeyOffset As Integer = 52
        Dim isWin8 As Integer = (regKey(66) \ 6) And 1
        regKey(66) = (regKey(66) And &HF7) Or ((isWin8 And 2) * 4)
        Dim j As Integer = 24
        Dim Chars As String = "BCDFGHJKMPQRTVWXY2346789"
        Dim winKeyOutput As String
        Dim Last As Integer
        Do
            Dim Cur As Integer = 0
            Dim y As Integer = 14
            Do
                Cur = Cur * 256
                Cur = regKey(y + KeyOffset) + Cur
                regKey(y + KeyOffset) = (Cur \ 24)
                Cur = Cur Mod 24
                y = y - 1
            Loop While y >= 0
            j = j - 1
            winKeyOutput = Mid(Chars, Cur + 1, 1) & winKeyOutput
            Last = Cur
        Loop While j >= 0
        If (isWin8 = 1) Then
            Dim keypart1 As String = Mid(winKeyOutput, 2, Last)
            Dim insert As String = "N"
            winKeyOutput = Replace(winKeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
            If Last = 0 Then winKeyOutput = insert & winKeyOutput
        End If
        Dim a As String = Mid(winKeyOutput, 1, 5)
        Dim b As String = Mid(winKeyOutput, 6, 5)
        Dim c As String = Mid(winKeyOutput, 11, 5)
        Dim d As String = Mid(winKeyOutput, 16, 5)
        Dim e As String = Mid(winKeyOutput, 21, 5)
        ConvertToKey = a & "-" & b & "-" & c & "-" & d & "-" & e
    End Function

[楚狂歌]

这是我从VBS改编的，测试过，没问题。