Sub ermitteln(ByVal Pid)
        szProductKey = ""
        Dim i, j, dwAccumulator, szPossibleChars
        Const rpkOffset = 52 : i = 28
        szPossibleChars = "BCDFGHJKMPQRTVWXY2346789"
        Do
            dwAccumulator = 0 : j = 14
            Do
                dwAccumulator = dwAccumulator * 256
                dwAccumulator = Pid(j + rpkOffset) + dwAccumulator
                Pid(j + rpkOffset) = (dwAccumulator \ 24) And 255
                dwAccumulator = dwAccumulator Mod 24
                j = j - 1
            Loop While j >= 0
            i = i - 1 : szProductKey = Mid(szPossibleChars, dwAccumulator + 1, _
              1) & szProductKey
            If (((29 - i) Mod 6) = 0) And (i <> -1) Then
                i = i - 1 : szProductKey = "-" & szProductKey
            End If
        Loop While i >= 0
 
 
    End Sub