📄 hx_system.asp
字号:
CheckUnit = formatnumber(size/1024,2)
Case "k"
CheckUnit = size
Case "m"
CheckUnit = (size*1024)
Case "g"
CheckUnit = (size*1024*1024)
Case Else
CheckUnit = size
End Select
End Function
Public Sub DelFiles(strFiles)
if strFiles="" then Exit Sub
dim fso,arrFiles,i
On Error Resume Next
Err=0
Set fso = CreateObject("scripting.FileSystemObject")
if fso.FileExists(server.MapPath(strFiles)) then
fso.DeleteFile(server.MapPath(strFiles))
if 0=Err then
Response.write "<br>清除文件（"&strFiles&"）成功！"
else
Response.write "<br>清除文件（"&strFiles&"）失败！"
end if
end if
Set fso = Nothing
Err=0
End Sub
Public Sub DownloadFile(strFile,sReName)
On error resume next
Server.ScriptTimeOut=999999
Dim S,fso,f,intFilelength,strFilename
strFilename = server.MapPath(strFile)
Response.Clear
Set s = Server.CreateObject("Adodb." & "Str" & "eam")
s.Open
s.Type = 1
Set fso = Server.CreateObject("scripting.FileSystemObject")
If Not fso.FileExists(strFilename) Then
Response.Write("<h1>错误: </h1><br>系统找不到指定文件！<a href='javascript:history.go(-1)'><font color=red>点此返回</font></a>吧！")
Exit Sub
End If
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
If err Then
Response.Write("<h1>错误: </h1>" & err.Description & "<p>")
Response.End
End If
Set fso=Nothing
Dim Data
Data=s.Read
s.Close
Set s=Nothing
If Response.IsClientConnected Then
Response.AddHeader "Content-Disposition", "attachment; filename="&ReplaceBadChar(sReName)&"."&GetDownLoadFileExt(f.name)
Response.AddHeader "Content-Length", intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite Data
Response.Flush
End If
End Sub
Public Function GetDownLoadFileExt(strFile)
GetDownLoadFileExt="rar"
Dim strExt
if Isnull(strFile) then Exit Function
if Instr(strFile,".")<=0 then Exit Function
strExt=Split(strFile,".")
GetDownLoadFileExt=strExt(Ubound(strExt))
End Function
Public Function ReplaceBadChar(strChar)
strChar=replace(replace(strChar," ",""),"'","")
strChar=replace(replace(strChar,".",""),"<","")
strChar=replace(replace(strChar,")",""),"(","")
strChar=replace(replace(strChar,"?",""),"*","")
strChar=replace(replace(strChar,"/",""),"\","")
ReplaceBadChar=replace(strChar,Chr(0),"")
End Function
Public Function HTMLEncode(fString)
If Not IsNull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = replace(fString, "&", "&")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
HTMLEncode = fString
End If
End Function
Public Function HTMLCode(fString)
If Not IsNull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, " "," ")
fString = Replace(fString, """, CHR(34))
fString = Replace(fString, "'", CHR(39))
fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10))
fString = Replace(fString, "<BR> ", CHR(10))
HTMLCode = fString
End If
End Function
Public Function NoHtml(str)
if not isnull(str) then
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(\<.[^\<]*\>)"
str=re.replace(str," ")
re.Pattern="(\<\/[^\<]*\>)"
str=re.replace(str," ")
NoHtml=str
Set re=Nothing
End if
End Function
'sContent（要转换的数据字符串）
'sFilters（要过滤掉的格式集，用"|"分隔多个）
Public Function DeCode(sContent, sFilters)
Dim a_Filter, i, s_Result, s_Filters
Decode = sContent
If IsNull(sContent) or IsNull(sFilters) Then Exit Function
If sContent = "" or sFilters = "" Then Exit Function
s_Result = sContent
s_Filters = sFilters
If InStr(s_Filters,"|")>0 then
a_Filter = Split(s_Filters, "|")
For i = 0 To UBound(a_Filter)
s_Result = DecodeFilter(s_Result, a_Filter(i))
Next
Else
s_Result = DecodeFilter(s_Result, s_Filters)
End If
DeCode = s_Result
End Function
Public Function DecodeFilter(sContent, sFilter)
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
Select Case Ucase(sFilter)
Case "SCRIPT"'去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
regEx.Pattern = "</?script[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "(javascript|jscript|vbscript|vbs):"
sContent = regEx.replace(sContent,"$1：")
regEx.Pattern = "on(mouse|exit|error|click|key)"
sContent = regEx.replace(sContent,"<I>on$1</I>")
Case "OBJECT"'去除对象<object><param><embed></object>
regEx.Pattern = "</?object[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "</?param[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "</?embed[^>]*>"
sContent = regEx.replace(sContent,"")
Case "TABLE"'去除表格<table><tr><td><th>
regEx.Pattern = "</?table[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "</?tr[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "</?th[^>]*>"
sContent = regEx.replace(sContent,"")
regEx.Pattern = "</?td[^>]*>"
sContent = regEx.replace(sContent,"")
Case "CLASS"'去除样式类class=""
regEx.Pattern = "(<[^>]+) class=[^ |^>]*([^>]*>)"
sContent = regEx.replace(sContent,"$1 $2")
Case "STYLE"'去除样式style=""
regEx.Pattern = "(<[^>]+) style=\""[^\""]*\""([^>]*>)"
sContent = regEx.replace(sContent,"")
Case "XML"'去除XML<?xml>
regEx.Pattern = "<\\?xml[^>]*>"
sContent = regEx.replace(sContent,"")
Case "NAMESPACE"'去除命名空间<o:p></o:p>
regEx.Pattern = "<\/?[a-z]+:[^>]*>"
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
'程序编写及设计:徐勇
'QQ号码: 563097256(网络侠客)
'网址：http://www.wsoas.com
'E_mail(MSN):netcst@126.com
'电话:13856921303 0551-5168961
'以上信息不影响程序运行!
'在使用过程中请保留以上信息,以便出现问题时及时与我取得联系
'注意：免费版程序不得用于商业用途，否则后果自负！！！！
END CLASS
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -