Valhalla Legends Archive

Does anybody have the algorithm for validating a starcraft or wacraft 2 cdkey?

Edit:grammer

There isn't a formula for telling whether or not a cdkey is valid for use with battle.net, other than using it with a bot and seeing if it works.

However, if you simply want to see if it is valid for install purposes you can use Yobguls' CDKeyDecode function.  I don't know who still uses this but here it is...


BOOL DecodeCDKey(LPCTSTR lpszCDKey, DWORD * lpdwProductId, DWORD * lpdwValue1,
                DWORD * lpdwValue2)
{
  char key[1024], value[1024];
  int i, length, keylength;
  BOOL bValid;

  length = strlen(lpszCDKey);
  keylength = 0;
  for (i = 0; i < length; i++)
  {
     if (isalnum(lpszCDKey[i]))
     {
        key[keylength] = lpszCDKey[i];
        keylength++;
     }
  }
  if (keylength == 13)
     bValid = DecodeStarcraftKey(key);
  else if (keylength == 16)
     bValid = DecodeD2Key(key);
  else
     return FALSE;
  strncpy(value, key, 2);
  value[2] = '\0';
  sscanf(value, "%X", lpdwProductId);
  if (keylength == 16)
  {
     strncpy(value, &key[2], 6);
     value[6] = '\0';
     sscanf(value, "%X", lpdwValue1);
     strcpy(value, &key[8]);
     value[8] = '\0';
     sscanf(value, "%X", lpdwValue2);
  }
  else if (keylength == 13)
  {
     strncpy(value, &key[2], 7);
     value[7] = '\0';
     sscanf(value, "%ld", lpdwValue1);
     strncpy(value, &key[9], 3);
     value[3] = '\0';
     sscanf(value, "%ld", lpdwValue2);
  }      
  return bValid;
}


If it returns TRUE it is valid for install

Thanks a lot Darkminion, can anyone convert this to vb?

Quote from: SiMi on June 24, 2003, 12:19 AM
Thanks a lot Darkminion, can anyone convert this to vb?

I'm sure alot of people can.

The real question is, why would they? Or possibly even, why would they give it to you?

DM forgot to include DecodeStarcraftKey and DecodeD2Key

QuoteI don't know who still uses this

I do (meaning, BNLS does), slightly modified to allow Warcraft 3 decoding as well.

The scanf/memcpy can be replaced with faster alternatives.  Hint: reverse the order.

Don't blame me, blame slugboy.

i didn't write most of this (aside from the last part of DecodeCDKey)

Public Function DecodeCDKey(ByVal Cdkey As String, ByRef ProdID As Long, ByRef Value1 As Long, Value2 As Long) As Boolean
   'http://forum.valhallalegends.com/phpbbs/index.php?board=17;action=display;threadid=1238;start=15
   'Starcraft: All digits are allowed. No letters are allowed.
   'Diablo 2, Lord of Destruction, Warcraft 2: The following digits and letters are not allowed: 0135 AILOQSUY
   'Warcraft 3, (probably) Frozen Throne: The following digits and letters are not allowed:      0135 AILOQSU

   Cdkey = Replace(Cdkey, "-", "")
   Cdkey = Replace(Cdkey, " ", "")
   Cdkey = UCase(Cdkey)

   Select Case Len(Cdkey)
       Case 13
           DecodeCDKey = DecodeStarcraftKey(Cdkey)
           ProdID = Val("&H" & Left(Cdkey, 2))
           Value1 = Mid(Cdkey, 3, 7)
           Value2 = Mid(Cdkey, 10, 3)
       Case 16
           DecodeCDKey = DecodeD2Key(Cdkey)
           ProdID = Val("&H" & Left(Cdkey, 2))
           Value1 = Val("&H" & Mid(Cdkey, 3, 6))
           Value2 = Val("&H" & Mid(Cdkey, 9)) ', 8))
#If DEBUG_ Then
       Case 26
           Debug.Assert False
#End If
       Case Else
           Debug.Assert False
           Disconnect
           Exit Function
   End Select
   
   
#If Not CBool(DEBUG_) Then
   Select Case frmSetup.ID & "-" & ProdID
       Case "STAR-1"
       Case "SEXP-1"
       Case "JSTR-1"
       Case "W2BN-4"
       Case "D2DV-6"
       Case "D2XP-10", "D2XP-6" '10 is the D2XP key, 6 is D2DV but you need the D2DV key to log in as D2XP
       Case Else
           Debug.Assert False
           MsgBox "WARNING: cd key may be for the wrong product!" & vbCrLf & "Product = " & frmSetup.ID & vbCrLf & "ID = " & ProdID, vbExclamation
           DecodeCDKey = False
   End Select
#End If
End Function

