您的位置：首页 → 网络冲浪 → 防范措施 → 网页防木马注入

网页防木马注入

时间：2009/9/13 0:05:00来源：本站整理作者：我要评论(0)

<%
Dim FireConn '此处声明变量不能少

Sub redOpenData(Num)
     Rem =========access数据库配置信息 开始 修改以下=========ACCESS
  
     Dim redDbPath,redConnStr
  
     If Num = 0 Then
      redDbPath = "Fire/songs.mdb"
     Else
      redDbPath = "Fire/songs.mdb"
     End If
  
Rem =========access数据库配置信息 结束 修改以上数据=================ACCESS
  
redConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(redDbPath)

On Error Resume Next

Set FireConn = Server.CreateObject("ADODB.Connection")
FireConn.open redConnStr

If Err Then
   Err.Clear
   Set FireConn = Nothing
   Response.Write "Fire DataBase Eoor Here " '数据库连接出错提示
   Response.End
End If
End Sub

Public Sub AllFireHere()
     Dim FireStr,FireStrs,Count_fire
Count_fire = 0
    
Rem ==================此处可以改动 开始====================

If IsObject(Application("Fire_Config")) = False Then
      Call RedGetFireConfig()
End If

If Application("Fire_Config")(3) = 1 Then
      Call RedCheckIpAdress()
End If

FireStrs = Application("Fire_Config")(0)

Rem ==================此处可以改动 结束====================

If RedCheckFireStr(Request.QueryString,FireStrs) = False Or RedCheckFireStr(Request.Form,FireStrs) = False Or RedCheckFireStr(Request.Cookies,FireStrs) = False Then
     
   Call RedFireStart() 'log记录
   Response.End()
End If
End Sub

Sub RedGetFireConfig()
     If IsObject(FireConn) = False Then
      Call redOpenData(0)
End IF

Dim Rs_Sub,tempArr(7)
Set Rs_Sub = FireConn.Execute("Select Conf_FireStr,Conf_Log,Conf_Domain,Conf_KillIp,Conf_ErrorType,Conf_ErrorUrl,Conf_AlertInfo,Conf_LockInfo From [Tb_FireConfig]")

If Not Rs_Sub.Eof Then
      Dim i
   For i = 0 To Ubound(tempArr)
       tempArr(i) = Rs_Sub(i)
   Next
  
   Rs_Sub.Close : Set Rs_Sub = Nothing
Else
      Response.Write("数据库Fire配置信息获取失败！")
   Response.End()
End If

Application.Lock
      Set Application("Fire_Config") = Nothing
   Application("Fire_Config") = tempArr
Application.unlock
End Sub

Sub RedCheckIpAdress()
     If IsObject(FireConn) = False Then
      Call redOpenData(0)
End If

Dim subIp,Rs_Sub,Songs
subIp = Trim(RedGetIP())
Songs = False

Set Rs_Sub = FireConn.Execute("Select Kill_Id From [Tb_KillIp] Where Kill_IP = '" & subIp & "' And Kill_Check = 1")

If Not Rs_Sub.Eof Then
      Songs = True
   Rs_Sub.Close : Set Rs_Sub = Nothing
End If

If Songs Then
      Call RedKillIp_ShowInfo()
   FireConn.Execute("Update [Tb_KillIp] Set Kill_Count = Kill_Count + 1 Where Kill_IP = '" & subIp & "'")
   Response.End() '此处频闭ip
End If
End Sub

Sub RedScript(scriptStr)
     Response.Write("<script language=""javascript"">" & scriptStr & "</script>")
End Sub

Sub RedKillIp_ShowInfo()
     Select Case Cint(Application("Fire_Config")(4))
      Case 1
       Call RedScript("alert('" & Application("Fire_Config")(7) & "');window.close();")
   Case 2
       Call RedScript("location.href='" & Application("Fire_Config")(5) & "';")
   Case 3
       Call RedScript("alert('" & Application("Fire_Config")(7) & "');location.href='" & Application("Fire_Config")(5) & "';")
   Case Else
       Call RedScript("window.close();")
End Select
End Sub

