【已解决】提取系统序列号

zbezj

这个帖子中提取系统序列号的方法，只适用于win7，不适用于win10系统。
https://www.autoitx.com/forum.ph ... =%D0%F2%C1%D0%BA%C5

在网上找了以下vbs的代码，适合于win10，看了下好像是红色部分有所不同，求大佬帮忙修改成AU3的代码，谢谢！
---------------------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Dim objshell,path,DigitalID,ProductKey,edition,keys
Set objshell = CreateObject("WScript.Shell")
Path = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
DigitalID = objshell.RegRead(Path & "DigitalProductId")
ProductKey = ConvertToKey(DigitalID)
Save ProductKey

Function ConvertToKey(Key)
    Const KeyOffset = 52
    Dim isWin8, Maps, i, j, Current, KeyOutput, Last, keypart1, insert
    'Check if OS is Windows 8
    isWin8 = (Key(66) \ 6) And 1
    Key(66) = (Key(66) And &HF7) Or ((isWin8 And 2) * 4)
    i = 24
    Maps = "BCDFGHJKMPQRTVWXY2346789"
    Do
               Current= 0
        j = 14
        Do
           Current = Current* 256
           Current = Key(j + KeyOffset) + Current
           Key(j + KeyOffset) = (Current \ 24)
           Current=Current Mod 24
            j = j -1
        Loop While j >= 0
        i = i -1
        KeyOutput = Mid(Maps,Current+ 1, 1) & KeyOutput
        Last = Current
    Loop While i >= 0
    keypart1 = Mid(KeyOutput, 2, Last)
    insert = "N"
    KeyOutput = Replace(KeyOutput, keypart1, keypart1 & insert, 2, 1, 0)
    If Last = 0 Then KeyOutput = insert & KeyOutput
    ConvertToKey = Mid(KeyOutput, 1, 5) & "-" & Mid(KeyOutput, 6, 5) & "-" & Mid(KeyOutput, 11, 5) & "-" & Mid(KeyOutput, 16, 5) & "-" & Mid(KeyOutput, 21, 5)
End Function

Function Save(Data)
    Dim fso, fName, txt,objshell
    Set objshell = CreateObject("wscript.shell")
    fName = ".\GetProductKey.log"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile(fName)
    txt.Writeline Data
    txt.Close
End Function

afan

MsgBox(0, '', RegRead('HKLM64\SOFTWARE\Microsoft\Windows NT\CurrentVersion\SoftwareProtectionPlatform', 'BackupProductKeyDefault'))

zbezj

afan 发表于 2020-12-13 16:16

多谢，这个我以前用过。但是这个代码，在有些系统是不行的，有些没有这个注册表项。并且这个键值，不一定是系统当前已经安装的Key。我一楼转载的那个代码普适性最好，可惜是vbs，不是au3.

afan

zbezj 发表于 2020-12-13 19:23
多谢，这个我以前用过。但是这个代码，在有些系统是不行的，有些没有这个注册表项。我一楼转载的那个代码 ...

你不是要 win10 的吗？

zbezj

afan 发表于 2020-12-13 19:27
你不是要 win10 的吗？

准确的说是win8以上系统。。但即便是win10，这一行代码也不行，因为这个Key未必是当前已经安装的Key。

zbezj

afan 发表于 2020-12-13 16:16

其实只要在下面这个帖子的代码基础上，根据1楼那个vbs代码。稍微修改一下就行。可惜vbs那几行没太看懂。
https://www.autoitx.com/forum.ph ... =%D0%F2%C1%D0%BA%C5

zbezj

afan 发表于 2020-12-13 19:27
你不是要 win10 的吗？

Func _GetCurrentKey()
        Local $CurrentWinKey
                If @OSBuild >= 9200 Then
                        If FileExists(@WindowsDir & "" & $123 & "\GetProductKey.vbs") Then ShellExecuteWait(@WindowsDir & "" & $123 & "\GetProductKey.vbs", "", @SW_HIDE)
                        $CurrentWinKey = FileReadLine(@WindowsDir & "\123\GetProductKey.log", 1)
                Else
                        $CurrentWinKey = RegRead("HKLM\SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", "DigitalProductId")
                        $CurrentWinKey = _GetXPKey($CurrentWinKey)
                EndIf
        Return $CurrentWinKey
EndFunc   ;==>_GetCurrentKey

