API tools faq
paste
Advertisement
Guest User

Battle.net CD-Key Encoding/Decoding

a guest
Jul 13th, 2010
2,070
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 18.39 KB | None | 0 0
raw download clone embed print report
  1. Public Class clsKey
  2.   Public Function Decode(ByVal CDKey As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal As UInt32) As Byte
  3.     CDKey = CDKey.Replace("-", vbNullString).ToUpper
  4.     If CDKey.Length = 13 Then
  5.       Decode13DigitKey(CDKey, Product, PublicVal, PrivateVal)
  6.       If Product <> 0 And PublicVal <> 0 And PrivateVal <> 0 Then
  7.         If Product = &H1 Or Product = &H2 Then
  8.           Return 0
  9.         Else
  10.           Return 2
  11.         End If
  12.       Else
  13.         Return 3
  14.       End If
  15.     ElseIf CDKey.Length = 16 Then
  16.       Decode16DigitKey(CDKey, Product, PublicVal, PrivateVal)
  17.       If Product <> 0 And PublicVal <> 0 And PrivateVal <> 0 Then
  18.         If Product = &H4 Or Product = &H6 Or Product = &HA Then
  19.           Return 0
  20.         Else
  21.           Return 2
  22.         End If
  23.       Else
  24.         Return 3
  25.       End If
  26.     ElseIf CDKey.Length = 26 Then
  27.       Dim bPriv() As Byte = {0}
  28.       Decode26DigitKey(CDKey, Product, PublicVal, bPriv)
  29.       PrivateVal = BitConverter.ToUInt32(bPriv, 0)
  30.       If Product <> 0 And PublicVal <> 0 And PrivateVal <> 0 Then
  31.         If Product = &HE Or Product = &H12 Or Product = &H17 Or Product = &H18 Or Product = &H19 Then
  32.           Return 0
  33.         Else
  34.           Return 2
  35.         End If
  36.       Else
  37.         Return 3
  38.       End If
  39.     Else
  40.       Return 1
  41.     End If
  42.   End Function
  43.   Public Function Decode(ByVal CDKey As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal() As Byte) As Byte
  44.     CDKey = CDKey.Replace("-", vbNullString).ToUpper
  45.     If CDKey.Length = 13 Then
  46.       Dim uPriv As UInt32
  47.       Decode13DigitKey(CDKey, Product, PublicVal, uPriv)
  48.       PrivateVal = BitConverter.GetBytes(uPriv)
  49.       If Product <> 0 And PublicVal <> 0 And uPriv <> 0 Then
  50.         If Product = &H1 Or Product = &H2 Then
  51.           Return 0
  52.         Else
  53.           Return 2
  54.         End If
  55.       Else
  56.         Return 3
  57.       End If
  58.     ElseIf CDKey.Length = 16 Then
  59.       Dim uPriv As UInt32
  60.       Decode16DigitKey(CDKey, Product, PublicVal, uPriv)
  61.       PrivateVal = BitConverter.GetBytes(uPriv)
  62.       If Product <> 0 And PublicVal <> 0 And uPriv <> 0 Then
  63.         If Product = &H4 Or Product = &H6 Or Product = &HA Then
  64.           Return 0
  65.         Else
  66.           Return 2
  67.         End If
  68.       Else
  69.         Return 3
  70.       End If
  71.     ElseIf CDKey.Length = 26 Then
  72.       Decode26DigitKey(CDKey, Product, PublicVal, PrivateVal)
  73.       If Product <> 0 And PublicVal <> 0 And Not IsNothing(PrivateVal) Then
  74.         If Product = &HE Or Product = &H12 Or Product = &H17 Or Product = &H18 Or Product = &H19 Then
  75.           Return 0
  76.         Else
  77.           Return 2
  78.         End If
  79.       Else
  80.         Return 3
  81.       End If
  82.     Else
  83.       Return 1
  84.     End If
  85.   End Function
  86.   Public Function Encode(ByRef CDKey As String, ByVal Product As UInt32, ByVal PublicVal As UInt32, ByVal PrivateVal As UInt32)
  87.     If Product = &H1 Or Product = &H2 Then
  88.       CDKey = Encode13DigitKey(Product, PublicVal, PrivateVal)
  89.       If CDKey <> vbNullString Then
  90.         Return 0
  91.       Else
  92.         Return 4
  93.       End If
  94.     ElseIf Product = &H4 Or Product = &H6 Or Product = &HA Then
  95.       CDKey = Encode16DigitKey(Product, PublicVal, PrivateVal)
  96.       If CDKey <> vbNullString Then
  97.         Return 0
  98.       Else
  99.         Return 4
  100.       End If
  101.     ElseIf Product = &HE Or Product = &H12 Or Product = &H17 Or Product = &H18 Or Product = &H19 Then
  102.       Dim bPriv() As Byte = BitConverter.GetBytes(PrivateVal)
  103.       CDKey = Encode26DigitKey(Product, PublicVal, bPriv)
  104.       If CDKey <> vbNullString Then
  105.         Return 0
  106.       Else
  107.         Return 4
  108.       End If
  109.     Else
  110.       Return 1
  111.     End If
  112.   End Function
  113.   Public Function Encode(ByRef CDKey As String, ByVal Product As UInt32, ByVal PublicVal As UInt32, ByVal PrivateVal() As Byte)
  114.     If Product = &H1 Or Product = &H2 Then
  115.       Dim uPriv As UInt32 = BitConverter.ToUInt32(PrivateVal, 0)
  116.       CDKey = Encode13DigitKey(Product, PublicVal, uPriv)
  117.       If CDKey <> vbNullString Then
  118.         Return 0
  119.       Else
  120.         Return 4
  121.       End If
  122.     ElseIf Product = &H4 Or Product = &H6 Or Product = &HA Then
  123.       Dim uPriv As UInt32 = BitConverter.ToUInt32(PrivateVal, 0)
  124.       CDKey = Encode16DigitKey(Product, PublicVal, uPriv)
  125.       If CDKey <> vbNullString Then
  126.         Return 0
  127.       Else
  128.         Return 4
  129.       End If
  130.     ElseIf Product = &HE Or Product = &H12 Or Product = &H17 Or Product = &H18 Or Product = &H19 Then
  131.       CDKey = Encode26DigitKey(Product, PublicVal, PrivateVal)
  132.       If CDKey <> vbNullString Then
  133.         Return 0
  134.       Else
  135.         Return 4
  136.       End If
  137.     Else
  138.       Return 1
  139.     End If
  140.   End Function
  141. End Class
  142.  
  143. Friend Module Key_13
  144.   Friend Sub Decode13DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal As UInt32)
  145.     Dim salt As Int32 = &H13AC9741, aOrd() As Byte = {6, 0, 2, 9, 3, 11, 1, 7, 5, 4, 10, 8}, Decoded(12) As Char
  146.     For I As Int32 = 11 To 0 Step -1
  147.       Dim C As Byte = Asc(Key.Substring(aOrd(I), 1))
  148.       If C <= 55 Then Decoded(I) = Chr(C Xor (salt And 7)) : salt >>= 3 Else Decoded(I) = Chr(C Xor I And 1)
  149.     Next
  150.     If Key.EndsWith(GetLastVal(Key)) Then
  151.       Dim sDone As String = Decoded
  152.       Product = UInt32.Parse(sDone.Substring(0, 2), Globalization.NumberStyles.AllowHexSpecifier)
  153.       PublicVal = sDone.Substring(2, 7)
  154.       PrivateVal = sDone.Substring(9, 3)
  155.     Else
  156.       Product = 0 : PublicVal = 0 : PrivateVal = 0
  157.     End If
  158.   End Sub
  159.   Friend Function Encode13DigitKey(ByVal Product As UInt32, ByVal PublicVal As UInt32, ByVal PrivateVal As UInt32) As String
  160.     Dim salt As Int32 = &H13AC9741, aOrd() As Byte = {6, 0, 2, 9, 3, 11, 1, 7, 5, 4, 10, 8}, Encoded(12) As Char
  161.     Dim Key() As Char = (PadValue(Product, 2) & PadValue(PublicVal, 7) & PadValue(PrivateVal, 3)).ToCharArray
  162.     For I As Int32 = 11 To 0 Step -1
  163.       Dim C As Byte = Asc(Key(I))
  164.       If C <= 55 Then Encoded(aOrd(I)) = Chr(C Xor (salt And 7)) : salt >>= 3 Else Encoded(aOrd(I)) = Chr(C Xor I And 1)
  165.     Next I
  166.     Encoded(12) = GetLastVal(Encoded)
  167.     Return Encoded
  168.   End Function
  169.   Private Function GetLastVal(ByVal sKey As String) As Char
  170.     Dim lLenVal As UInt32 = 3, Key() As Char = sKey.ToCharArray
  171.     For I As Int32 = 0 To 11
  172.       lLenVal = lLenVal + (CStr(Key(I)) Xor (lLenVal * 2))
  173.     Next I
  174.     Return CStr(lLenVal Mod 10)
  175.   End Function
  176.   Private Function PadValue(ByVal Value As UInt32, ByVal Length As UInt16) As String
  177.     Dim sVal As String = CStr(Value)
  178.     Do While sVal.Length < Length
  179.       sVal = "0" & sVal
  180.     Loop
  181.     Return sVal
  182.   End Function
  183. End Module
  184.  
  185. Friend Module Key_16
  186.   Friend Sub Decode16DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal As UInt32)
  187.     Dim salt As Int32 = &H13AC9741, aOrd() As Byte = {5, 6, 0, 1, 2, 3, 4, 9, 10, 11, 12, 13, 14, 15, 7, 8}
  188.     Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXZ"
  189.     Dim cKey() As Char = Key.ToCharArray
  190.     For I As Integer = 0 To 14 Step 2
  191.       If Not CodeValues.Contains(cKey(I + 1)) OrElse Not CodeValues.Contains(cKey(I)) Then Exit Sub
  192.       Dim N As Int32 = (CodeValues.IndexOf(cKey(I + 1))) + (CodeValues.IndexOf(cKey(I)) * 24) And &HFF
  193.       cKey(I) = Chr(IIf(((N >> 4) And &HF) < 10, ((N >> 4) And &HF) + &H30, ((N >> 4) And &HF) + &H37))
  194.       cKey(I + 1) = Chr(IIf((N And &HF) < 10, (N And &HF) + &H30, (N And &HF) + &H37))
  195.     Next I
  196.     Dim Decoded(15) As Char
  197.     For I As Int32 = 15 To 0 Step -1
  198.       Dim C As Byte = Asc(Char.ToUpper(cKey(aOrd(I))))
  199.       If C <= 55 Then
  200.         Decoded(I) = Chr(C Xor (salt And 7))
  201.         salt >>= 3
  202.       ElseIf C < 65 Then
  203.         Decoded(I) = Chr(C Xor I And 1)
  204.       Else
  205.         Decoded(I) = Chr(C)
  206.       End If
  207.     Next
  208.     Debug.Print(Decoded)
  209.     Dim sDone As String = Decoded
  210.     Product = UInt32.Parse(sDone.Substring(0, 2), Globalization.NumberStyles.AllowHexSpecifier)
  211.     PublicVal = UInt32.Parse(sDone.Substring(2, 6), Globalization.NumberStyles.AllowHexSpecifier)
  212.     PrivateVal = UInt32.Parse(sDone.Substring(8), Globalization.NumberStyles.AllowHexSpecifier)
  213.   End Sub
  214.   Friend Function Encode16DigitKey(ByVal Product As UInt32, ByVal PublicVal As UInt32, ByVal PrivateVal As UInt32) As String
  215.     Dim salt As Int32 = &H13AC9741, aOrd() As Byte = {5, 6, 0, 1, 2, 3, 4, 9, 10, 11, 12, 13, 14, 15, 7, 8}, Encoded(15) As Char
  216.     Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXZ"
  217.     Dim Key() As Char = (PadHex(Product, 2) & PadHex(PublicVal, 6) & PadHex(PrivateVal, 8)).ToCharArray
  218.     For I As Int32 = 15 To 0 Step -1
  219.       Dim C As Byte = Asc(Key(I))
  220.       If C <= 55 Then
  221.         Encoded(aOrd(I)) = Chr(C Xor (salt And 7))
  222.         salt >>= 3
  223.       ElseIf C < 65 Then
  224.         Encoded(aOrd(I)) = Chr(C Xor I And 1)
  225.       Else
  226.         Encoded(aOrd(I)) = Chr(C)
  227.       End If
  228.     Next I
  229.     Dim R As Int32 = 3
  230.     For I As Int16 = 0 To 15 : R = R + ((IIf(IsNumeric(Encoded(I)), Asc(Encoded(I)) - &H30, Asc(Char.ToUpper(Encoded(I))) - &H37)) Xor (R * 2)) : Next I
  231.     R = R And &HFF
  232.     Dim tmpByte As Byte = &H80
  233.     For I As Int16 = 14 To 0 Step -2
  234.       Dim A As Int32 = IIf(IsNumeric(Encoded(I)), Asc(Encoded(I)) - &H30, Asc(Char.ToUpper(Encoded(I))) - &H37)
  235.       Dim B As Int32 = (IIf(IsNumeric(Encoded(I + 1)), Asc(Encoded(I + 1)) - &H30, Asc(Char.ToUpper(Encoded(I + 1))) - &H37))
  236.       A = UInt32.Parse(Hex(A) & Hex(B), Globalization.NumberStyles.AllowHexSpecifier)
  237.       If R And tmpByte Then A = A + &H100
  238.       B = 0
  239.       While A >= &H18 : B = B + 1 : A = A - &H18 : End While
  240.       Encoded(I) = Mid(CodeValues, B + 1, 1)
  241.       Encoded(I + 1) = Mid(CodeValues, A + 1, 1)
  242.       tmpByte = tmpByte / 2
  243.     Next I
  244.     Return Encoded
  245.   End Function
  246.   Friend Function PadHex(ByVal Value As UInt32, ByVal Length As UInt16) As String
  247.     Dim sVal As String = Hex(Value)
  248.     Do While sVal.Length < Length : sVal = "0" & sVal : Loop
  249.     Return sVal
  250.   End Function
  251. End Module
  252.  
  253. Friend Module Key_26
  254.   Private ReadOnly TRANSLATEMAP()() As Byte = {
  255.     New Byte() {&H9, &H4, &H7, &HF, &HD, &HA, &H3, &HB, &H1, &H2, &HC, &H8, &H6, &HE, &H5, &H0},
  256.     New Byte() {&H9, &HB, &H5, &H4, &H8, &HF, &H1, &HE, &H7, &H0, &H3, &H2, &HA, &H6, &HD, &HC},
  257.     New Byte() {&HC, &HE, &H1, &H4, &H9, &HF, &HA, &HB, &HD, &H6, &H0, &H8, &H7, &H2, &H5, &H3},
  258.     New Byte() {&HB, &H2, &H5, &HE, &HD, &H3, &H9, &H0, &H1, &HF, &H7, &HC, &HA, &H6, &H4, &H8},
  259.     New Byte() {&H6, &H2, &H4, &H5, &HB, &H8, &HC, &HE, &HD, &HF, &H7, &H1, &HA, &H0, &H3, &H9},
  260.     New Byte() {&H5, &H4, &HE, &HC, &H7, &H6, &HD, &HA, &HF, &H2, &H9, &H1, &H0, &HB, &H8, &H3},
  261.     New Byte() {&HC, &H7, &H8, &HF, &HB, &H0, &H5, &H9, &HD, &HA, &H6, &HE, &H2, &H4, &H3, &H1},
  262.     New Byte() {&H3, &HA, &HE, &H8, &H1, &HB, &H5, &H4, &H2, &HF, &HD, &HC, &H6, &H7, &H9, &H0},
  263.     New Byte() {&HC, &HD, &H1, &HF, &H8, &HE, &H5, &HB, &H3, &HA, &H9, &H0, &H7, &H2, &H4, &H6},
  264.     New Byte() {&HD, &HA, &H7, &HE, &H1, &H6, &HB, &H8, &HF, &HC, &H5, &H2, &H3, &H0, &H4, &H9},
  265.     New Byte() {&H3, &HE, &H7, &H5, &HB, &HF, &H8, &HC, &H1, &HA, &H4, &HD, &H0, &H6, &H9, &H2},
  266.     New Byte() {&HB, &H6, &H9, &H4, &H1, &H8, &HA, &HD, &H7, &HE, &H0, &HC, &HF, &H2, &H3, &H5},
  267.     New Byte() {&HC, &H7, &H8, &HD, &H3, &HB, &H0, &HE, &H6, &HF, &H9, &H4, &HA, &H1, &H5, &H2},
  268.     New Byte() {&HC, &H6, &HD, &H9, &HB, &H0, &H1, &H2, &HF, &H7, &H3, &H4, &HA, &HE, &H8, &H5},
  269.     New Byte() {&H3, &H6, &H1, &H5, &HB, &HC, &H8, &H0, &HF, &HE, &H9, &H4, &H7, &HA, &HD, &H2},
  270.     New Byte() {&HA, &H7, &HB, &HF, &H2, &H8, &H0, &HD, &HE, &HC, &H1, &H6, &H9, &H3, &H5, &H4},
  271.     New Byte() {&HA, &HB, &HD, &H4, &H3, &H8, &H5, &H9, &H1, &H0, &HF, &HC, &H7, &HE, &H2, &H6},
  272.     New Byte() {&HB, &H4, &HD, &HF, &H1, &H6, &H3, &HE, &H7, &HA, &HC, &H8, &H9, &H2, &H5, &H0},
  273.     New Byte() {&H9, &H6, &H7, &H0, &H1, &HA, &HD, &H2, &H3, &HE, &HF, &HC, &H5, &HB, &H4, &H8},
  274.     New Byte() {&HD, &HE, &H5, &H6, &H1, &H9, &H8, &HC, &H2, &HF, &H3, &H7, &HB, &H4, &H0, &HA},
  275.     New Byte() {&H9, &HF, &H4, &H0, &H1, &H6, &HA, &HE, &H2, &H3, &H7, &HD, &H5, &HB, &H8, &HC},
  276.     New Byte() {&H3, &HE, &H1, &HA, &H2, &HC, &H8, &H4, &HB, &H7, &HD, &H0, &HF, &H6, &H9, &H5},
  277.     New Byte() {&H7, &H2, &HC, &H6, &HA, &H8, &HB, &H0, &HF, &H4, &H3, &HE, &H9, &H1, &HD, &H5},
  278.     New Byte() {&HC, &H4, &H5, &H9, &HA, &H2, &H8, &HD, &H3, &HF, &H1, &HE, &H6, &H7, &HB, &H0},
  279.     New Byte() {&HA, &H8, &HE, &HD, &H9, &HF, &H3, &H0, &H4, &H6, &H1, &HC, &H7, &HB, &H2, &H5},
  280.     New Byte() {&H3, &HC, &H4, &HA, &H2, &HF, &HD, &HE, &H7, &H0, &H5, &H8, &H1, &H6, &HB, &H9},
  281.     New Byte() {&HA, &HC, &H1, &H0, &H9, &HE, &HD, &HB, &H3, &H7, &HF, &H8, &H5, &H2, &H4, &H6},
  282.     New Byte() {&HE, &HA, &H1, &H8, &H7, &H6, &H5, &HC, &H2, &HF, &H0, &HD, &H3, &HB, &H4, &H9},
  283.     New Byte() {&H3, &H8, &HE, &H0, &H7, &H9, &HF, &HC, &H1, &H6, &HD, &H2, &H5, &HA, &HB, &H4},
  284.     New Byte() {&H3, &HA, &HC, &H4, &HD, &HB, &H9, &HE, &HF, &H6, &H1, &H7, &H2, &H0, &H5, &H8}}
  285.   Friend Sub Decode26DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal() As Byte)
  286.     Try
  287.       Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXYZ"
  288.       Dim cKey() As Char = Key.ToCharArray
  289.       Dim aOrd() As Byte = {30, 27, 24, 21, 18, 15, 12, 9, 6, 3, 0, 49,
  290.                                     46, 43, 40, 37, 34, 31, 28, 25,
  291.                             22, 19, 16, 13, 10, 7, 4, 1, 50, 47, 44, 41,
  292.                                     38, 35, 32, 29, 26, 23, 20, 17,
  293.                             14, 11, 8, 5, 2, 51, 48, 45, 42, 39, 36, 33}
  294.       Dim n_digitsBase5(0 To 51) As Byte
  295.       For I As Integer = 0 To 26 - 1
  296.         If Not CodeValues.Contains(cKey(I)) Then Exit Sub
  297.         Dim bC As Byte = CodeValues.IndexOf(cKey(I))
  298.         n_digitsBase5(aOrd(I * 2)) = CByte(bC \ 5)
  299.         n_digitsBase5(aOrd(I * 2 + 1)) = CByte(bC Mod 5)
  300.       Next I
  301.       Dim n As Numerics.BigInteger = 0
  302.       For I As Integer = 51 To 0 Step -1 : n = n * 5 + n_digitsBase5(I) : Next I
  303.       Dim nbytes() As Byte = n.ToByteArray
  304.       Dim nibbles(0 To 29) As Byte
  305.       For I As Integer = 0 To 14
  306.         For J As Integer = 0 To 1
  307.           nibbles((I << 1) + J) = CByte((nbytes(I) >> (J << 2)) And CUInt(&HF))
  308.         Next J
  309.       Next I
  310.       Dim perm() As Byte, c As Byte
  311.       For R As Integer = 29 To 0 Step -1
  312.         perm = TRANSLATEMAP(R)
  313.         c = nibbles(R)
  314.         For r2 As Integer = 29 To 0 Step -1
  315.           If R = r2 Then Continue For
  316.           c = perm(nibbles(r2) Xor perm(c))
  317.         Next r2
  318.         nibbles(R) = perm(c)
  319.       Next R
  320.       Dim nLen As Integer = (nibbles.Length >> 1) - 1
  321.       Dim bTmp(nLen) As Byte
  322.       Dim nI As Integer
  323.       For I As Integer = 0 To nLen
  324.         nI = I << 1
  325.         bTmp(I) = nibbles(nI) Or (nibbles((nI) Or 1) << 4)
  326.       Next
  327.       Erase nibbles
  328.       Dim bits As New BitArray(bTmp)
  329.       Erase bTmp
  330.       For I As Integer = 0 To 119
  331.         Dim J As Integer = (I * 11) Mod 120
  332.         If J <= I Then Continue For
  333.         Dim b As Boolean = bits.Get(I)
  334.         bits(I) = bits(J)
  335.         bits.Set(J, b)
  336.       Next I
  337.       Dim bb(0 To 14) As Byte
  338.       For I As Integer = 0 To 14
  339.         For J As Integer = 0 To 7
  340.           If bits.Get((I << 3) + J) Then bb(I) = bb(I) Or CByte(&H1 << J)
  341.         Next J
  342.       Next I
  343.       If bb(&HE) = &H0 Then
  344.         Product = bb(&HD) >> &HA
  345.         PublicVal = BitConverter.ToUInt32(bb, &HA) And &HFFFFFF
  346.         Dim bOrder() As Byte = {8, 9, 4, 5, 6, 7, 0, 1, 2, 3}
  347.         ReDim PrivateVal(9)
  348.         For I As Integer = 0 To 9 : PrivateVal(I) = bb(bOrder(I)) : Next
  349.       Else
  350.         Product = 0
  351.         PublicVal = 0
  352.         Erase PrivateVal
  353.       End If
  354.     Catch ex As Exception
  355.       Product = 0
  356.       PublicVal = 0
  357.       Erase PrivateVal
  358.     End Try
  359.   End Sub
  360.  
  361.   Friend Function Encode26DigitKey(ByVal Product As UInt32, ByVal PublicVal As UInt32, ByVal PrivateVal() As Byte) As String
  362.     Dim bOrder() As Byte = {8, 9, 4, 5, 6, 7, 0, 1, 2, 3}
  363.     Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXYZ"
  364.     Dim aOrd() As Byte = {30, 27, 24, 21, 18, 15, 12, 9, 6, 3, 0, 49,
  365.                                   46, 43, 40, 37, 34, 31, 28, 25,
  366.                           22, 19, 16, 13, 10, 7, 4, 1, 50, 47, 44, 41,
  367.                                   38, 35, 32, 29, 26, 23, 20, 17,
  368.                           14, 11, 8, 5, 2, 51, 48, 45, 42, 39, 36, 33}
  369.     Dim bb(0 To 14) As Byte
  370.     For I As Integer = 0 To 9 : bb(bOrder(I)) = PrivateVal(I) : Next
  371.     bb(&HA) = BitConverter.GetBytes(PublicVal)(0)
  372.     bb(&HB) = BitConverter.GetBytes(PublicVal)(1)
  373.     bb(&HC) = BitConverter.GetBytes(PublicVal)(2)
  374.     bb(&HD) = Product << 2
  375.     Dim bits As New BitArray(bb)
  376.     For I As Integer = 0 To 119
  377.       Dim J As Integer = (I * 11) Mod 120
  378.       If J <= I Then Continue For
  379.       Dim b As Boolean = bits.Get(I)
  380.       bits(I) = bits(J)
  381.       bits.Set(J, b)
  382.     Next I
  383.     Dim nibbles(0 To 29) As Byte
  384.     For I As Integer = 0 To 29
  385.       For J As Integer = 3 To 0 Step -1
  386.         If bits.Get(I * 4 + J) Then nibbles(I) = nibbles(I) Or (&H1 << J)
  387.       Next J
  388.     Next I
  389.     Dim perm() As Byte, c As Byte
  390.     For R As Integer = 0 To 29
  391.       perm = TRANSLATEMAP(R)
  392.       c = FindC(perm, nibbles(R))
  393.       For r2 As Integer = 0 To 29
  394.         If R = r2 Then Continue For
  395.         c = FindC(perm, nibbles(r2) Xor FindC(perm, c))
  396.       Next r2
  397.       nibbles(R) = c
  398.     Next
  399.     Dim nLen As Integer = (nibbles.Length >> 1) - 1
  400.     Dim bTmp(nLen + 1) As Byte
  401.     Dim nI As Integer
  402.     For I As Integer = 0 To nLen
  403.       nI = I << 1
  404.       bTmp(I) = nibbles(nI) Or (nibbles((nI) Or 1) << 4)
  405.     Next
  406.     Erase nibbles
  407.     Dim n As New Numerics.BigInteger(bTmp)
  408.     Dim n_digitsBase5(0 To 51) As Byte
  409.     For I As Integer = 0 To 51
  410.       n_digitsBase5(I) = n Mod 5
  411.       n = (n - n_digitsBase5(I)) / 5
  412.     Next
  413.     Dim bC As Byte, sKey As String = vbNullString
  414.     For I As Integer = 0 To 26 - 1
  415.       bC = (n_digitsBase5(aOrd(I * 2)) * 5) + n_digitsBase5(aOrd(I * 2 + 1))
  416.       sKey &= CodeValues.Substring(bC, 1)
  417.     Next I
  418.     Return sKey
  419.   End Function
  420.  
  421.   Private Function FindC(ByVal perm() As Byte, ByVal Nibble As Byte) As Byte
  422.     For I As Integer = 0 To perm.Length - 1
  423.       If perm(I) = Nibble Then Return I
  424.     Next
  425.     Return 0
  426.   End Function
  427.  
  428.   Private Function BitArrayToString(ByVal bArray As BitArray) As String
  429.     Dim sTmp As String = vbNullString
  430.     For I As Integer = 0 To bArray.Length - 1
  431.       sTmp &= IIf(bArray(I), "1", "0")
  432.     Next
  433.     Return sTmp
  434.   End Function
  435. End Module
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!