hx_system.asp

带OA办公的动态源码网站

			sContent		= regEx.replace(sContent,"")
		Case Else
			regEx.Pattern	= "</?" & s_Filter & "[^>]*>"
			sContent		= regEx.replace(sContent,"")
		End Select
		DecodeFilter = sContent
		Set regEx=nothing
	End Function

	Public Function UBBCode(strContent)
	on error resume next
	strContent = HTMLEncode(strContent)
	dim objRegExp
	Set objRegExp=new RegExp
	objRegExp.IgnoreCase =true
	objRegExp.Global=True

	objRegExp.Pattern="(\[URL\])(.*)(\[\/URL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$2</A>")

	objRegExp.Pattern="(\[URL=(.*)\])(.*)(\[\/URL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""$2"" TARGET=_blank>$3</A>")

	objRegExp.Pattern="(\[EMAIL\])(.*)(\[\/EMAIL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""mailto:$2"">$2</A>")
	objRegExp.Pattern="(\[EMAIL=(.*)\])(.*)(\[\/EMAIL\])"
	strContent= objRegExp.Replace(strContent,"<A HREF=""mailto:$2"" TARGET=_blank>$3</A>")

	objRegExp.Pattern="(\[FLASH\])(.*)(\[\/FLASH\])"
	strContent= objRegExp.Replace(strContent,"<OBJECT codeBase=http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=4,0,2,0 classid=clsid:D27CDB6E-AE6D-11cf-96B8-444553540000 width=500 height=400><PARAM NAME=movie VALUE=""$2""><PARAM NAME=quality VALUE=high><embed src=""$2"" quality=high pluginspage='http://www.macromedia.com/shockwave/download/index.cgi?P1_Prod_Version=ShockwaveFlash' type='application/x-shockwave-flash' width=500 height=400>$2</embed></OBJECT>")

	objRegExp.Pattern="(\[IMG\])(.*)(\[\/IMG\])"
	strContent=objRegExp.Replace(strContent,"<IMG SRC=""$2"" border=0>")

        objRegExp.Pattern="(\[HTML\])(.*)(\[\/HTML\])"
	strContent=objRegExp.Replace(strContent,"<SPAN><IMG src=pic/code.gif align=absBottom> HTML 代码片段如下:<BR><TEXTAREA style=""WIDTH: 94%; BACKGROUND-COLOR: #f7f7f7"" name=textfield rows=10>$2</TEXTAREA><BR><INPUT onclick=runEx() type=button value=运行此代码 name=Button> [Ctrl+A 全部选择   提示:你可先修改部分代码，再按运行]</SPAN><BR>")

	objRegExp.Pattern="(\[color=(.*)\])(.*)(\[\/color\])"
	strContent=objRegExp.Replace(strContent,"<font color=$2>$3</font>")
	objRegExp.Pattern="(\[face=(.*)\])(.*)(\[\/face\])"
	strContent=objRegExp.Replace(strContent,"<font face=$2>$3</font>")
	objRegExp.Pattern="(\[align=(.*)\])(.*)(\[\/align\])"
	strContent=objRegExp.Replace(strContent,"<div align=$2>$3</div>")

	objRegExp.Pattern="(\[QUOTE\])(.*)(\[\/QUOTE\])"
	strContent=objRegExp.Replace(strContent,"<BLOCKQUOTE><font size=1 face=""Verdana, Arial"">quote:</font><HR>$2<HR></BLOCKQUOTE>")
	objRegExp.Pattern="(\[fly\])(.*)(\[\/fly\])"
	strContent=objRegExp.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$2</marquee>")
	objRegExp.Pattern="(\[move\])(.*)(\[\/move\])"
	strContent=objRegExp.Replace(strContent,"<MARQUEE scrollamount=3>$2</marquee>")
	objRegExp.Pattern="(\[glow=(.*),(.*),(.*)\])(.*)(\[\/glow\])"
	strContent=objRegExp.Replace(strContent,"<table width=$2 style=""filter:glow(color=$3, strength=$4)"">$5</table>")
	objRegExp.Pattern="(\[SHADOW=(.*),(.*),(.*)\])(.*)(\[\/SHADOW\])"
	strContent=objRegExp.Replace(strContent,"<table width=$2 style=""filter:shadow(color=$3, direction=$4)"">$5</table>")
    
	objRegExp.Pattern="(\[i\])(.*)(\[\/i\])"
	strContent=objRegExp.Replace(strContent,"<i>$2</i>")
	objRegExp.Pattern="(\[u\])(.*)(\[\/u\])"
	strContent=objRegExp.Replace(strContent,"<u>$2</u>")
	objRegExp.Pattern="(\[b\])(.*)(\[\/b\])"
	strContent=objRegExp.Replace(strContent,"<b>$2</b>")
	objRegExp.Pattern="(\[fly\])(.*)(\[\/fly\])"
	strContent=objRegExp.Replace(strContent,"<marquee>$2</marquee>")

	objRegExp.Pattern="(\[size=1\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=1>$2</font>")
	objRegExp.Pattern="(\[size=2\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=2>$2</font>")
	objRegExp.Pattern="(\[size=3\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=3>$2</font>")
	objRegExp.Pattern="(\[size=4\])(.*)(\[\/size\])"
	strContent=objRegExp.Replace(strContent,"<font size=4>$2</font>")

	strContent = doCode(strContent, "[list]", "[/list]", "<ul>", "</ul>")
	strContent = doCode(strContent, "[list=1]", "[/list]", "<ol type=1>", "</ol id=1>")
	strContent = doCode(strContent, "[list=a]", "[/list]", "<ol type=a>", "</ol id=a>")
	strContent = doCode(strContent, "[*]", "[/*]", "<li>", "</li>")
	strContent = doCode(strContent, "[code]", "[/code]", "<pre id=code><font size=1 face=""Verdana, Arial"" id=code>", "</font id=code></pre id=code>")

	set objRegExp=Nothing
	UBBCode=strContent
	End Function

	Public Function ChkClng(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkClng = CLng(str)
		Else
			ChkClng = 0
		End If
	End Function

	Public Function ChkCBool(ByVal str)
		If Not IsNull(str) Then
			ChkCBool = CBool(str)
		Else
			ChkCBool = False
		End If
	End Function

	Public Function ChkCDbl(ByVal str)
		If str<>"" and IsNumeric(str) Then
			ChkCDbl = CDbl(str)
		Else
			ChkCDbl = 0
		End If
	End Function

	Public Function ChkNull(ByVal str)
		If IsNull(str) Then
			ChkNull = ""
		Else
			ChkNull = str
		End If
	End Function
		
'检查文件后缀，如果与预定的匹配即返回TRUE
Function CheckExt(FileExt)
	If DimFileExt = "*" Then CheckExt = True
	Ext = Split(DimFileExt,",")
	For i = 0 To Ubound(Ext)
		If Lcase(FileExt) = Ext(i) Then 
			CheckExt = True
			Exit Function
		End If
	Next
End Function
'遍历处理path及其子目录所有文件
Sub HX_ShowAllFile(Path)
	Set FSO = CreateObject("Scripting.FileSystemObject")
	if not fso.FolderExists(path) then exit sub
	Set f = FSO.GetFolder(Path)
	Set fc2 = f.files
	For Each myfile in fc2
		If CheckExt(FSO.GetExtensionName(path&"\"&myfile.name)) Then 
		 SumFiles = SumFiles + 1
		 if HX_ScanFile(Path&"\"&myfile.name) then SumShell=SumShell+1
		end if 
	Next
	Set fc = f.SubFolders
	For Each f1 in fc
		HX_ShowAllFile path&"\"&f1.name
		SumFolders = SumFolders + 1
    Next
	Set FSO = Nothing
End Sub
'检测文件
Function HX_ScanFile(FilePath)
  HX_ScanFile=False
  dim FSOs,ofile,filetxt,DoMyBest,regEx,Matches,Match
	Set FSOs = CreateObject("Scripting.FileSystemObject")
	on error resume next
	set ofile = fsos.OpenTextFile(FilePath)
	filetxt = Lcase(ofile.readall())
	If err Then Exit Function
	if len(filetxt)>0 then
	'特征码检查
	   'Check "WScr"&DoMyBest&"ipt.Shell"
	    If instr( filetxt, Lcase("WScr"&DoMyBest&"ipt.Shell") ) or Instr( filetxt, Lcase("clsid:72C24DD5-D70A"&DoMyBest&"-438B-8A42-98424B88AFB8") ) then HX_ScanFile=True
	   'Check "She"&DoMyBest&"ll.Application"
	    If instr( filetxt, Lcase("She"&DoMyBest&"ll.Application") ) or Instr( filetxt, Lcase("clsid:13709620-C27"&DoMyBest&"9-11CE-A49E-444553540000") ) then HX_ScanFile=True
		if instr( filetxt,"输入马的内容")>0 or instr(filetxt,"保存文件的<font color=red>绝对路径(包括文件名:如D:\web\x.asp):</font>")>0 then ScanFile=True
		'Check .Encode
		 Set regEx = New RegExp
		 regEx.IgnoreCase = True
		 regEx.Global = True
		 regEx.Pattern = "@\s*LANGUAGE\s*=\s*[""]?\s*(vbscript|jscript|javascript).encode\b"
		 If regEx.Test(filetxt) Then HX_ScanFile=True
	    'Check my ASP backdoor :(
		 regEx.Pattern = "\bEv"&"al\b"
		 If regEx.Test(filetxt) Then HX_ScanFile=True
		'Check exe&cute backdoor
		 'regEx.Pattern = "[^.]\bExe"&"cute\b"
		 'If regEx.Test(filetxt) Then HX_ScanFile=True
		 'Set regEx = Nothing
		'Check include file
		 Set regEx = New RegExp
		 regEx.IgnoreCase = True
		 regEx.Global = True
		 regEx.Pattern = "<!--\s*#include\s*file\s*=\s*"".*"""
		 Set Matches = regEx.Execute(filetxt)
		 For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		 Next
		Set Matches = Nothing
		Set regEx = Nothing
		'Check include virtual
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "<!--\s*#include\s*virtual\s*=\s*"".*"""
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Server.MapPath("\")&"\"&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
		'Check Server&.Execute|Transfer
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ \t]*|\()"".*"""
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			tFile = Replace(Mid(Match.Value, Instr(Match.Value, """") + 1, Len(Match.Value) - Instr(Match.Value, """") - 1),"/","\")
			If Not CheckExt(FSOs.GetExtensionName(tFile)) Then
				Call HX_ScanFile( Mid(FilePath,1,InStrRev(FilePath,"\"))&tFile, replace(FilePath,server.MapPath("\")&"\","",1,1,1) )
				SumFiles = SumFiles + 1
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
		
		'Check Server&.Execute|Transfer
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "Server.(Exec"&"ute|Transfer)([ \t]*|\()[^""]\)"
		If regEx.Test(filetxt) Then HX_ScanFile=True
		Set Matches = Nothing
		Set regEx = Nothing
		'Check Crea"&"teObject
		Set regEx = New RegExp
		regEx.IgnoreCase = True
		regEx.Global = True
		regEx.Pattern = "CreateO"&"bject[ |\t]*\(.*\)"
		Set Matches = regEx.Execute(filetxt)
		For Each Match in Matches
			If Instr(Match.Value, "&") or Instr(Match.Value, "+") or Instr(Match.Value, """") = 0 or Instr(Match.Value, "(") <> InStrRev(Match.Value, "(") Then
				HX_ScanFile=True
				exit Function
			End If
		Next
		Set Matches = Nothing
		Set regEx = Nothing
	end if
	set ofile = nothing
	set fsos = nothing	
End Function

Public PrivateKey
Public PublicKey
Public Modulus

Public Function Crypt(pLngMessage, pLngKey)
  On Error Resume Next
  Dim lLngMod
  Dim lLngResult
  Dim lLngIndex
  If pLngKey Mod 2 = 0 Then
    lLngResult = 1
    For lLngIndex = 1 To pLngKey / 2
      lLngMod = (pLngMessage ^ 2) Mod Modulus
      lLngResult = (lLngMod * lLngResult) Mod Modulus
      If Err Then Exit Function
    Next
  Else
    lLngResult = pLngMessage
    For lLngIndex = 1 To pLngKey / 2
     lLngMod = (pLngMessage ^ 2) Mod Modulus
     On Error Resume Next
     lLngResult = (lLngMod * lLngResult) Mod Modulus
     If Err Then Exit Function
    Next
  End If
  Crypt = lLngResult
End Function

Public Function HX_Encode(ByVal pStrMessage)
  Dim lLngIndex
  Dim lLngMaxIndex
  Dim lBytAscii
  Dim lLngEncrypted
  lLngMaxIndex = Len(pStrMessage) 
  If lLngMaxIndex = 0 Then Exit Function 
    For lLngIndex = 1 To lLngMaxIndex 
      lBytAscii = Asc(Mid(pStrMessage, lLngIndex, 1)) 
      lLngEncrypted = Crypt(lBytAscii, PublicKey) 
      HX_Encode = HX_Encode & NumberToHex(lLngEncrypted, 4) 
    Next 
End Function

Public Function HX_Decode(ByVal pStrMessage) 
  Dim lBytAscii 
  Dim lLngIndex 
  Dim lLngMaxIndex 
  Dim lLngEncryptedData 
  HX_Decode = "" 
  lLngMaxIndex = Len(pStrMessage) 
  For lLngIndex = 1 To lLngMaxIndex Step 4 
    lLngEncryptedData = HexToNumber(Mid(pStrMessage, lLngIndex, 4)) 
    lBytAscii = Crypt(lLngEncryptedData, PrivateKey) 
    HX_Decode = HX_Decode & Chr(lBytAscii) 
  Next 
End Function 
     
Private Function NumberToHex(ByRef pLngNumber, ByRef pLngLength) 
  NumberToHex = Right(String(pLngLength, "0") & Hex(pLngNumber), pLngLength) 
End Function 

Private Function HexToNumber(ByRef pStrHex) 
  HexToNumber = CLng("&h" & pStrHex) 
End Function 

function Encryptstr(Message) 
Dim LngKeyE 
Dim LngKeyD 
Dim LngKeyN 
Dim StrMessage 
Dim ObjRSA 
    LngKeyE = "32823" 
    LngKeyD = "20643" 
    LngKeyN = "29893" 
    StrMessage = Message      
     PublicKey = LngKeyE 
     Modulus = LngKeyN 
     Encryptstr = HX_Encode(StrMessage) 
end function 

function decryptstr(Message) 
Dim LngKeyE 
Dim LngKeyD 
Dim LngKeyN 
Dim StrMessage 
Dim ObjRSA 
    LngKeyE = "32823" 
    LngKeyD = "20643" 
    LngKeyN = "29893" 
    StrMessage = Message 
        PrivateKey =LngKeyD 
        Modulus=LngKeyN 
        decryptstr=HX_Decode(StrMessage) 
end function 
END CLASS
%>