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


Zitieren
