下次自动登录
现在的位置:
& 综合 & 正文
[转]分享我的常用函数库
发了这篇贴子，俺也是超级用户了，借此勉励，希望大家喜欢，有能用上的顶一下，有建议的也帮忙给点意见，谢谢了！
'清理SQL字符串，防止注入
function Sqlstr(data)
sqlstr="'" & replace(data,"'","''") & "'"
end function
'在当前位置设置断点，如果出错则给出错误提示并停止运行，否则提示没错，继续运行
sub Chkerr(place)
if is_debug = false then exit sub
if err then
Response.Write "错误发生在:"&place&"&br /&错误描述:"&err.description
response.End()
Response.Write "&br /&在[&font color=""red""&"&place&"&/font&]没有发生错误！"
'当前位置输出某个变量值
sub Chkstr(str)
if is_debug then Response.Write str&"&br /&"
'替换response.write ，偷懒的做法
sub Outputx(str)
Response.Write str
'在当前位置停止运行，同时检查错误
sub Debug(dstr)
if dstr="" then dstr="Debug stops here:--"
chkerr dstr
outputx "&br /&DEBUG STOPS HERE"
response.End()
'输出表格属性，也是一偷懒的做法
sub Table_Alt()
response.Write(" width=""98%"" border=""1"" align=""center"" cellpadding=""0"" cellspacing=""1"" bordercolorright=""#000000"" bordercolordark=""#ffffff"" ")
'隐藏该标签，如&table ..... &% Hide_This % & &
sub Hide_This()
outputx " style=""display:"" "
'禁止某个控件的点击，如&a &,&input ../&等等
sub Disable_Menu()
response.Write " onclick="""" "
'在当前位置显示一个图片，给出帮助信息，点击后弹出提示框
sub help(str)
str = "-- 帮助 --
/n/n帮助信息:"&str
response.Write "&a href=""#"" onclick=""alert('"&str&"');""&&img src=""p/help.gif"" alt="""&replace(replace(str,"/n/n","/n"),"/n","&br /&")&""" /&&/a&"
'检查输入值，如果为空，则用-替代，可用于防止保存到数据库的为空值，或某值为空时的显示不规则
function Get_Value(x)
if isnull(x) or x="" then
get_value = "-"
get_value = x
end function
'用CSS定义&H6&，显示系统提示信息，如需要，可提供更详细的使用说明
sub Sys_Tip(msg)
if len(msg)&0 then response.write "&h6&"&msg&"&/h6&"
'检查当前recordset是否为空
'用if isrb(rs) then 替代 if rs.bof and rs.eof then
'也是一偷懒的方法
function isRb(rs)
if rs.bof and rs.eof then
isrb = true
isrb = false
end function
'清理以,分割的字符串，清理其中的两个分隔符号，去掉前后的符号
function Clean_Ary(ary_name)
if left(ary_name,1) = "," then ary_name=mid(ary_name,2,len(ary_name))
if right(ary_name,1) = "," then ary_name=mid(ary_name,1,len(ary_name)-1)
do while instr(ary_name,",,")&&0
ary_name = replace(ary_name,",,",",")
clean_ary = ary_name
end function
'去掉输入参数里的HTML标签，这是其中一个函数
Function RemoveHTML_A(strText)
nPos1 = InStr(strText, "&")
Do While nPos1&0
nPos2 = InStr(nPos1+1, strText, "&")
If nPos2&0 Then
strText = Left(strText, nPos1 - 1) & Mid(strText, nPos2 + 1)
nPos1 = InStr(strText, "&")
RemoveHTML_A = strText
End Function
'在新闻标题列表等应用中，只取一定长度的字符，若超过这个长度，则加上...
function GetTitle(title,content,length)
If length = 0 Then length = 8
if title = "" or isnull(title) then title = left(RemoveHTML_A(content),30)
If Len(title) & length Then
GetTitle = Left(title, length) & ".."
GetTitle = title
end function
'关闭和释放记录集对象
sub RsClose(rst)
if isobject(rst) then
set rst = nothing
'关闭和释放connetion对象
sub DbClose(conn)
if isobject(conn) then
conn.close
set conn = nothing
'这也是种关闭和释放对象的方法，在页末使用
sub EndPage(rs,conn)
set rs = nothing
set conn = nothing
'这是一组时间函数，是我在做取昨天的日期的时候整理的
'判断是否是闰年
Function IsLeapYear(yr)
If ((yr Mod 4 = 0 ) And (yr Mod 100 && 0)) Or (yr Mod 400 = 0) Then
IsLeapYear = True
IsLeapYear = False
End Function
function get_month_last_day(sm)
redim months(12)
months(1)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(2)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28"
if IsLeapYear(year(date())) then months(2) = months(2) &",29"
months(3)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(4)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(5)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(6)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(7)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(8)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(9)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(10)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
months(11)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30"
months(12)="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
get_month_last_day = mid(months(sm),len(months(sm))-1,2)
end function
'得到昨天的日期
function get_lastday(this_day)
'outputx "今天是"&this_day&",今年的第["&datediff("d","",this_day)&"]天&br /&"
syear = year(this_day)
smonth = month(this_day)
sday = day(this_day)
if sday = 1 then
if smonth = 1 then '去年
get_lastday = cstr(cint(syear)-1)&"-12-31"
get_lastday = syear&"-"& cstr(cint(smonth)-1)&"-"&get_month_last_day(cstr(cint(smonth)-1))
get_lastday = syear&"-"&smonth&"-"&cstr(sday-1)
end function
'一组根据输入值是否为空而返回同值的函数
'检查是否为空，如是则返回"未填写"
function chk_not_input(str)
if str="" or isnull(str) then
chk_not_input="未填写"
chk_not_input=str
end function
'检查是否为空，返回str类型
function chk_null_str(str)
if str="" or isnull(str) then
chk_null_str="未填"
chk_null_str=str
end function
'检查是否为空，返回0
function chk_null_0(str)
if isnull(str) or str="" or str="-" then
chk_null_0="0"
chk_null_0=str
end function
'检查是否为空，为空则用X替换
function chk_null_x(str,x)
if str="" or isnull(str) then
chk_null_x=x
chk_null_x=str
end function
'检查是否为空，为空则用横线替换
function chk_null_line(str)
if str="" or isnull(str) then
chk_null_line="-"
chk_null_line=str
end function
乘机一帖，希望能有用
'''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理'''''''''''''''''''''''''''''''''''''''''''''''''
一直使用着，调用很明了，有两种：
1，call alert("弹出返回信息","-1")
2，call alert("跳转某地址","http: //.....")
Function alert(message,gourl)
message = replace(message,"'","/'")
If gourl="" or gourl="-1" then
Response.Write ("&script language=javascript&alert('" & message & "');history.go(-1)&/script&")
Response.Write ("&script language=javascript&alert('" & message & "');location='" & gourl &"'&/script&")
Response.End()
End Function
'''''''''''''''''''''''''''''''''''''''''''禁止站外提交数据'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些权限页面（即凭借用户名密码正确登录后能访问的页）上，直接 call outofsite() 调用检查。
注意：这里就使用了上面的 alert(message,gourl) 函数。
Function outofsite()
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
call alert("/n注意，为确保本站点的安全性：/n● 禁止直接输入网址到达机密页面！/n● 禁止从站点外部非法向本站提交数据！/n● 请使用正确的访问途径合法登录，谢谢合作。","-1")
End Function
'''''''''''''''''''''''''''''''''''''''''''取得IP地址'''''''''''''''''''''''''''''''''''''''''''''''''
要获得IP值直接使用 call userip() 即可
Function Userip()
Dim GetClientIP
'如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法
GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then
'如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法
GetClientIP = Request.ServerVariables("REMOTE_ADDR")
Userip = GetClientIP
End function
'''''''''''''''''''''''''''''''''''''''''''简易处理较长文本'''''''''''''''''''''''''''''''''''''''''''''''''
我一般是用在首页的新闻标题调用，主要是中文，所以就用个简易的。
比如提取标题只显示12个字。 call conleft(rs("n_title"),12)
function conleft(contact,i)
if len(contact)&i then
contact=left(contact,i)
conleft=contact&"..."
conleft=contact
end function
'''''''''''''''''''''''''''''''''''''''''''登陆验证接口函数'''''''''''''''''''''''''''''''''''''''''''''''''
接口有一定的通用性：）
先 call outofsite() 防止外部注册机提交requestname和requestpwd 分别表示接受用户名和密码的表单对象的名称tablename、namefield和pwdfield 分别表示数据库中存放用户信息的表、记录用户名的字段和用户密码的字段。（这里密码是MD5加密，否则请修改函数中的MD5()包含）reurl 表示正确登录后跳转的地址
注意：这里同样使用了上面的 alert(message,gourl) 函数
有人还有就是增加了验证码，这里说明下：主要是先验证码正确，再检测用户名和密码的，所以本函数与有验证码的登录无大关系。
关于这个还有要增强的，就是每次用户名和密码不正确的记录，连上该帐号测试的IP，一起通过JMAIL发送到管理员信箱，这样管理员就能随时掌握登录的情况。
Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)
call outofsite()
dim cn_name,cn_pwd
cn_name=trim(request.form(""&requestname&""))
cn_pwd=trim(request.form(""&requestpwd&""))
if cn_name="" or cn_pwd="" then
call alert("请将帐号或密码填写完整，谢谢合作。","-1")
response.end()
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&namefield&"='"&cn_name&"'"
rs.open sql,conn,1,1
if rs.eof then
call alert("警告，非法猜测用户名！","-1")
if rs(""&pwdfield&"")=md5(cn_pwd) then
session("cn_name")=rs(""&namefield&"") '这个地方的session名称可以自己修改
response.Redirect(reurl)
call alert("请正确输入用户名和与之吻合的密码。","-1")
End Function
'''''''''''''''''''''''''''''''''''''''''''布尔切换值函数'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些双向选择的字段类型上，比如产品的 推荐和不推荐 等
具体如何应用就不详说了，各位慢慢看
function pvouch(tablename,fildname,autoidname,indexid)
dim fildvalue
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&autoidname&"="&indexid
rs.Open sql,conn,2,3
fildvalue=rs(""&fildname&"")
if fildvalue=0 then
fildvalue=1
fildvalue=0
rs(""&fildname&"")=fildvalue
Set rs = Nothing
end function
Blueidea Web TeamModerator Of Blueidea Developer forum
乘机一帖，希望能有用
'''''''''''''''''''''''''''''''''''''''''''弹出信息对话框并做相应处理'''''''''''''''''''''''''''''''''''''''''''''''''
一直使用着，调用很明了，有两种：
1，call alert("弹出返回信息","-1")
2，call alert("跳转某地址","http: //.....")
Function alert(message,gourl)
message = replace(message,"'","/'")
If gourl="" or gourl="-1" then
Response.Write ("&script language=javascript&alert('" & message & "');history.go(-1)&/script&")
Response.Write ("&script language=javascript&alert('" & message & "');location='" & gourl &"'&/script&")
Response.End()
End Function
'''''''''''''''''''''''''''''''''''''''''''禁止站外提交数据'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些权限页面（即凭借用户名密码正确登录后能访问的页）上，直接 call outofsite() 调用检查。
注意：这里就使用了上面的 alert(message,gourl) 函数。
Function outofsite()
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
call alert("/n注意，为确保本站点的安全性：/n● 禁止直接输入网址到达机密页面！/n● 禁止从站点外部非法向本站提交数据！/n● 请使用正确的访问途径合法登录，谢谢合作。","-1")
End Function
'''''''''''''''''''''''''''''''''''''''''''取得IP地址'''''''''''''''''''''''''''''''''''''''''''''''''
要获得IP值直接使用 call userip() 即可
Function Userip()
Dim GetClientIP
'如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法
GetClientIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If GetClientIP = "" or isnull(GetClientIP) or isempty(GetClientIP) Then
'如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法
GetClientIP = Request.ServerVariables("REMOTE_ADDR")
Userip = GetClientIP
End function
'''''''''''''''''''''''''''''''''''''''''''简易处理较长文本'''''''''''''''''''''''''''''''''''''''''''''''''
我一般是用在首页的新闻标题调用，主要是中文，所以就用个简易的。
比如提取标题只显示12个字。 call conleft(rs("n_title"),12)
function conleft(contact,i)
if len(contact)&i then
contact=left(contact,i)
conleft=contact&"..."
conleft=contact
end function
'''''''''''''''''''''''''''''''''''''''''''登陆验证接口函数'''''''''''''''''''''''''''''''''''''''''''''''''
接口有一定的通用性：）
先 call outofsite() 防止外部注册机提交requestname和requestpwd 分别表示接受用户名和密码的表单对象的名称tablename、namefield和pwdfield 分别表示数据库中存放用户信息的表、记录用户名的字段和用户密码的字段。（这里密码是MD5加密，否则请修改函数中的MD5()包含）reurl 表示正确登录后跳转的地址
注意：这里同样使用了上面的 alert(message,gourl) 函数
有人还有就是增加了验证码，这里说明下：主要是先验证码正确，再检测用户名和密码的，所以本函数与有验证码的登录无大关系。
关于这个还有要增强的，就是每次用户名和密码不正确的记录，连上该帐号测试的IP，一起通过JMAIL发送到管理员信箱，这样管理员就能随时掌握登录的情况。
Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)
call outofsite()
dim cn_name,cn_pwd
cn_name=trim(request.form(""&requestname&""))
cn_pwd=trim(request.form(""&requestpwd&""))
if cn_name="" or cn_pwd="" then
call alert("请将帐号或密码填写完整，谢谢合作。","-1")
response.end()
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&namefield&"='"&cn_name&"'"
rs.open sql,conn,1,1
if rs.eof then
call alert("警告，非法猜测用户名！","-1")
if rs(""&pwdfield&"")=md5(cn_pwd) then
session("cn_name")=rs(""&namefield&"") '这个地方的session名称可以自己修改
response.Redirect(reurl)
call alert("请正确输入用户名和与之吻合的密码。","-1")
End Function
'''''''''''''''''''''''''''''''''''''''''''布尔切换值函数'''''''''''''''''''''''''''''''''''''''''''''''''
主要用在一些双向选择的字段类型上，比如产品的 推荐和不推荐 等
具体如何应用就不详说了，各位慢慢看
function pvouch(tablename,fildname,autoidname,indexid)
dim fildvalue
Set rs = Server.CreateObject ("ADODB.Recordset")
sql = "Select * from "&tablename&" where "&autoidname&"="&indexid
rs.Open sql,conn,2,3
fildvalue=rs(""&fildname&"")
if fildvalue=0 then
fildvalue=1
fildvalue=0
rs(""&fildname&"")=fildvalue
Set rs = Nothing
end function
Blueidea Web TeamModerator Of Blueidea Developer forum
我也来贴两个。在数据库连接Conn开启的情况下使用。
检查数据是否重复，比如注册用户的时候。
'检查数据是否重复
Function chkRecord(newValue,chkTable,chkField)
Dim chkRecordRs,chkRecordSql,chkValue
If Trim(newValue) = "" Then
chkValue = false
chkRecordSql = "Select ID From "&chkTable&" Where "&chkField&" = '"&newValue&"'"
Set chkRecordRs = Conn.Execute( chkRecordSql )
If chkRecordRs.Eof Or chkRecordRs.Bof Then
chkValue = true
chkValue = false
Set chkRecordRs = Nothing
chkRecord = chkValue
End Function
获取在cname表中与id对应的fname的值
Function getName(id,cname,fname)
If IsNumeric(id) Then
Dim getNameRs,getNameSql
getNameSql = "Select "&fname&" From "&cname&" Where Id="&Cint(id)
Set getNameRs = Conn.Execute (getNameSql)
If Not(getNameRs.Eof Or getNameRs.Bof) Then
getName = getNameRs(fname)
getName = ""
Set getNameRs = Nothing
getName = ""
End Function
凤翱翔于千仞兮，非梧不栖。 士伏处于一方兮，非主不依。 乐躬耕于陇亩兮，吾爱吾庐。 聊寄傲于琴书兮，以待天时。
那我接两个检测正则的~~
站点链接检测
function checklink(str)
dim rs,truelink
if (str="http://") then
if not (str="") then
set rs=new regexp
rs.ignorecase=true
rs.global=true
rs.pattern="(http:////((/w)+[.]){1,}([A-Za-z]|[0-9]{1,3})(((//[/~]*|//[/~]*)(/w)+)|[.](/w)+)*(((([?](/w)+){1}[=]*))*((/w)+){1}([/&](/w)+[/=](/w)+)*)*)"
truelink=rs.test(str)
if truelink=false then
response.redirect("error.asp?err=site")
response.end
set rs=nothing
end function
电子邮件地址检测
function checkmail(str)
dim rs,truemail
if not (str="") then
set rs=new regexp
rs.ignorecase=true
rs.global=true
rs.pattern="(/w)+[@]{1}((/w)+[.]){1,3}(/w)+"
truemail=rs.test(str)
if truemail=false then
response.redirect("error.asp?err=email")
response.end
set rs=nothing
end function
仁慈的主啊，请您宽恕我这个有罪之人吧，我又开始潜水拉~~
***Lettergraph v1.1 by Ferruh Mavituna
' Write Letters as images
'//ARGUMENTS//
' valx : Text (alphanumeric)
'//SAMPLE//
' Response.Write P13_Lettergraph("soul")
' &&& Need alphabet folder &&&
'******************************
'Function P13_Lettergraph(valx,folder)
' If folder = "" Then folder ="alphabet"
'******************************
Function P13_Lettergraph(valx)
Dim ix, ix2, valxarr, curletter, lmod
If valx && "" Then
valxarr = Split(Trim(valx)," ")
For ix2 = 0 to Ubound(valxarr)
For ix = 1 to Len(valxarr(ix2))
curletter = Left(valxarr(ix2),1)
'// Turkish Character Map
If Ucase(curletter) = "Ş" Then curletter = "s2"
If Ucase(curletter) = "Ğ" Then curletter = "g2"
If Ucase(curletter) = "i" Then curletter = "i2"
If Ucase(curletter) = "&U" Then curletter = "u2"
If Ucase(curletter) = "&O" Then curletter = "o2"
If ix2 mod 2 Then lmod = "2" Else lmod = ""
P13_Lettergraph = P13_Lettergraph & "&img src=""13mg/lt" & lmod &"/" & curletter &".gif"" alt=""" & curletter & """ /&"
valxarr(ix2) = Right(valxarr(ix2),Len(valxarr(ix2))-1)
If ix2 & Ubound(valxarr) Then P13_Lettergraph = P13_Lettergraph & "&img src=""13mg/lt/dot.gif"" alt=""dot"" /&"
End Function
response.write(P13_Lettergraph(""))
response.write("")
[这消息被5do8编辑过(最后编辑时间 <font color="#:36:31)]
图片路径你要自己裁缝的
这个的意思就是说把字符串的"每个字符"导出图片形式,在ubb图片的时候可用.
-------------------返回字符串出现的次数--------------------
Function search(pSearch, pSearchStr)
Dim tempSearch, tempSearchStr, startpos, endpos
startpos = 1
Do While (startpos & 0)
endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr))
If endpos & 0 Then
ctr = ctr + 1
startpos = endpos + Len(pSearchStr)
search = ctr
End Function
------------------------url处理函数------------------------------
'Add a name/value pair to a URL
Function QueryStringAdd(ByVal URL, ByVal Name, ByVal Value)
'Start with the existing URL
QueryStringAdd = URL
'Determine whether or not there's a querystring
If (InStr(URL, "?") & 0) Then
'Yes, so append the name/value pair using an ampersand
QueryStringAdd = QueryStringAdd & "&"
'No, so start one off with a question mark
QueryStringAdd = QueryStringAdd & "?"
'And add the URLEncoded name/value pair
QueryStringAdd = QueryStringAdd & Server.URLEncode(Name) & "=" & Server.URLEncode(Value)
End Function
'Remove a name/value pair from a URL
'Usage: AllInstances = False --& Removes the rightmost instance from the URL
' AllInstances = True --& Removes all instances from the URL
Function QueryStringRemove(ByVal URL, ByVal Name, ByVal AllInstances)
Dim PositionQueryString, PageLocation, QueryString, Substring, PositionCurrent, PositionEnd, PositionAmpersand
PositionQueryString = Instr(URL, "?")
'Only process the specified URL if it actually contains a querystring!
If (PositionQueryString & 0) Then
'Split the URL into the page location and querystring
PageLocation = Left(URL, PositionQueryString - 1)
QueryString = Mid(URL, PositionQueryString)
'Build the substring we will be searching for
Substring = Server.URLEncode(Name) & "="
'Find the last (rightmost) instance of the
'specified variable in the querystring
PositionCurrent = InStrRev(QueryString, Substring) - Len(SubString)
If (AllInstances) Then
'Only stop one we've reached the start of the querystring
PositionEnd = 0
'Stop once we've removed the last instance
PositionEnd = PositionCurrent
'Loop until we've reached our set end position
While ((PositionCurrent & 0) And (PositionCurrent &= PositionEnd))
'The substring is present in the URL
PositionCurrent = InStrRev(QueryString, Substring)
If (PositionCurrent & 0) Then
'If a match was found, remove it!
'Find the start of the next querystring variable
'by finding the ampersand that would preceed it
PositionAmpersand = InStr(PositionCurrent, QueryString, "&")
If (PositionAmpersand = 0) Then
'If there isn't another ampersand in the URL then it
'must be the last variable in the querystring so
'only grab the characters from the start of the string
'up until the character before the current position
'(so that any preceeding & or ? is chopped)
QueryString = Left(QueryString, PositionCurrent - 2)
PositionCurrent = Len(QueryString)
'Otherwise grab characters from start of the string
'until the current position, and from after the
'position of the ampersand onwards
QueryString = Left(QueryString, PositionCurrent - 1) & Mid(QueryString, PositionAmpersand + 1)
PositionCurrent = PositionAmpersand
If QueryString = "?" Then
QueryString = ""
'Return the processed URL
QueryStringRemove = PageLocation & QueryString
QueryStringRemove = URL
End Function
'TEST CODE
'---------
URL = "http://www.testserver.com/tests cript.asp"
'Test adding a variable and removing it
URL = QueryStringAdd(URL,"test","1")
Response.Write URL & "&br /&"
URL = QueryStringRemove(URL,"test",False)
Response.Write URL & "&br /&"
'Now add a couple of the same name with a different one in the
'middle and remove them individually but in a different order
URL = QueryStringAdd(URL,"test","2")
URL = QueryStringAdd(URL,"dummy","dummyvalue")
URL = QueryStringAdd(URL,"test","3")
Response.Write URL & "&br /&"
URL = QueryStringRemove(URL,"test",False)
Response.Write URL & "&br /&"
URL = QueryStringRemove(URL,"test",False)
Response.Write URL & "&br /&"
URL = QueryStringRemove(URL,"dummy",False)
Response.Write URL & "&br /&"
'Now do something similar but remove all
'instances of "test" in a single call
URL = QueryStringAdd(URL,"test","2")
URL = QueryStringAdd(URL,"test","2")
URL = QueryStringAdd(URL,"dummy","dummyvalue")
URL = QueryStringAdd(URL,"test","2")
URL = QueryStringAdd(URL,"test","2")
Response.Write URL & "&br /&"
URL = QueryStringRemove(URL,"test",True)
Response.Write URL & "&br /&"
在处理get方式递交信息时好使的很!
我这个算函数吗？？
是用来替换关键字的。
'*******************************************************************
'replacekeyword(keytext)
'需要和库联接时才能使用
'入口参数：keytext
'出口参数：replacekeyword
'******************************************************************
function repkeyword(keytext)
dim db_kewords, db_rewords, arr_kewords, arr_rewords
set rers = conn.execute("select * from words_key where show=1 order by list_id")
while not rers.eof
db_kewords = db_kewords&"|"&rers(1)
db_rewords = db_rewords&"|"&lcase(rers(2))
arr_kewords = split(db_kewords,"|")
arr_rewords = split(db_rewords,"|")
rers.movenext
set rers = nothing
Set re = new RegExp
re.IgnoreCase = True
re.Global = True
for i = 1 to ubound(arr_kewords)
re.Pattern="([^""|=|//|//|@]|^)("&arr_kewords(i)&")"
keytext = re.Replace(keytext," $1&a href=$2&$2&/a&")
repkeyword = keytext
set re = Nothing
end function
[生命其实就是一个过程，可悲的是它不能够重新开始，可喜的是它也不需要重新开始.]
我也来贴自己的和收集的'禁止采集页面
Sub LockPage()
Dim http_reffer,server_name
http_reffer=Request.ServerVariables("HTTP_REFERER")
server_name=Request.ServerVariables("SERVER_NAME")
if CheckAgent()=False Then
if http_reffer="" or left(http_reffer,len("http://"&server_name)+1)&&"http://"&server_name&"/" Then
Response.Write("&html&&body&")
Response.Write("&form action='' name=checkrefer id=checkrefer method=post&")
Response.Write("&/form&")
Response.Write("&script&")
'Response.Write("alert('禁止非法访问');")
Response.Write("document.all.checkrefer.action=document.URL;")
Response.Write("document.all.checkrefer.submit();")
Response.Write("&/script&")
Response.Write("&/body&&/html&")
response.end
'检查当前访问者是否是蜘蛛人
Function CheckAgent()
Dim user_agent,allow_agent
user_agent=Request.ServerVariables("HTTP_USER_AGENT")
allow_agent=split("Baiduspider,Scooter,ia_archiver,Googlebot,FAST-WebCrawler,MSNBOT,Slurp",",")
CheckAgent=False
for agenti=lbound(allow_agent) to ubound(allow_agent)
if instr(user_agent,allow_agent(agenti))&0 Then
CheckAgent=True
end Function
'身份证校验
Function CheckidCard(idcard)
Dim LenCard
LenCard=Len(idcard)
'判断身份证长度
if not (LenCard = 15 Or LenCard = 18) Then
CheckidCard= "身份证长度不是15位或18位"
exit Function
'变量声明区
dim WeightedFactor,VerifyCode,area,birthday,lastnum,Ai,i,Total,Modnum,sex,age,province,sexNum,provinceID
WeightedFactor = array(7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2) '为前17位各个数字对应的加权因子
VerifyCode = array(1,0,"x",9,8,7,6,5,4,3,2)
'通过模得到的校验码
area="11北京,12天津,13河北,14山西,15内蒙古,21辽宁,22吉林,23黑龙江,31上海,32江苏,33浙江,34安徽,35福建,36江西,37山东,41河南,42湖北,43湖南,44广东,45广西,46海南,50重庆,51四川,52贵州,53云南,54西藏,61陕西,62甘肃,63青海,64宁夏,65新疆,71台湾,81香港,82澳门,91国外"
provinceID=left(idcard,2)
if instr(area,provinceID)=0 then
CheckidCard= "身份证头2位错误"
exit function
'补齐15位卡号
if LenCard= 15 then
idcard=left(idcard,6) & "19" & mid(idcard,7,9)
birthday= mid(idcard,7,4)+"-"+mid(idcard,11,2)+"-"+mid(idcard,13,2)
isdate(birthday) then
CheckidCard=
"生日非法"
exit function
if datediff("yyyy",cdate(birthday),date())&18 then
CheckidCard=
"你还未满18岁,不可能有身份证的"
exit function
'判断检验码
if len(idcard)=18 then
lastnum=int(right(idcard,1)) 'lastnum为18位身份证最后一位
Ai=left(idcard,17) 'Ai为除最后一位字符的字串
For i = 0 To 16
Total = Total + cint(Mid(Ai,i+1,1)) * WeightedFactor(i) 'Total前17位数字与对应的加权因子积的和
Modnum=total mod 11 '此数为模,total除以11后的余数
if VerifyCode(Modnum)&&lastnum then
CheckidCard= "最后一位校验码不对"
exit function
sexNum=mid(idcard,17,1)
sex="男性"
(sexNum mod 2) =0 then sex="女性"
age=datediff("yyyy",cdate(birthday),date())
province=mid(area,instr(area,provinceID)+2,3)
province=replace(province,",","")
CheckidCard= "恭喜,身份证通过校验&br/&" & "您为:" & sex & ",来自于:" & province & ",生日为:" & birthday
End Function
'设置页面马上过期
Sub PageNoCache()
Response.Expires = 0
Response.expiresabsolute = Now() - 1
Response.addHeader "pragma", "no-cache"
Response.addHeader "cache-control", "private"
Response.CacheControl = "no-cache"
Response.Buffer = True
Response.Clear
Server.ScriptTimeOut=
'把中文變成unicode
function chinese2unicode(Salon)
dim Salon_one
dim Salon_unicode
if Salon="" then Salon="无"
for i=1 to len(Salon)
Salon_one=Mid(Salon,i,1)
Salon_unicode=Salon_unicode&chr(38)
Salon_unicode=Salon_unicode&chr(35)
Salon_unicode=Salon_unicode&chr(120)
Salon_unicode=Salon_unicode& Hex(ascw(Salon_one))
Salon_unicode=Salon_unicode&chr(59)
chinese2unicode=Salon_unicode
End Function
提供万网、中频、商中、新网、互联、ENOM、DIRECTI全线产品。国外PHP5G空间　500RMB／年(无限MYSQL,无限域名）　国外ASP5G空间　1500RMB／年 QQ:116610
我给个简单的'把表中有限的几个分类转换成"汉字"
dim quizClass,quizOption
'quizClass=rs("quizLib.quizClass")
quizClass=rs("quizClass")
select case quizClass
case "radio1"
response.Write("判断题")
case "radio2"
response.Write("单选题")
case "checkbox"
response.Write("多选题")
case "text"
response.Write("填空题")
end select
阿宝 2006年到来之前就会火起来
我预测的:D
Function OracleDate( dt )
dt = CDate( dt ) ' just to be sure
OracleDate = Right( "0" & Day(dt), 2 ) & "-" _
& UCase( MonthName(Month(dt), True) ) & "-" _
& Year(dt)
End Function
查找字符串的次数:
Function search(pSearch, pSearchStr)
Dim tempSearch, tempSearchStr, startpos, endpos
startpos = 1
Do While (startpos & 0)
endpos = InStr(startpos, LCase(pSearch), LCase(pSearchStr))
If endpos & 0 Then
ctr = ctr + 1
startpos = endpos + Len(pSearchStr)
search = ctr
End Function
不要吝啬,大方点,我已经帖子这么几个吐血的了,怎么有人只copy不共享?寒.闪了~
蓝色里的一个大哥给我的，很好用，大家试试吧
'// 去调HTML标签 输出
function delhtml(strhtml)
dim objregexp, stroutput
set objregexp = new regexp
objregexp.ignorecase = true
objregexp.global = true
objregexp.pattern = "(&[a-za-z].*?&)|(&[//][a-za-z].*?&)"
stroutput = objregexp.replace(strhtml, "")
stroutput = replace(stroutput, "&", "&")
stroutput = replace(stroutput, "&", "&")
delhtml = stroutput
set objregexp = nothing
end function
[生命其实就是一个过程，可悲的是它不能够重新开始，可喜的是它也不需要重新开始.]
以前Blueidea里看到一个分页的类我也贴出来大家分享以下.再次感谢这为大哥的劳动成果!
'程序参数说明
'PapgeSize
定义分页每一页的记录数
返回经过分页的Recordset此属性只读
得到数据库连接
得到查询语句
'程序方法说明
显示分页导航条,唯一的公用方法
'===================================================================
Const Btn_First="&font face=""webdings""&9&/font&"
'定义第一页按钮显示样式
Const Btn_Prev="&font face=""webdings""&3&/font&"
'定义前一页按钮显示样式
Const Btn_Next="&font face=""webdings""&4&/font&"
'定义下一页按钮显示样式
Const Btn_Last="&font face=""webdings""&:&/font&"
'定义最后一页按钮显示样式
Const XD_Align="Center"
'定义分页信息对齐方式
Const XD_Width="100%"
'定义分页信息框大小
Class Xdownpage
Private XD_PageCount,XD_Conn,XD_Rs,XD_SQL,XD_PageSize,Str_errors,int_curpage,str_URL,int_totalPage,int_totalRecord,XD_sURL
'=================================================================
'PageSize 属性
'设置每一页的分页大小
'=================================================================
Public Property Let PageSize(int_PageSize)
If IsNumeric(Int_Pagesize) Then
XD_PageSize=CLng(int_PageSize)
str_error=str_error & "PageSize的参数不正确"
ShowError()
End Property
Public Property Get PageSize
If XD_PageSize="" or (not(IsNumeric(XD_PageSize))) Then
PageSize=10
PageSize=XD_PageSize
End Property
'=================================================================
'GetRS 属性
'返回分页后的记录集
'=================================================================
Public Property Get GetRs()
Set XD_Rs=Server.createobject("adodb.recordset")
XD_Rs.PageSize=PageSize
XD_Rs.Open XD_SQL,XD_Conn,1,1
If not(XD_Rs.eof and XD_RS.BOF) Then
If int_curpage&XD_RS.PageCount Then
int_curpage=XD_RS.PageCount
XD_Rs.AbsolutePage=int_curpage
Set GetRs=XD_RS
End Property
'================================================================
得到数据库连接
'================================================================
Public Property Let GetConn(obj_Conn)
Set XD_Conn=obj_Conn
End Property
'================================================================
得到查询语句
'================================================================
Public Property Let GetSQL(str_sql)
XD_SQL=str_sql
End Property
'==================================================================
'Class_Initialize 类的初始化
'初始化当前页的值
'==================================================================
Private Sub Class_Initialize
'========================
'设定一些参数的黙认值
'========================
XD_PageSize=10
'设定分页的默认值为10
'========================
'获取当前面的值
'========================
If request("page")="" Then
int_curpage=1
ElseIf not(IsNumeric(request("page"))) Then
int_curpage=1
ElseIf CInt(Trim(request("page")))&1 Then
int_curpage=1
Int_curpage=CInt(Trim(request("page")))
'====================================================================
创建分页导航条
'有首页、前一页、下一页、末页、还有数字导航
'====================================================================
Public Sub ShowPage()
Dim str_tmp
XD_sURL = GetUrl()
int_totalRecord=XD_RS.RecordCount
If int_totalRecord&=0 Then
str_error=str_error & "总记录数为零，请输入数据"
Call ShowError()
If int_totalRecord="" then
int_TotalPage=1
If int_totalRecord mod PageSize =0 Then
int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1
int_TotalPage = CLng(int_TotalRecord / XD_PageSize * -1)*-1+1
If Int_curpage&int_Totalpage Then
int_curpage=int_TotalPage
'==================================================================
'显示分页信息，各个模块根据自己要求更改显求位置
'==================================================================
response.write ""
str_tmp=ShowFirstPrv
response.write str_tmp
str_tmp=showNumBtn
response.write str_tmp
str_tmp=ShowNextLast
response.write str_tmp
str_tmp=ShowPageInfo
response.write str_tmp
response.write ""
'====================================================================
'ShowFirstPrv
显示首页、前一页
'====================================================================
Private Function ShowFirstPrv()
Dim Str_tmp,int_prvpage
If int_curpage=1 Then
str_tmp=Btn_First&" "&Btn_Prev
int_prvpage=int_curpage-1
str_tmp="&a href="""&XD_sURL & "1" & """&" & Btn_First&"&/a& &a href=""" & XD_sURL & CStr(int_prvpage) & """&" & Btn_Prev&"&/a&"
ShowFirstPrv=str_tmp
End Function
'====================================================================
'ShowNextLast
下一页、末页
'====================================================================
Private Function ShowNextLast()
Dim str_tmp,int_Nextpage
If Int_curpage&=int_totalpage Then
str_tmp=Btn_Next & " " & Btn_Last
Int_NextPage=int_curpage+1
str_tmp="&a href=""" & XD_sURL & CStr(int_nextpage) & """&" & Btn_Next&"&/a& &a href="""& XD_sURL & CStr(int_totalpage) & """&" &
Btn_Last&"&/a&"
ShowNextLast=str_tmp
End Function
'====================================================================
'ShowNumBtn
'====================================================================
Private Function showNumBtn()
Dim i,str_tmp
For i=1 to int_totalpage
str_tmp=str_tmp & "[&a href=""" & XD_sURL & CStr(i) & """&"&i&"&/a&] "
showNumBtn=str_tmp
End Function
'====================================================================
'ShowPageInfo
'更据要求自行修改
'====================================================================
Private Function ShowPageInfo()
Dim str_tmp
str_tmp="页次:"&int_curpage&"/"&int_totalpage&"页 共"&int_totalrecord&"条记录 "&XD_PageSize&"条/每页"
ShowPageInfo=str_tmp
End Function
'==================================================================
得到当前的URL
'更据URL参数不同，获取不同的结果
'==================================================================
Private Function GetURL()
Dim strurl,str_url,i,j,search_str,result_url
search_str="page="
strurl=Request.ServerVariables("URL")
Strurl=split(strurl,"/")
i=UBound(strurl,1)
str_url=strurl(i)'得到当前页文件名
str_params=Trim(Request.ServerVariables("QUERY_STRING"))
If str_params="" Then
result_url=str_url & "?page="
If InstrRev(str_params,search_str)=0 Then
result_url=str_url & "?" & str_params &"&page="
j=InstrRev(str_params,search_str)-2
If j=-1 Then
result_url=str_url & "?page="
str_params=Left(str_params,j)
result_url=str_url & "?" & str_params &"&page="
GetURL=result_url
End Function
'====================================================================
' 设置 Terminate 事件。
'====================================================================
Private Sub Class_Terminate
XD_RS.close
Set XD_RS=nothing
'====================================================================
'ShowError
'====================================================================
Private Sub ShowError()
If str_Error && "" Then
Response.Write("" & str_Error & "")
Response.End
set conn = server.CreateObject("adodb.connection")
conn.open "driver={microsoft access driver (*.mdb)};dbq=" & server.Mappath("pages.mdb")
'#############类调用样例#################
Set mypage=new xdownpage
'得到数据库连接
mypage.getconn=conn
mypage.getsql="select * from [test] order by id asc"
'设置每一页的记录条数据为5条
mypage.pagesize=5
'返回Recordset
set rs=mypage.getrs()
'显示分页信息，这个方法可以，在set rs=mypage.getrs()以后,可在任意位置调用，可以调用多次
mypage.showpage()
Response.Write("&br/&")
for i=1 to mypage.pagesize
'这里就可以自定义显示方式了
if not rs.eof then
response.write rs(0) & "&br/&"
rs.movenext
技术太菜！一直在学习中！
Class caDataGrid
'private variables
private pAutoColumns, pConnStr, pSqlStr, intColCnt
Private pOutPut, pConn, pRec, x, y, pArray
'this runs when you create a reference to the caDataGrid class
Private Sub Class_Initialize()
Set pConn = server.createobject("adodb.connection")
Set pRec = server.createobject("adodb.recordset")
intColCnt = 0
pAutoColumns = True
'Properties - all writable
Public Property Let ConnectionString(strConn)
pConnStr = strConn
End Property
Public Property Let AutoColumns(bAutoCols)
If bAutoCols = True or bAutoCols = False then
pAutoColumns = bAutoCols
End Property
Public Property Let SqlString(strSql)
pSqlStr = strSql
End Property
'Methods for our class
Public Sub AddColumn(strColName)
If intColCnt = 0 then
pOutPut = "&table width='100%' border=1 cellpadding=0 cellspacing=0&" & vbcrlf
pOutPut = pOutPut & "&tr&" & vbcrlf
pOutPut = pOutPut & "&td&&strong&" & strColName & "&/strong&&/td&" & vbcrlf
intColCnt = intColCnt + 1
Public Sub Bind
pConn.Open pConnStr
Set pRec = pConn.Execute(pSqlStr)
If pAutoColumns = True then
'assign column names from returned recordset
pOutPut = "&table width='100%' border=1 cellpadding=0 cellspacing=0&" & vbcrlf
pOutPut = pOutPut & "&tr&" & vbcrlf
Redim pColNames(pRec.Fields.Count)
For x = 0 to pRec.Fields.Count - 1
pOutPut = pOutPut & "&td&" & pRec.Fields(x).Name & "&/td&" & vbcrlf
pOutPut = pOutPut & "&/tr&" & vbcrlf
pArray = pRec.GetRows
For x = 0 to UBound(pArray, 2)
pOutPut = pOutPut & "&tr&" & vbcrlf
For y = 0 to UBound(pArray, 1)
pOutPut = pOutPut & "&td&" & pArray(y, x) & "&/td&" & vbcrlf
pOutPut = pOutPut & "&/tr&" & vbcrlf
pOutPut = pOutPut & "&/table&" & vbcrlf
Response.Write pOutPut
'this runs when we destroy our reference to caDataGrid
Private Sub Class_Terminate()
pOutPut = ""
pRec.Close
Set pRec = nothing
pconn.close
Set pConn = nothing
昨天没敢贴日历类，今天有人先了，起起哄。
要杀先杀头上的那个5do8
function getdata ($month=NULL,$year=NULL,$appointment=array()) {
$month = ( $month ==NULL )? date("n"):$
$year = ( $year ==NULL )? date("Y"):$
$weekday_cn = array("日","一","二","三","四","五","六");
//先判断月份以及是不是2月和闰月
//可以用一个数组来代替
//设定数组下标为月份数，值为天数，根据月份数返回对应的值（天数）
if ($month !=2) {
switch ($month) {
$day = 31;
$day = 31;
$day = 30;
$day = 31;
$day = 30;
$day = 31;
$day = 31;
$day = 30;
$day = 31;
$day = 30;
$day = 31;
if (date("L",mktime(0,0,0,$month,0,$year))) {
$day = 29;
$day = 28;
//得到开始的第一天是星期几
$start_day = (int)date("w",mktime(0,0,0,$month,date("j",mktime(0,0,0,$month,1,$year)),$year));
//日期从1开始计数
//得到今天是几号
$today=(int)date("j");
//打印表头
echo "&table width=/"200/" border=/"0/" cellspacing=/"1/" cellpadding=/"2/" class=/"calendar_table/"&&tr class=/"calendar_tr_header/"&";
echo "&th colspan=/"7/" scope=/"col/" class=/"calendar_th_header/"&".$year."年".$month."月"."&/th&&/tr&/n";
echo "&tr align=/"center/" class=/"calendar_tr_week/"&";
for ($i=0;$i&count($weekday_cn);$i++) {
echo "&th scope=/"col/" class=/"calendar_th_week/"&".$weekday_cn[$i]."&/th&/n";
echo "&/tr&";
//打印第一行
echo "&tr align=/"center/" class=/"calendar_tr_day/"& /n";
for ($i=0;$i&$start_$i++)
echo "&td class=/"calendar_td_day/"&&&/td&/n";
for ($j=0;$j&(7-$start_day);$j++) {
$url_n = "&a href=/"".$appointment[$n]."/" class=/"calendar_app_day/"&".$n."&/a&";
$str_n = ( $appointment[$n] ==NULL )?$n:( "&a href=/"".$appointment[$n]."/" class=/"calendar_app_url/"&".$n."&/a&" );
$table_td= ($today ==$n)?("&td class=/"calendar_td_today/"&&span class=/"calendar_app_today/"&".$str_n."&/span&&/td&"):("&td class=/"calendar_td_day/"&".$str_n."&/td&");
echo $table_
echo "&/tr&/n";
//已显示多少天
$m=($n-1);
//根据剩余天数除以7得到的商，用ceil()取整后，确定最后需要显示多少行
for($i=0;$i&(ceil($day-$m)/7);$i++){
echo "&tr align=/"center/" class=/"calendar_tr_day/"& ";
//每行7天7个单元格
for ($j=0;$j&7;$j++) {
if ($n&=$day) {
$str_n = ( $appointment[$n] ==NULL )?$n:( "&a href=/"".$appointment[$n]."/" class=/"calendar_app_url/"&".$n."&/a&" );
//显示是否是当日
$table_td= ($today ==$n)?("&td class=/"calendar_td_today/"&&span class=/"calendar_app_today/"&".$n."&/span&&/td&"):("&td class=/"calendar_td_day/"&".$n."&/td&");
echo $table_
//余下的空格显示
echo "&td class=/"calendar_td_day/"&&&/td&/n";
echo "&/tr&";
echo "&/table&";
方法有点笨，不过还算能用。也可以从外部定义CSS。使用方法：/*//使用方法//getdata();//或给出月份和年度信息//getdata(1,2006);////CSS控制关键词////calendar_table 整个表格//calendar_tr_header 表格头部年月信息行//calendar_th_header 表格头部年月信息单元格//calendar_tr_week 星期行//calendar_th_week 星期单元格//calendar_tr_day 日期行//calendar_td_day 日期单元格//calendar_app_url 日程安排链接//calendar_td_today 显示当日的单元格//calendar_app_day 有日程安排的单元格*/
快<font color="#的打工仔子
show an array in at table:
Sub ShowArrayInTable(ArrayToShow)
Dim I ' Simple Looping Var
Dim iArraySize ' Var to store array size
' If you want to know how big an array is, you can use this
' to find out. This even works in VB where they don't have
' to be zero-based. The LBound and UBound return the
' indecies of the lowest and highest array elements so to
' get the size we take the difference and add one since you
' can store a value at both end points.
iArraySize = (UBound(ArrayToShow) - LBound(ArrayToShow)) + 1
Response.Write "&p&The array has " & iArraySize _
& " elements. They are:&/p&" & vbCrLf
Response.Write "&table border=""1""&" & vbCrLf
Response.Write "&thead&" & vbCrLf
Response.Write "&tr&" & vbCrLf
Response.Write "&th&Index&/th&" & vbCrLf
Response.Write "&th&Value&/th&" & vbCrLf
Response.Write "&/tr&" & vbCrLf
Response.Write "&/thead&" & vbCrLf
Response.Write "&tbody&" & vbCrLf
' Simple loop over a table outputting a row for each element
For I = LBound(ArrayToShow) To UBound(ArrayToShow)
Response.Write "&tr&" & vbCrLf
' Write out the index of the element we're currently on
Response.Write "&td&" & I & "&/td&" & vbCrLf
' Write out the value of the element we're currently on
Response.Write "&td&" & ArrayToShow(I) & "&/td&" & vbCrLf
Response.Write "&/tr&" & vbCrLf
Response.Write "&/tbody&" & vbCrLf
Response.Write "&/table&" & vbCrLf
老外这样玩字符:
&% @language="VBscript" %&
&% option explicit %&
'--------------
' Hex2Dgt()
'------------------------------------------
' input: one hex-char 0..9, a..f, A..F
' return: a number 0..15
' note: no error-checking
'------------------------------------------
Function Hex2Dgt(ByVal inHexChar)
If ( inHexChar &= "9" ) Then
Hex2Dgt = Asc(inHexChar) - Asc("0")
Hex2Dgt = Asc(uCase(inHexChar)) - Asc("A") + 10
End Function
'--------------
' Hex2Dec()
'------------------------------------------
' input: a Hex string
' -2 null string
' -1 error (non-hex char)
【上篇】【下篇】