Programmierer für Steamdecrypt...Mein Steam PW auslesen

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

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