ms序列号查看器,VB源代码.

ricoman

国外1网站看到的.
有能力的朋友,写一段替换序列号的,代码.

1. 
   
2. Option Explicit
   
3. Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
   
4. Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
   
5. 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 ' Note that If you declare the lpData parameter as String, you must pass it By Value.
   
6.     Private Const REG_BINARY = 3
   
7.     Private Const HKEY_LOCAL_MACHINE = &H80000002
   
8.     Private Const ERROR_SUCCESS = 0&
   
9. 
   
10. 
    
11. 
    
12. Public Function sGetXPCDKey() As String
    
13.     Dim bDigitalProductID() As Byte
    
14.     Dim bProductKey() As Byte
    
15.     Dim ilByte As Long
    
16.     Dim lDataLen As Long
    
17.     Dim hKey As Long
    
18.     If RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", hKey) = ERROR_SUCCESS Then
    
19.         lDataLen = 164
    
20.         ReDim Preserve bDigitalProductID(lDataLen)
    
21.         If RegQueryValueEx(hKey, "DigitalProductId", 0&, REG_BINARY, bDigitalProductID(0), lDataLen) = ERROR_SUCCESS Then
    
22.             ReDim Preserve bProductKey(14)
    
23.             For ilByte = 52 To 66
    
24.                 bProductKey(ilByte - 52) = bDigitalProductID(ilByte)
    
25.             Next ilByte
    
26. 
    
27.         Else
    
28.             sGetXPCDKey = ""
    
29.             Exit Function
    
30.         End If
    
31. 
    
32.     Else
    
33.         sGetXPCDKey = ""
    
34.         Exit Function
    
35.     End If
    
36.     Dim bKeyChars(0 To 24) As Byte
    
37.     bKeyChars(0) = Asc("B")
    
38.     bKeyChars(1) = Asc("C")
    
39.     bKeyChars(2) = Asc("D")
    
40.     bKeyChars(3) = Asc("F")
    
41.     bKeyChars(4) = Asc("G")
    
42.     bKeyChars(5) = Asc("H")
    
43.     bKeyChars(6) = Asc("J")
    
44.     bKeyChars(7) = Asc("K")
    
45.     bKeyChars(8) = Asc("M")
    
46.     bKeyChars(9) = Asc("P")
    
47.     bKeyChars(10) = Asc("Q")
    
48.     bKeyChars(11) = Asc("R")
    
49.     bKeyChars(12) = Asc("T")
    
50.     bKeyChars(13) = Asc("V")
    
51.     bKeyChars(14) = Asc("W")
    
52.     bKeyChars(15) = Asc("X")
    
53.     bKeyChars(16) = Asc("Y")
    
54.     bKeyChars(17) = Asc("2")
    
55.     bKeyChars(18) = Asc("3")
    
56.     bKeyChars(19) = Asc("4")
    
57.     bKeyChars(20) = Asc("6")
    
58.     bKeyChars(21) = Asc("7")
    
59.     bKeyChars(22) = Asc("8")
    
60.     bKeyChars(23) = Asc("9")
    
61.     Dim nCur As Integer
    
62.     Dim sCDKey As String
    
63.     Dim ilKeyByte As Long
    
64.     Dim ilBit As Long
    
65.     For ilByte = 24 To 0 Step -1
    
66.         nCur = 0
    
67.         For ilKeyByte = 14 To 0 Step -1
    
68.             nCur = nCur * 256 Xor bProductKey(ilKeyByte)
    
69.             bProductKey(ilKeyByte) = Int(nCur / 24)
    
70.             nCur = nCur Mod 24
    
71.         Next ilKeyByte
    
72.         sCDKey = Chr(bKeyChars(nCur)) & sCDKey
    
73.         If ilByte Mod 5 =  0  And  ilByte   <  >  0  Then  sCDKey  =   "-"   &   sCDKey
    
74.     Next ilByte
    
75.     sGetXPCDKey = sCDKey
    
76. End Function
    

复制代码

HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Office\11.0\Registration\{90110804-6000-11D3-8CFE-0150048383C9}

这个位置是,Office 2003的序列号位置

7cai

哦，看看

kso

这个是好东西。。
只可惜本人不精于VB。。