;Autor: nco2k

EnableExplicit

Procedure.s sGetXPCDKey()
  Protected *bDigitalProductID
  Protected *bProductKey.b
  Protected ilByte.l
  Protected lDataLen.l
  Protected hKey.l
  Protected Byte.l
  Protected nCur.l
  Protected sCDKey.s
  Protected ilKeyByte.l
  
  *bDigitalProductID = AllocateMemory(164)
  *bProductKey.b = AllocateMemory(15)
  ilByte.l
  lDataLen.l
  hKey.l
  
  If RegOpenKey_(#HKEY_LOCAL_MACHINE, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", @hKey) = #ERROR_SUCCESS
    lDataLen = 164
    
    If RegQueryValueEx_(hKey, "DigitalProductId", 0, "REG_BINARY", *bDigitalProductID, @lDataLen) = #ERROR_SUCCESS
      
      For ilByte = 52 To 66
        Byte.l = PeekB(*bDigitalProductID + ilByte) & 255
        PokeB(*bProductKey + ilByte - 52, Byte)
      Next ilByte
      RegCloseKey_(hKey)
    Else
      RegCloseKey_(hKey)
      ProcedureReturn ""
    EndIf
  Else
    ProcedureReturn ""
  EndIf
  Dim bKeyChars.l(23)
  
  bKeyChars(0) = Asc("B")
  bKeyChars(1) = Asc("C")
  bKeyChars(2) = Asc("D")
  bKeyChars(3) = Asc("F")
  bKeyChars(4) = Asc("G")
  bKeyChars(5) = Asc("H")
  bKeyChars(6) = Asc("J")
  bKeyChars(7) = Asc("K")
  bKeyChars(8) = Asc("M")
  bKeyChars(9) = Asc("P")
  bKeyChars(10) = Asc("Q")
  bKeyChars(11) = Asc("R")
  bKeyChars(12) = Asc("T")
  bKeyChars(13) = Asc("V")
  bKeyChars(14) = Asc("W")
  bKeyChars(15) = Asc("X")
  bKeyChars(16) = Asc("Y")
  bKeyChars(17) = Asc("2")
  bKeyChars(18) = Asc("3")
  bKeyChars(19) = Asc("4")
  bKeyChars(20) = Asc("6")
  bKeyChars(21) = Asc("7")
  bKeyChars(22) = Asc("8")
  bKeyChars(23) = Asc("9")
  nCur.l
  sCDKey.s
  ilKeyByte.l
  ilByte.l
  Byte.l
  For ilByte = 24 To 0 Step -1
    nCur = 0
    For ilKeyByte = 14 To 0 Step -1
      Byte = PeekB(*bProductKey + ilKeyByte) & 255
      nCur = ((nCur & 255) * 256) ! Byte
      PokeB(*bProductKey + ilKeyByte, (Int(nCur / 24)))
      nCur = nCur % 24
    Next ilKeyByte
    sCDKey = Chr(bKeyChars(nCur)) + sCDKey
    If ilByte % 5 = 0 And ilByte <> 0
      sCDKey = "-" + sCDKey
    EndIf
  Next ilByte
  
  ProcedureReturn sCDKey
EndProcedure

MessageRequester("","Windows-Seriennummer: "+sGetXPCDKey(),0)