")
fString = Replace(fString, CHR(10), " ")
HTMLEncode = fString
End If
End Function
''+++++++++++++++++++++++++++++++++++++++++++++++++++
''过程名:HTMLDecode(fString)
''作用 :装回原html代码
''参数 :fString 具体内容
''+++++++++++++++++++++++++++++++++++++++++++++++++++
Function HTMLDecode(fString)
If Not IsNull(fString) Then
fString = Replace(fString, "'" , CHR(39))
fString = Replace(fString, """ , CHR(34))
fString = Replace(fString, " ", CHR(9))
fString = Replace(fString, " " , CHR(32))
fString = replace(fString, "<" , "<")
fString = replace(fString, ">" , ">")
fString = Replace(fString, " ", CHR(10))
fString = Replace(fString, "
" , CHR(10) & CHR(10))
fString = Replace(fString, "" , CHR(13))
HTMLDecode = fString
End If
End Function
''+++++++++++++++++++++++++++++++++++++++++++++++++++
''过程名:NoHtml
''作用 :处理html代码
''参数 :str 需要处理的字符串
''+++++++++++++++++++++++++++++++++++++++++++++++++++
Function nohtml(str)
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
End Function
''+++++++++++++++++++++++++++++++++++++++++++++++++++
''过程名:strlen
''作用 :求取字符长度
''参数 :str 需要处理的字符串
''+++++++++++++++++++++++++++++++++++++++++++++++++++
Function strLen(str)
If isNull(str) Or Str = "" Then
StrLen = 0
Exit Function
End If
Dim WINNT_CHINESE
WINNT_CHINESE=(len("例子")=2)
If WINNT_CHINESE Then
Dim l,t,c
Dim i
l=len(str)
t=l
For i=1 To l
c=asc(mid(str,i,1))
If c<0 Then c=c+65536
If c>255 Then t=t+1
Next
strLen=t
Else
strLen=len(str)
End If
End Function
''+++++++++++++++++++++++++++++++++++++++++++++++++++
''过程名:cutStr
''作用 :取特定长度的字符串
''参数 :str 需要处理的字符串,strLen 长度
''+++++++++++++++++++++++++++++++++++++++++++++++++++
function cutStr(str,strlen)
dim l,t,c
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
cutStr=left(str,i)&"..."
exit for
else
cutStr=str
end if
next
cutStr=replace(cutStr,chr(10),"")
end function
'防止SQL注入
Function Checkstr(Str)
If Isnull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str,Chr(0),"")
CheckStr = Replace(Str,"'","''")
End Function
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'过程名：formatDT
'作 用：格式化日期显示
'参 数：Dtype 显示类型，DateTime 要格式化显示的时间
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function formatDT(Dtype,DateTime)
select case Dtype
'2004-07-25 09:40:50
case "0" formatDT = year(DateTime) & "-" & doublenum(Month(DateTime)) & "-" & doublenum(Day(DateTime)) & " " & doublenum(Hour(DateTime)) & ":" & doublenum(Minute(DateTime)) & ":" & doublenum(Second(DateTime))
'2004-07-25 09:40
case "1" formatDT = year(DateTime) & "-" & doublenum(Month(DateTime)) & "-" & doublenum(Day(DateTime)) & " " & doublenum(Hour(DateTime)) & ":" & doublenum(Minute(DateTime))
'07/25/03
case "2" formatDT = doublenum(Month(DateTime)) & "/" & doublenum(Day(DateTime))& "/" & Right(year(DateTime),2)
'2004-07
case "3" formatDT = year(DateTime) & "-" & doublenum(Month(DateTime))
'07-25
case "4" formatDT = doublenum(Month(DateTime)) & "-" & doublenum(Day(DateTime))
'09:40:50
case "5" formatDT = doublenum(Hour(DateTime)) & ":" & doublenum(Minute(DateTime)) & ":" & doublenum(Second(DateTime))
'09:40
case "6" formatDT = doublenum(Hour(DateTime)) & ":" & doublenum(Minute(DateTime))
'2004年07月25日
case "7" formatDT = year(DateTime) & "年" & doublenum(Month(DateTime)) & "月" & doublenum(Day(DateTime)) & "日"
'2004年07月
CASE "8" formatDT = year(DateTime) & "年" & doublenum(Month(DateTime)) & "月"
'07月25日
case "9" formatDT = doublenum(Month(DateTime)) & "月" & doublenum(Day(DateTime)) & "日"
'07月25日 09:40
case "10" formatDT = doublenum(Month(DateTime)) & "月" & doublenum(Day(DateTime)) & "日 " & doublenum(Hour(DateTime)) & ":" & doublenum(Minute(DateTime))
'Monday,Jul 25,2004
case "11"
MonthArray = Array("January","February","March","April","May","June","July","August","September","October","November","December")
WeekArray = Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
formatDT = WeekArray(Weekday(DateTime )-1) & "," & MonthArray(Month(DateTime)-1) & " " &Day(DateTime) & "," & Year(DateTime)
end select
End Function
'取两位以上的数据
'如果取指定的n位，可以使用Right函数(从字符串右边返回指定数目的字符。)
Function DoubleNum(fNum)
if fNum > 9 then
doublenum = fNum
else
doublenum = "0" & fNum
end if
End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ End ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'替换字符
Function ReplaceText(StrContent,PatternStr,reText)
Dim objRe
Set objRe=New RegExp
objRe.Pattern=PatternStr
objRe.Global=True
objRe.IgnoreCase=True
' objRe.MultiLine=True
ReplaceText=objRe.Replace(StrContent,reText)
Set objRe=nothing
End Function
function AnsiEnCode(vstrIn)
Dim i, strReturn, innerCode, ThisChr
Dim Hight8, Low8
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
AnsiEnCode = strReturn
End Function
Function AnsiDeCode(s)
Dim i, sTmp, sResult, sTmp1
sResult = ""
For i=1 To Len(s)
If Mid(s,i,1)="%" Then
sTmp = "&H" & Mid(s,i+1,2)
If isNumeric(sTmp) Then
If CInt(sTmp)=0 Then
i = i + 2
ElseIf CInt(sTmp)>0 And CInt(sTmp)<128 Then
sResult = sResult & Chr(sTmp)
i = i + 2
Else
If Mid(s,i+3,1)="%" Then
sTmp1 = "&H" & Mid(s,i+4,2)
If isNumeric(sTmp1) Then
sResult = sResult & Chr(CInt(sTmp)*16*16 + CInt(sTmp1))
i = i + 5
End If
Else
sResult = sResult & Chr(sTmp)
i = i + 2
End If
End If
Else
sResult = sResult & Mid(s,i,1)
End If
Else
sResult = sResult & Mid(s,i,1)
End If
Next
AnsiDeCode = sResult
End Function
'*******************************************
'客户端模拟交互类 2005年5月18日 星期三 [R.W.]
'################################################################################################
'获取客户端的IP
Public Function Web_GetClientIP()
Web_GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
if Web_GetClientIP = "" then Web_GetClientIP = Request.ServerVariables("REMOTE_ADDR")
end function
'客户端脚本:alert(Msg) I;
Public Sub Client_Alert(ByVal Msg)
Response.Write("")
End Sub
'客户端脚本:alert(Msg) II;
Public Sub Client_Alert2(ByVal Msg,ByVal returnURL)
Response.Write("")
End Sub
'客户端脚本:confrim(Msg) I;
Public Sub Client_Confirm(ByVal Msg,ByVal url)
Response.Write("")
End Sub
'客户端脚本:confrim(Msg) II;
Public Sub Client_Confirm2(ByVal Msg,ByVal cfmurl,ByVal retrunURL)
Response.Write("")
End Sub
'客户端脚本:重定向网址
Public Sub Client_Redirect(ByVal URL,ByVal CopyHistory)
if CopyHistory then
Response.Write("")
else
Response.Write("")
end if
End Sub
Sub ShowMsgPage(URLPath)
Response.Clear()
Response.Redirect(URLPath)
Response.End
End Sub
'*****************************************
'显示特定消息
'*****************************************
Sub ShowMsg(strMsg,iSecond)
if len(strMsg)>0 then
%>
<%=strMsg%>
<%
end if
End Sub
'*******************************************
'判断抉择类 2005年5月18日 星期三 [R.W.]
'################################################################################################
''+++++++++++++++++++++++++++++++++++++++++++++++++++
''过程名:IsOuterPost
''作用 :判断是否为外部提交数据
''参数 :无
''+++++++++++++++++++++++++++++++++++++++++++++++++++
Function IsOuterPost()
dim server_v1,server_v2
server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(server_v1,8,len(server_v2))<>server_v2 then
IsOuterPost=true
else
IsOuterPost=false
end if
End Function
Function checkEmail(strEmailAddr)
Dim re
Set re = new RegExp
re.pattern = "^[a-zA-Z][A-Za-z0-9_.-]+@[a-zA-Z0-9_]+?\.[a-zA-Z]{2,3}$"
chkemail=re.Test(strEmailAddr)
End Function
Function checkQQ(qq)
Dim re1
Set re1 = new RegExp
re1.IgnoreCase = false
re1.global = false
re1.Pattern = "[0-9]{4,9}$"
chkqq = re1.Test(qq)
End Function
'检测安装的组件
Function IsObjInstalled(strClassString)
'on error resume next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
Function IsEmptyStr(strChk)
if IsNull(strChk) then
IsEmptyStr = true
Exit Function
else
if Len(CStr(strChk))>=1 then
IsEmptyStr = false
else
IsEmptyStr = true
end if
end if
End Function
Function IsNumber(str)
if not IsEmptyStr(str) then
isNumber = isNumeric(str)
else
isNumber = false
end if
End Function
'*****************************************
'自动处理显示哪种内容
'*****************************************
Function HtmlShow(objStr,nullShow,hShow)
if not IsEmptyStr(objStr) then
HtmlShow = Replace(hShow,"$",objStr)
else
HtmlShow = nullShow
end if
End Function
Function getWhich(blnJudge,yesShow,noShow)
if (blnJudge = true) then
getWhich = yesShow
else
getWhich = noShow
end if
End Function
Function GetCode(str,lenNum)
if len(str)1024 then
size=(Size/1024)
showsize=size & " KB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " MB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " GB"
end if
response.write "" & showsize & ""
End Sub
Sub Showspecialspaceinfo(method)
dim fso,d,fc,f1,size,showsize,drvpath
set fso=server.createobject("scripting.filesystemobject")
drvpath=server.mappath("pic")
drvpath=left(drvpath,(instrrev(drvpath,"\")-1))
set d=fso.getfolder(drvpath)
if method="All" then
size=d.size
elseif method="Program" then
set fc=d.Files
for each f1 in fc
size=size+f1.size
next
end if
showsize=size & " Byte"
if size>1024 then
size=(Size/1024)
showsize=size & " KB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " MB"
end if
if size>1024 then
size=(size/1024)
showsize=formatnumber(size,2) & " GB"
end if
response.write "" & showsize & ""
end sub
Function Drawbar(drvpath)
dim fso,drvpathroot,d,size,totalsize,barsize
set fso=server.createobject("scripting.filesystemobject")
drvpathroot=server.mappath("pic")
drvpathroot=left(drvpathroot,(instrrev(drvpathroot,"\")-1))
set d=fso.getfolder(drvpathroot)
totalsize=d.size
drvpath=server.mappath(drvpath)
set d=fso.getfolder(drvpath)
size=d.size
barsize=cint((size/totalsize)*400)
Drawbar=barsize
End Function
Function Drawspecialbar()
dim fso,drvpathroot,d,fc,f1,size,totalsize,barsize
set fso=server.createobject("scripting.filesystemobject")
drvpathroot=server.mappath("pic")
drvpathroot=left(drvpathroot,(instrrev(drvpathroot,"\")-1))
set d=fso.getfolder(drvpathroot)
totalsize=d.size
set fc=d.files
for each f1 in fc
size=size+f1.size
next
barsize=cint((size/totalsize)*400)
Drawspecialbar=barsize
End Function
'*******************************************
'数据分页列表类 2005年5月18日 星期三 [R.W.]
'################################################################################################
'***********************************************************
'分页显示 [ 共 15 页 ] << < 第 6 7 8 9 10 页 > >> 2005年4月12日
'***********************************************************
Function showPageList(iTotal,iPagesize,iCurrentpage,iListNum,strPageVar)
dim pstr,totalpage,iCount,mTotal
dim prePage,nextPage,iPage
if (iTotal mod iPagesize > 0) then
totalpage = Fix(iTotal/iPagesize) + 1
else
totalpage = iTotal/iPagesize
end if
if (iCurrentpage>totalpage) then iCurrentpage=totalpage
if (iCurrentpage<1) then iCurrentpage = 1
if (iCurrentPage <> 1) then
pStr = pStr & "<< "&" < 第 "
else
pStr = pStr & "<< "&" < 第 "
end if
if (iListNum mod 2 = 0) then iListNum = iListNum+1
mTotal = (iListNum+1)/2
for iCount=1 to iListNum
if iCount < mTotal then
iPage = iCurrentPage - (mTotal-iCount)
if iPage > 0 then
pStr = pStr & " "&iPage&" "
end if
elseif iCount = mTotal then
pStr = pStr & " "&iCurrentPage&" "
else
iPage = iCurrentPage + (iCount-mTotal)
if iPage <= totalPage then
pStr = pStr & " "&iPage&" "
end if
end if
next
if (iCurrentPage <> totalpage) then
pStr = pStr & "页 > "&" >>"
else
pStr = pStr & "页 > "&" >>"
end if
showPageList = "[ 共 "&totalPage&" 页 ] " & pStr
End Function
'*********************************************
'检查是否在翻页 (通过比较除传递页数之外的参数值:QueryString翻页适用)
'比较页面>比较参数
'*********************************************
Function IsTurnPage(strPageVar)
Dim fileLast,fileNow,strVal
Dim iLoc,blnTurning,blnNewPage
blnTurning = true
fileLast = Request.ServerVariables("HTTP_REFERER")
fileNow = Request.ServerVariables("SCRIPT_NAME")
blnNewPage = (InStr(1,LCase(fileLast),LCase(FileNow),1)=0)
if (not blnNewPage) then
'*********************比较现值与引用值**************
iLoc = InStr(1,fileLast,"?",1)
if iLoc >0 then
fileLast = Mid(fileLast,iLoc+1)
for each strVal in Request.QueryString
if strVal <> strPageVar then
if Request.QueryString(strVal) <> GetQueryString(strVal,fileLast) then
blnTurning = false
Exit for
end if
end if
next
else
blnTurning = false
end if
else
blnTurning = false
end if
IsTurnPage = blnTurning
End Function
'*********************************************
'取得strQueryString中的strVal的值，如：GetQueryString("page","st=1&page=2&ss=yes") = 2
'*********************************************
Function GetQueryString(strVal,strQueryString)
Dim iLoc,iStart,iEnd,VarArray
Dim k
iLoc = InStr(1,strQueryString,"=",1)
if (iLoc> 0) then
VarArray = Split(strQueryString,"&")
for k=0 to UBound(VarArray)
iStart = InStr(1,VarArray(k),strVal,1)
iEnd = InStr(1,VarArray(k),"=",1)
if iStart>0 then
GetQueryString = Mid(VarArray(k),iEnd+1)
Exit for
end if
next
else
GetQueryString = ""
end if
End Function
'*******************************************
'调试操作 2005年5月18日 星期三 [R.W.]
'################################################################################################
Private const sDebugTemplate = "
"
Public Function Debug_String(ByVal message)
Response.Write(Replace(sDebugTemplate,"[信息内容]",Message))
'Response.End
end function
Public Function Debug_Topic(ByVal message,ByVal topic)
Response.Write(Replace(Replace(sDebugTemplate,"[信息内容]",Message),"调试信息",topic))
'Response.End
end function
%>