main.frm

注入工具的VB源代码实现, 和nbsi类似!! 还有不完善的地方, 希望一起加入PHP+Mysql的分析功能

    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