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...

[code]
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;
}
[/code]

If it returns TRUE it is valid for install

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

[quote author=SiMi link=board=17;threadid=1684;start=0#msg12834 date=1056431959]
Thanks a lot Darkminion, can anyone convert this to vb?
[/quote]
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 :)

[quote]I don't know who still uses this[/quote]
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) :)

[code]Public Function DecodeCDKey(ByVal Cdkey As String, ByRef ProdID As Long, ByRef Value1 As Long, Value2 As Long) As Boolean
'https://davnit.net/bnet/vL/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[/code]

Thanks Camel!