Sub LogAlertInfo()
     Select Case Cint(Application("Fire_Config")(4))
      Case 1
       Call RedScript("alert('" & Application("Fire_Config")(6) & "');window.close();")
   Case 2
       Call RedScript("location.href='" & Application("Fire_Config")(5) & "';")
   Case 3
       Call RedScript("alert('" & Application("Fire_Config")(6) & "');location.href='" & Application("Fire_Config")(5) & "';")
   Case Else
       Call RedScript("window.close();")
End Select
End Sub

Function RedCheckFireStr(strng,FireStrs)
     If CheckEmpty(strng) Then
      RedCheckFireStr = True
   Exit Function
End If

FireStrs = ReSpecialStr(FireStrs)

Dim i_fire,FireStr,TempNum
FireStr = Split(LCase(FireStrs),",")
TempNum = Ubound(FireStr)


For i_fire = 0 To TempNum
      If Instr(Lcase(strng),FireStr(i_fire)) > 0 Then
       RedCheckFireStr = False
    Exit Function
      End If
Next

RedCheckFireStr = True
End Function

Function CheckEmpty(fstrng)
     If IsNull(fstrng) Or IsEmpty(fstrng) Or fstrng = "" Then
      CheckEmpty = True
Else
      CheckEmpty = False
End If
End Function

Function RegExpTest(patrn, strng)
     If CheckEmpty(strng) Then
      RegExpTest = False
   Exit Function
End If

Dim regEx, retVal
     Set regEx = New RegExp
     regEx.Pattern = patrn
     regEx.IgnoreCase = True
     retVal = regEx.Test(strng)

     RegExpTest = retVal

Set regEx = Nothing
End Function

Function RedIsIpAdress(fIp)
     If CheckEmpty(fIp) Then
      RedIsIpAdress = "0.0.0.0"
   Exit Function
End If

If RegExpTest("^\d{1,4}(\.\d{1,4}){3}$",fIp) Then
      RedIsIpAdress =   fIp
Else
      RedIsIpAdress = "0.0.0.0"
End If
End Function

Private Function RedGetIP()
     Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
   strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
   strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
   strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
   strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If

RedGetIP = RedIsIpAdress(Trim(Mid(strIPAddr, 1, 30)))
End Function

Function FireFomatSpecialString(strng)
strng = LCase(strng)

strng = Replace(strng,Chr(34),"&#34;") ' "
strng = Replace(strng,Chr(37),"&#37;") ' %
strng = Replace(strng,Chr(38),"&#38;") ' &
strng = Replace(strng,Chr(39),"&#39;") ' '
strng = Replace(strng,Chr(40),"&#40") ' (
strng = Replace(strng,Chr(41),"&#41") ' )
strng = Replace(strng,Chr(42),"&#42") ' *
strng = Replace(strng,Chr(43),"&#43") ' +
strng = Replace(strng,Chr(44),"&#44") ' ,
strng = Replace(strng,Chr(45),"&#45") '-
strng = Replace(strng,Chr(60),"&#60") ' <
strng = Replace(strng,Chr(62),"&#62") ' >
strng = Replace(strng," ","&nbsp;") ' space

strng = Replace(strng,"javascript","#Java Script#")
strng = Replace(strng,"execute","#execute#")
strng = Replace(strng,"eval","#eval#")

FireFomatSpecialString = strng
End Function

Function ReSpecialStr(strng)

strng = Replace(strng,"&#34;",Chr(34)) ' "
strng = Replace(strng,"&#39;",Chr(39)) ' '
strng = Replace(strng,"&#40",Chr(40)) ' (
strng = Replace(strng,"&#41",Chr(41)) ' )
strng = Replace(strng,"&#60",Chr(60)) ' <
strng = Replace(strng,"&#62",Chr(62)) ' >

ReSpecialStr = strng
End Function

Sub RedFireStart()
     On Error Resume Next

If IsObject(Application("Fire_Config")) = False Then
      Call RedGetFireConfig()
End If

If Application("Fire_Config")(1) = 1 Then
      Call RedFireLog()
End If

If Application("Fire_Config")(3) = 1 Then
      Call RedFireLogIp()
End If

Call LogAlertInfo()
End Sub

Sub RedFireLog()
     If IsObject(FireConn) = False Then
      Call redOpenData(0)