Func _GetXPKey($binaryDPID)
        Local $bKey[15]
        Local $sKey[29]
        Local $Digits[24]
        Local $Value = 0
        Local $hi = 0
        Local $n = 0
        Local $i = 0
        Local $Result
        $Digits = StringSplit("BCDFGHJKMPQRTVWXY2346789", "")
        $binaryDPID = StringMid($binaryDPID, 107, 30)
        For $i = 1 To 29 Step 2
                $bKey[Int($i / 2)] = Dec(StringMid($binaryDPID, $i, 2))
        Next

        For $i = 28 To 0 Step -1
                If Mod(($i + 1), 6) = 0 Then
                        $sKey[$i] = "-"
                Else
                        $hi = 0
                        For $n = 14 To 0 Step -1
                                $Value = BitOR(BitShift($hi, -8), $bKey[$n])
                                $bKey[$n] = Int($Value / 24)
                                $hi = Mod($Value, 24)
                        Next
                        $sKey[$i] = $Digits[$hi + 1]
                EndIf

        Next
        For $i = 0 To 28
                $Result = $Result & $sKey[$i]
        Next

        Return $Result
EndFunc   ;==>_GetXPKey

现在是这么分开写的，win8以上系统引用了vbs那段代码。 想统一到一起。

lpxx

英文站上转载的，正确与否未知。

MsgBox(0,0, ProductKey())
Func ProductKey()
        Local $sKey[29], $Value = 0, $hi = 0, $n = 0, $i = 0, $dlen = 29, $slen = 15, $Result, $bKey, $iKeyOffset = 52, $RegKey
                        $bKey = RegRead("HKLM64\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "DigitalProductId")
        If Not BinaryLen($bKey) Then Return ""
        Local $aKeys[BinaryLen($bKey)]
        For $i = 0 To UBound($aKeys) - 1
                $aKeys[$i] = Int(BinaryMid($bKey, $i + 1, 1))
        Next
        Local Const $isWin8 = BitAND(BitShift($aKeys[$iKeyOffset + 14], 3), 1)
        $aKeys[$iKeyOffset + 14] = BitOR(BitAND($aKeys[$iKeyOffset + 14], 0xF7), BitShift(BitAND($isWin8, 2), -2))
        $i = 24
        Local $sChars = "BCDFGHJKMPQRTVWXY2346789", $iCur, $iX, $sKeyOutput, $iLast
        While $i > -1
                $iCur = 0
                $iX = 14
                While $iX > -1
                        $iCur = BitShift($iCur, -8)
                        $iCur = $aKeys[$iX + $iKeyOffset] + $iCur
                        $aKeys[$iX + $iKeyOffset] = Int($iCur / 24)
                        $iCur = Mod($iCur, 24)
                        $iX -= 1
                WEnd
                $i -= 1
                $sKeyOutput = StringMid($sChars, $iCur + 1, 1) & $sKeyOutput
                $iLast = $iCur
        WEnd
        If $isWin8 Then
                $sKeyOutput = StringMid($sKeyOutput, 2, $iLast) & "N" & StringTrimLeft($sKeyOutput, $iLast + 1)
        EndIf
        Return StringRegExpReplace($sKeyOutput, '(\w{5})(\w{5})(\w{5})(\w{5})(\w{5})', '\1-\2-\3-\4-\5')
EndFunc   ;==>ProductKey

afan

zbezj 发表于 2020-12-13 19:31
准确的说是win8以上系统。。但即便是win10，这一行代码也不行，因为这个Key未必是当前已经安装的Key。

很少用win10，不清楚序列号还有这些问题，在我机器上一致就给你个参考而已~
lpxx大侠的应该是你想要的，基本上和VBS是一样的

zbezj

lpxx 发表于 2020-12-13 19:56
英文站上转载的，正确与否未知。

多谢，已验证，正确。

zbezj

afan 发表于 2020-12-13 20:16
很少用win10，不清楚序列号还有这些问题，在我机器上一致就给你个参考而已~
lpxx大侠的应该是你想要的， ...

多谢两位大神。

zbezj

afan 发表于 2020-12-13 20:16
很少用win10，不清楚序列号还有这些问题，在我机器上一致就给你个参考而已~
lpxx大侠的应该是你想要的， ...

大侠，您有篇帖子关于“”对win10系统高分屏(高DPI)适配“”，回复不了，想问一下，是怎么做到的？能发一下代码么，我最近也遇到了这个问题（创建的Label文字，在高分辨率下，文字过大显示不全。），谢谢！

afan

zbezj 发表于 2020-12-15 19:26
大侠，您有篇帖子关于“”对win10系统高分屏(高DPI)适配“”，回复不了，想问一下，是怎么做到的？能发一 ...

先用 api 函数 SetProcessDPIAware* 接管系统对DPI的处理方式，之后如不进行任何处理则进程不会随DPI改变而改变，始终保持原样。
如需随DPI改变而处理则比较繁琐，需：
启动时获取当前的DPI初值，根据该值设置界面的各个元素，如控件坐标，图标最适用的大小，字体的大小等等。
注册 WM_DPICHANGED 消息，并在消息中处理DPI改变后与之前的DPI比值，再次设置如上的窗口各元素。
跑题了，这是新问题。