Public Function DecodeStarcraftKey(ByRef Key As String) As Boolean
   Dim R As Double, n As Double, n2 As Double, v As Double, _
   v2 As Double, keyvalue As Double, c1 As Byte, c2 As Byte, C As Byte, _
   bValid As Boolean, i As Integer, aryKey(0 To 12) As String
   For i = 1 To 13
       aryKey(i - 1) = Mid(Key, i, 1)
   Next i
   v = 3
   For i = 0 To 11
       C = aryKey(i)
       n = Val(C)
       n2 = v * 2
       n = n Xor n2
       v = v + n
   Next i
   v = v Mod 10
   If Hex(v) = aryKey(12) Then
       bValid = True
   End If
   v = 194
   For i = 11 To 0 Step -1
       If v < 7 Then GoTo continue
       C = aryKey(i)
       n = CInt(v / 12)
       n2 = v Mod 12
       v = v - 17
       c2 = aryKey(n2)
       aryKey(i) = c2
       aryKey(n2) = C
   Next i
continue:
   v2 = &H13AC9741
   For i = 11 To 0 Step -1
       C = UCase(aryKey(i))
       aryKey(i) = C
       If Asc(C) <= Asc("7") Then
           v = v2
           c2 = v And &HFF
           c2 = c2 And 7
           c2 = c2 Xor C
           v = RShift(CLng(v), 3)
           aryKey(i) = c2
           v2 = v
       ElseIf Asc(C) < 65 Then
           c2 = CByte(i)
           c2 = c2 And 1
           c2 = c2 Xor C
           aryKey(i) = c2
       End If
   Next i
   Key = Join(aryKey, "")
   DecodeStarcraftKey = bValid
End Function

Public Function DecodeD2Key(ByRef Key As String) As Boolean
   Dim R As Double, n As Double, n2 As Double, v As Double, _
   v2 As Double, keyvalue As Double, c1 As Byte, c2 As Byte, _
   C As Byte, bValid As Boolean, i As Integer, aryKey(0 To 15) As String, _
   codevalues As String: codevalues = "246789BCDEFGHJKMNPRTVWXZ"

   R = 1
   keyvalue = 0

   For i = 1 To 16
       aryKey(i - 1) = Mid$(Key, i, 1)
   Next i

   For i = 0 To 15 Step 2
       c1 = InStr(1, codevalues, aryKey(i)) - 1
       If c1 = -1 Then c1 = &HFF
       n = c1 * 3
       c2 = InStr(1, codevalues, aryKey(i + 1)) - 1
       If c2 = -1 Then c2 = &HFF
       n = c2 + n * 8
       If n >= &H100 Then
           n = n - &H100
           keyvalue = keyvalue Or R
       End If
       n2 = n
       n2 = RShift(n2, 4)
       aryKey(i) = GetHexValue(n2)
       aryKey(i + 1) = GetHexValue(n)
       'r = LShift(r, 1)
       R = R * 2
Cont:
   Next i

   v = 3
   For i = 0 To 15
       C = GetNumValue(aryKey(i))
       n = Val(C)
       n2 = v * 2
       n = n Xor n2
       v = v + n
   Next i

   v = v And &HFF
   DecodeD2Key = IIf(v = keyvalue, True, False)

   For i = 15 To 0 Step -1
       C = Asc(aryKey(i))
       If i > 8 Then
           n = i - 9
       Else
           n = i + 7 '&HF - (8 - i)
       End If
       n = n And &HF
       c2 = Asc(aryKey(n))
       aryKey(i) = Chr$(c2)
       aryKey(n) = Chr$(C)
   Next i

   v2 = &H13AC9741
   For i = 15 To 0 Step -1
       C = Asc(UCase(aryKey(i)))
       aryKey(i) = Chr$(C)
       If Val(C) <= Asc("7") Then
           v = v2
           c2 = v And &HF
           c2 = c2 And 7
           c2 = c2 Xor C
           v = RShift(v, 3)
           aryKey(i) = Chr$(c2)
           v2 = v
       ElseIf Val(C) < Asc("A") Then
           c2 = CByte(i)
           c2 = c2 And 1
           c2 = c2 Xor C
           aryKey(i) = Chr$(c2)
       End If
   Next i

   Key = Join(aryKey, "")
End Function

Private Function GetHexValue(v As Double) As String
   v = v And &HF
   If v < 10 Then
       GetHexValue = Chr(v + &H30)
   Else
       GetHexValue = Chr(v + &H37)
   End If
End Function

Private Function GetNumValue(C As String) As Integer
   C = UCase(C)
   If IsNumeric(C) Then
       GetNumValue = Asc(C) - &H30
   Else
       GetNumValue = Asc(C) - &H37
   End If
End Function

Thanks Camel!