End If

Dim fireArr(2)

fireArr(0) = Request.ServerVariables("SCRIPT_NAME")

If CheckEmpty(Request.QueryString) = False Then
      fireArr(0) = fireArr(0) & "?" & Request.QueryString
End If

fireArr(1) = RedGetIP()

fireArr(2) = ""

If Request.ServerVariables("HTTP_USER_AGENT") <> "" Then
      fireArr(2) = fireArr(2) & "HTTP_USER_AGENT : " & Request.ServerVariables("HTTP_USER_AGENT") & VbCrlf
End If

If Request.ServerVariables("HTTP_REFERER") <> "" Then
      fireArr(2) = fireArr(2) & "HTTP_REFERER : " & Request.ServerVariables("HTTP_REFERER") & VbCrlf
End If

If Request.ServerVariables("SERVER_PORT") <> "" Then
      fireArr(2) = fireArr(2) & "SERVER_PORT : " & Request.ServerVariables("SERVER_PORT") & VbCrlf
End If

If Request.ServerVariables("SERVER_PORT_SECURE") <> "" Then
      fireArr(2) = fireArr(2) & "SERVER_PORT_SECURE : " & Request.ServerVariables("SERVER_PORT_SECURE") & VbCrlf
End If

Dim i
For i = 0 To Ubound(fireArr)
      fireArr(i) = Trim(FireFomatSpecialString(fireArr(i)))
Next

FireConn.Execute("Insert Into [Tb_FireLog] (Fire_QueryString,Fire_Ip,Fire_Other) Values ('" & fireArr(0) & "','" & fireArr(1) & "','" & fireArr(2) & "')")
End Sub

Sub RedFireLogIp()
     If IsObject(FireConn) = False Then
      Call redOpenData(0)
End If

Dim subIp,Rs_Check,Songs
subIp = Trim(RedGetIP())
Songs = False

Set Rs_Check = FireConn.Execute("Select Kill_Check From [Tb_KillIp] Where Kill_IP = '" & subIp & "'")

If Not Rs_Check.Eof Then
   Songs = True
  
   '以下注释为：如果此IP无锁定，程序将其自动锁定
   'If Rs_Check("Kill_Check") <> 1 Then
       'FireConn.Execute("Update [Tb_KillIp] Set Kill_Check = 1 , Kill_Time = '" & Now() & "' Where Kill_IP = '" & subIp & "'")
   'End If
  
   Rs_Check.Close : Set Rs_Check = Nothing
End If

If Songs = False Then
      FireConn.Execute("Insert Into [Tb_KillIp] (Kill_IP,Kill_Check,Kill_Time) Values ('" & subIp & "',1,'" & Now() & "') ")
End If
End Sub

Rem ======================================以上防火墙配置结束==========================================

Sub RedJianKong()
     Call RedFireLog()
Call RedFireLogIp()
End Sub

Rem ======================================此处调用放火墙==============================================

'Call AllFireHere() '放火墙
'Call RedJianKong() '记录log和ip 注：防火墙本身已经有记录操作，请勿重复
%>

相关视频

    没有数据

相关阅读 网页认证wifi怎么破解百度打不开网页怎么办第五人格月亮河公园旋转木马怎么用 旋转木马怎么玩第五人格旋转木马怎么玩 第五人格旋转木马玩法解析逆水寒科举答题器网页版地址 逆水寒答题器网页版在哪进a站会关闭吗 acfun网页无法访问原因uc答题助手页面在哪里 uc答题助手网页版地址网页404是什么意思 网站404错误怎么解决

文章评论
发表评论

热门文章 没有查询到任何记录。

最新文章 防止DdoS攻击：通过路解析卡巴斯基特色之漏 网站被sql注入的修复方法Ubuntu破解Windows和防护的三种方法防黑客qq改密码技巧如何保证Foxmail泄露邮箱密码安全

人气排行 路由器被劫持怎么办？路由器DNS被黑客篡改怎防止DdoS攻击：通过路由器绕过DDoS防御攻击如何彻底清除电脑病毒？如何使用无忧隐藏无线路由防蹭网办法车模兽兽激情视频下载暗藏木马使用四款防黑客软件的体会怎么防止木马入侵