XProfan

'
' © Frank Abbing für Paules-PC-Forum
' ./../../sys/?nohdr=1&u=www.paules-pc-forum.de/forum/dlls-includes-units-prozeduren/134802-windows-product-key-auslesen
'
 $H windows.ph
Declare mem#, memnew#, digits#, x&, pkey$
Dim mem#, 280
Dim memnew#, 280
Dim digits#,100
Clear mem#
Clear memnew#
String digits#, 0 = "BCDFGHJKMPQRTVWXY2346789"
Var path$ = "Software\\Microsoft\\Windows NT\\CurrentVersion"
Var item$ = "DigitalProductID"
Var key& = 0
Var size& = 280
~RegOpenKeyEx($80000002, Addr(path$), 0, $20119, Addr(key&))
~RegQueryValueEx(key&, Addr(item$), 0, 0, mem#, Addr(size&))

If size&<>280

    ~RegCloseKey(key&)

    WhileLoop 24, 0, -1

        x& = 0

        WhileLoop 66, 52, -1

            x& = (x& << 8) + Byte(mem#, &loop)
            Byte mem#, &loop = x& / 24
            x& = x& mod 24

        EndWhile

        Byte memnew#, &loop = Byte(digits#, x&)

    EndWhile

    pkey$=Char$(memnew#, 0, 5) + "-" + Char$(memnew#, 5, 5) + "-" + Char$(memnew#, 10, 5) + "-" + Char$(memnew#, 15, 5) + "-" + Char$(memnew#, 20, 5)
    MessageBox(pkey$, "Ihr Windows Produkt-Key lautet:", 64)

Else

    MessageBox("...konnte leider nicht ermittelt werden.", "Ihr Windows Produkt-Key...", 64)

EndIf