[Delphi] Retrieve Windows product code

[Skream Example]

Attribute VB_Name = "mWinProdKey"
Option Explicit

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Public Function WinProdKey() As String
    Dim lhKey           As Long
    Dim bvBuffer(163)   As Byte
    Dim vCharset        As Variant
    Dim bvChar(23)      As Byte
    Dim I               As Long
    Dim j               As Long
    Dim lCur            As Long

    If RegOpenKey(&H80000002, "SOFTWARE\MICROSOFT\Windows NT\CurrentVersion", lhKey) = 0& Then
        If RegQueryValueEx(lhKey, "DigitalProductId", 0, 3, bvBuffer(0), 164) = 0 Then

            Call CopyMemory(bvBuffer(0), bvBuffer(52), &HF)

            vCharset = Array( _
               "B", "C", "D", "F", "G", "H", "J", "K", "M", "P", "Q", "R", _
               "T", "V", "W", "X", "Y", "2", "3", "4", "6", "7", "8", "9")

            For I = 0 To 23
                bvChar(I) = Asc(vCharset(I))
            Next

            For I = 24 To 0 Step -1
                lCur = 0
                For j = 14 To 0 Step -1
                    lCur = lCur * 256 Xor bvBuffer(j)
                    bvBuffer(j) = Int(lCur / 24)
                    lCur = lCur Mod 24
                Next
                WinProdKey = vCharset(lCur) & WinProdKey
                If I Mod 5 = 0 And I <> 0 Then WinProdKey = "-" & WinProdKey
            Next

        End If
        Call RegCloseKey(lhKey)
    End If
End Function