ASP常用代码段

最新推荐文章于 2017-07-29 09:01:16 发布

KoneyZheng

最新推荐文章于 2017-07-29 09:01:16 发布

阅读量1.3k

点赞数

分类专栏：网页制作

网页制作专栏收录该内容

6 篇文章 0 订阅

订阅专栏

原文地址：http://biancheng.dnbcw.info/94/94887.html

VBScript code

    
    
     
     Function GetSafeStr(str)
    GetSafeStr=Replace(Replace(Replace(Replace(Replace(str,"'","‘"),"""","“"),"&",""),"<","&lt;"),">","&gt;")
End Function

阳历转农历
<%
Function Nongli()
Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)
Dim curTime, curYear, curMonth, curDay, curWeekday
Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr
Dim i, m, n, k, isEnd, bit, TheDate
'获取当前系统时间
curTime = Date
'星期名
WeekName(0) = " * "
WeekName(1) = "星期日"
WeekName(2) = "星期一"
WeekName(3) = "星期二"
WeekName(4) = "星期三"
WeekName(5) = "星期四"
WeekName(6) = "星期五"
WeekName(7) = "星期六"
'天干名称
TianGan(0) = "甲"
TianGan(1) = "乙"
TianGan(2) = "丙"
TianGan(3) = "丁"
TianGan(4) = "戊"
TianGan(5) = "己"
TianGan(6) = "庚"
TianGan(7) = "辛"
TianGan(8) = "壬"
TianGan(9) = "癸"
'地支名称
DiZhi(0) = "子"
DiZhi(1) = "丑"
DiZhi(2) = "寅"
DiZhi(3) = "卯"
DiZhi(4) = "辰"
DiZhi(5) = "巳"
DiZhi(6) = "午"
DiZhi(7) = "未"
DiZhi(8) = "申"
DiZhi(9) = "酉"
DiZhi(10) = "戌"
DiZhi(11) = "亥"
'属相名称
ShuXiang(0) = "鼠"
ShuXiang(1) = "牛"
ShuXiang(2) = "虎"
ShuXiang(3) = "兔"
ShuXiang(4) = "龙"
ShuXiang(5) = "蛇"
ShuXiang(6) = "马"
ShuXiang(7) = "羊"
ShuXiang(8) = "猴"
ShuXiang(9) = "鸡"
ShuXiang(10) = "狗"
ShuXiang(11) = "猪"
'农历日期名
DayName(0) = "*"
DayName(1) = "初一"
DayName(2) = "初二"
DayName(3) = "初三"
DayName(4) = "初四"
DayName(5) = "初五"
DayName(6) = "初六"
DayName(7) = "初七"
DayName(8) = "初八"
DayName(9) = "初九"
DayName(10) = "初十"
DayName(11) = "十一"
DayName(12) = "十二"
DayName(13) = "十三"
DayName(14) = "十四"
DayName(15) = "十五"
DayName(16) = "十六"
DayName(17) = "十七"
DayName(18) = "十八"
DayName(19) = "十九"
DayName(20) = "二十"
DayName(21) = "廿一"
DayName(22) = "廿二"
DayName(23) = "廿三"
DayName(24) = "廿四"
DayName(25) = "廿五"
DayName(26) = "廿六"
DayName(27) = "廿七"
DayName(28) = "廿八"
DayName(29) = "廿九"
DayName(30) = "三十"
'农历月份名
MonName(0) = "*"
MonName(1) = "正"
MonName(2) = "二"
MonName(3) = "三"
MonName(4) = "四"
MonName(5) = "五"
MonName(6) = "六"
MonName(7) = "七"
MonName(8) = "八"
MonName(9) = "九"
MonName(10) = "十"
MonName(11) = "十一"
MonName(12) = "腊"
'公历每月前面的天数
MonthAdd(0) = 0
MonthAdd(1) = 31
MonthAdd(2) = 59
MonthAdd(3) = 90
MonthAdd(4) = 120
MonthAdd(5) = 151
MonthAdd(6) = 181
MonthAdd(7) = 212
MonthAdd(8) = 243
MonthAdd(9) = 273
MonthAdd(10) = 304
MonthAdd(11) = 334
'农历数据
NongliData(0) = 2635
NongliData(1) = 333387
NongliData(2) = 1701
NongliData(3) = 1748
NongliData(4) = 267701
NongliData(5) = 694
NongliData(6) = 2391
NongliData(7) = 133423
NongliData(8) = 1175
NongliData(9) = 396438
NongliData(10) = 3402
NongliData(11) = 3749
NongliData(12) = 331177
NongliData(13) = 1453
NongliData(14) = 694
NongliData(15) = 201326
NongliData(16) = 2350
NongliData(17) = 465197
NongliData(18) = 3221
NongliData(19) = 3402
NongliData(20) = 400202
NongliData(21) = 2901
NongliData(22) = 1386
NongliData(23) = 267611
NongliData(24) = 605
NongliData(25) = 2349
NongliData(26) = 137515
NongliData(27) = 2709
NongliData(28) = 464533
NongliData(29) = 1738
NongliData(30) = 2901
NongliData(31) = 330421
NongliData(32) = 1242
NongliData(33) = 2651
NongliData(34) = 199255
NongliData(35) = 1323
NongliData(36) = 529706
NongliData(37) = 3733
NongliData(38) = 1706
NongliData(39) = 398762
NongliData(40) = 2741
NongliData(41) = 1206
NongliData(42) = 267438
NongliData(43) = 2647
NongliData(44) = 1318
NongliData(45) = 204070
NongliData(46) = 3477
NongliData(47) = 461653
NongliData(48) = 1386
NongliData(49) = 2413
NongliData(50) = 330077
NongliData(51) = 1197
NongliData(52) = 2637
NongliData(53) = 268877
NongliData(54) = 3365
NongliData(55) = 531109
NongliData(56) = 2900
NongliData(57) = 2922
NongliData(58) = 398042
NongliData(59) = 2395
NongliData(60) = 1179
NongliData(61) = 267415
NongliData(62) = 2635
NongliData(63) = 661067
NongliData(64) = 1701
NongliData(65) = 1748
NongliData(66) = 398772
NongliData(67) = 2742
NongliData(68) = 2391
NongliData(69) = 330031
NongliData(70) = 1175
NongliData(71) = 1611
NongliData(72) = 200010
NongliData(73) = 3749
NongliData(74) = 527717
NongliData(75) = 1452
NongliData(76) = 2742
NongliData(77) = 332397
NongliData(78) = 2350
NongliData(79) = 3222
NongliData(80) = 268949
NongliData(81) = 3402
NongliData(82) = 3493
NongliData(83) = 133973
NongliData(84) = 1386
NongliData(85) = 464219
NongliData(86) = 605
NongliData(87) = 2349
NongliData(88) = 334123
NongliData(89) = 2709
NongliData(90) = 2890
NongliData(91) = 267946
NongliData(92) = 2773
NongliData(93) = 592565
NongliData(94) = 1210
NongliData(95) = 2651
NongliData(96) = 395863
NongliData(97) = 1323
NongliData(98) = 2707
NongliData(99) = 265877
'生成当前公历年、月、日 ==> GongliStr
curYear = Year(curTime)
curMonth = Month(curTime)
curDay = Day(curTime)
GongliStr = curYear & "年"
If (curMonth < 10) Then
GongliStr = GongliStr & "0" & curMonth & "月"
Else
GongliStr = GongliStr & curMonth & "月"
End If
If (curDay < 10) Then
GongliStr = GongliStr & "0" & curDay & "日"
Else
GongliStr = GongliStr & curDay & "日"
End If
'生成当前公历星期 ==> WeekdayStr
curWeekday = Weekday(curTime)
WeekdayStr = WeekName(curWeekday)
'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
If ((curYear Mod 4) = 0 And curMonth > 2) Then
TheDate = TheDate + 1
End If
'计算农历天干、地支、月、日
isEnd = 0
m = 0
Do
If (NongliData(m) < 4095) Then
k = 11
Else
k = 12
End If
n = k
Do
If (n < 0) Then
Exit Do
End If
'获取NongliData(m)的第n个二进制位的值
bit = NongliData(m)
For q = 1 To n Step 1
bit = Int(bit / 2)
Next
bit = bit Mod 2
If (TheDate <= 29 + bit) Then
isEnd = 1
Exit Do
End If
TheDate = TheDate - 29 - bit
n = n - 1
Loop
If (isEnd = 1) Then
Exit Do
End If
m = m + 1
Loop
curYear = 1921 + m
curMonth = k - n + 1
curDay = TheDate
If (k = 12) Then
If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
curMonth = 1 - curMonth
ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
curMonth = curMonth - 1
End If
End If
'生成农历天干、地支、属相 ==> NongliStr
NongliStr = TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12)
NongliStr = NongliStr & "<font color='#ff9000'><b>(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")</b></font>年"
'生成农历月、日 ==> NongljDayStr
If (curMonth < 1) Then
NongliDayStr = "闰" & MonName(-1 * curMonth)
Else
NongliDayStr = MonName(curMonth)
End If
NongliDayStr = NongliDayStr & "月"
NongliDayStr = NongliDayStr & DayName(curDay)
NongLi= NongliStr & " " & NongliDayStr
end Function
dim sdate:sdate=Nongli()
response.Write(sdate)
%>

'**********************************************************************************************
'函数名称: ZeroFill(Num,Num_Length)
'函数功能: 前面补0
'参数说明: Num 要操作的数字
' Num_Length 显示的位数
'返回值 : 格式化的字符串
'**********************************************************************************************
Function ZeroFill(Num,Num_Length)
Dim ZeroFill_i,ZeroFill_ReturnNum
For ZeroFill_i=len(Num) To Num_Length-1
ZeroFill_ReturnNum=ZeroFill_ReturnNum&"0"
Next
ZeroFill_ReturnNum=ZeroFill_ReturnNum&Num
ZeroFill=ZeroFi

------其他回答（1分）---------

VBScript code

   
   
    
    
Function isMach(str,reg)
    if isnull(str) or str="" then isMach=false:exit function
    Set regEx = New RegExp
    regEx.Pattern = reg
    regEx.IgnoreCase = true
    regEx.Global = true
    isMach = regEx.test(str)
    Set reg=nothing
End Function

------其他回答（1分）---------

VBScript code

   
   
    
    
Function getReferer(def)
    dim ref
    ref=LCase(Request.ServerVariables("http_referer"))
    if ref="" then ref=def
    getReferer=ref
End Function

------其他回答（1分）---------

<%
'生成安全码的函数
function make_randomize(max_len,w_n) 'max_len 生成长度，w_n：0 可能包含字母，1：只为数字
randomize
for intcounter=1 to max_len
whatnext=int((1-0+1)*rnd+w_n)
if whatnext=0 then
upper=122
lower=97
else
upper=57
lower=48
end if
strnewpass=strnewpass & chr(int((upper-lower+1)*rnd)+lower)
next
make_randomize=strnewpass
end function
'safecode=make_randomize(4,0)
'response.Write(safecode)
%>
<%random_num=make_randomize(4,0) '生成4位数字的安全码
session("random_num")=random_num '为什么调用session，没有session的安全码是完全没有意义的。呵呵
Set Jpeg = Server.createObject("Persits.Jpeg") '调用组件
Jpeg.Open Server.MapPath("1.jpg") '打开准备的图片
Jpeg.Canvas.Font.Color = &H006699
Jpeg.Canvas.Font.Family = "Arial Black"
Jpeg.Canvas.Font.Bold = false
Jpeg.Canvas.PrintText 0, -2, random_num
jpeg.save Server.MapPath("random_index.jpg") '保存
%> <img src="random_index.jpg" border="0" align="absmiddle">

------其他回答（1分）---------

VBScript code

   
   
    
    function getip()
    Dim strIPAddr
    If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
        strIPAddr = Request.ServerVariables("REMOTE_ADDR")
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
        strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
        strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
    Else
        strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    End If
    getIP = Trim(Mid(strIPAddr, 1, 30))
end function

------其他回答（1分）---------

VB code

   
   
    
    
Function BackAlert(AlertStr)
        response.write "<script>alert('"&AlertStr&"');history.go(-1);</script> "
        response.End()
End Function
Function GoAlert(Message,Url)
        Response.write "<script>alert('"&Message&"');location.href='"&Url&"';</script>"
        Response.End()
End Function

------其他回答（1分）---------

οncοntextmenu="window.event.returnvalue=false"将彻底屏蔽鼠标右键
或者
<script language=" javascript">
function click()
{
if (event.button==0) //event.button依环境值不同
{
alert("对不起，本页的内容不经允许不得拷备。");
}
}
window.document.οnmοusedοwn=click;
</script>
οnpaste="returnfalse"不准粘贴
οncοpy="returnfalse;"oncut="returnfalse;"防止复制
光标是停在文本框文字的最后
functioncc()
{
vare=event.srcElement;
varr=e.createTextRange();
r.moveStart('character',e.value.length);
r.collapse(true);
r.select();
}
判断上一页的来源
asp:request.servervariables("HTTP_REFERER")
javascript:document.referrer
网页不会被缓存
ASP网页
Response.Expires=-1
Response.ExpiresAbsolute=Now()-1
Response.cachecontrol="no-cache"

------其他回答（1分）---------

VBScript code

   
   
    
    <%
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
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
%>

------其他回答（1分）---------

VBScript code

   
   
    
    '===============================================================
'函数名：RemoveHTML
'作  用：清除HTML标签
'参  数：strHTML 内容
'返回值：过滤HTML标签后的内容
'===============================================================
function RemoveHTML(strHTML)  
    Dim objRegExp, Match, Matches   
    Set objRegExp = New Regexp  
    
    objRegExp.IgnoreCase = True  
    objRegExp.Global = True  
    '取闭合的<>  
    objRegExp.Pattern = "<.+?>"  
    '进行匹配  
    Set Matches = objRegExp.Execute(strHTML)  
    
    '遍历匹配集合，并替换掉匹配的项目  
    For Each Match in Matches   
        strHtml=Replace(strHTML,Match.Value,"")  
    Next  
    RemoveHTML=strHTML  
    Set objRegExp = Nothing  
End function

------其他回答（1分）---------

Function IIF(Expression,ReturnTrue,ReturnFalse)
If Expression Then
IIF = ReturnTrue
Else
IIF = ReturnFalse
End If
End Function
'函数:全功能安全过滤函数
'参数:请求方式,过滤类型,请求名,值类型,默认值
Function SafeRequest(Requester,FilterType,RequestName,RequestType,DefaultValue)
Dim tmpValue
Select Case Requester
Case 0 : tmpValue = RequestName
Case 1 : tmpValue = Request(RequestName)
Case 2 : tmpValue = Request.Form(RequestName)
Case 3 : tmpValue = Request.QueryString(RequestName)
Case 4 : tmpValue = Request.Cookies(RequestName)
End Select
Select Case RequestType
Case 0
If Not IsNumeric(tmpValue) Or Len(tmpValue)<=0 Then
tmpValue = CLng(DefaultValue)
Else
tmpValue = CLng(tmpValue)
End If
Case 1
If tmpValue="" Or IsNull(tmpValue) Then tmpValue=DefaultValue
Select Case FilterType
Case 0 : tmpValue = tmpValue
Case 1 : tmpValue = SafeSql(tmpValue)
Case 2 : tmpValue = FilterHtml(tmpValue)
End Select
Case 2
If Not IsDate(tmpValue) Or Len(tmpValue) <=0 Then
tmpValue = CDate(DefaultValue)
Else
tmpValue = CDate(tmpValue)
End If
End Select
SafeRequest = tmpValue
End Function
'函数：危险Sql过滤
'参数：Sql
'返回：过滤结果
Function SafeSql(str)
SafeSql = Replace(str, "'", "'")
End Function
'函数：过滤Html标签
'参数：字符串
'返回：过滤后的字符串
Function FilterHtml(str)
If IsNull(str) Or str="" Then FilterHtml="" : Exit Function
Dim r
Set r = New RegExp
r.IgnoreCase = True
r.Global = True
r.MultiLine = True
r.Pattern = "<.+?>"
FilterHtml = r.Replace(str,"")
Set r = Nothing
End Function

------其他回答（1分）---------

解码

VBScript code

   
   
    
    
Function UrlDecode(encodestr) 
Dim NewStr
NewStr="" 
havechar=false 
lastchar="" 
For i=1 To Len(encodestr) 
   char_c=Mid(encodestr,i,1) 
   If char_c = "+" Then 
      newstr=newstr & " " 
   Elseif char_c="%" then 
      next_1_c=Mid(encodestr,i+1,2) 
      next_1_num=CInt("&H" & next_1_c) 
      If havechar Then 
         havechar=false 
         newstr=newstr & chr(Cint("&H" & lastchar & next_1_c)) 
      Else 
         If Abs(next_1_num)<=127 Then 
            newstr=newstr & chr(next_1_num) 
         Else 
            havechar=true 
            lastchar=next_1_c 
         End If 
      End If 
      i=i+2 
   Else 
      newstr=newstr & char_c 
   End If 
Next 
urldecode=newstr 
End function

------其他回答（1分）---------

ASP与Access 数据库连接：
以下为引用的内容：
<%@ language=VBscript%>
　　<%
　　dim conn,mdbfile
　　mdbfile=server.mappath(" 数据库名称.mdb")
　　set conn=server.createobject("adodb.connection")
　　conn.open "driver={microsoft access driver (*.mdb)};uid=admin;pwd=数
据库密码;dbq="&mdbfile
%>

ASP与SQL数据库连接：
以下为引用的内容：
<%@ language=VBscript%>
　　<%
　　dim conn
　　set conn=server.createobject("ADODB.connection")
　　con.open "PROVIDER=SQLOLEDB;DATA SOURCE=SQL 服务器名称或IP地址;
UID=sa;PWD=数据库密码;DATABASE=数据库名称
　　%>
如何回到先前的页面
以下为引用的内容：
答：< a href="< %=request.serverVariables("Http_REFERER")% >"
>preivous page< /a >

或用图片如：< img src="arrowback.gif" alt="< %=request.
serverVariables("HTTP_REFERER")% >" >
如何确定对方的IP地址
答：< %=Request.serverVariables("REMOTE_ADDR)% >

------其他回答（1分）---------

收藏一下。

------其他回答（1分）---------

function IsNumericStr(str)
IsNumericStr = true
str=LCase(str)
strSource ="0123456789"
for i=1 to len(str)
if InStr(strSource,mid(str,i,1))<=0 then
IsNumericStr = false
exit for
end if
next
end function

------其他回答（1分）---------

Rem 判断发言是否来自外部
'ChkPost=false 来自外部提交(非法)
'ChkPost=true 合法提交表单
'*************************************************************************************************
function ChkPost()
dim server_v1,server_v2
chkpost=false
server_v1=LCase(Cstr(Request.ServerVariables("HTTP_REFERER")))
server_v2=LCase(Cstr(Request.ServerVariables("SERVER_NAME")))
if mid(server_v1,8,len(server_v2))<>server_v2 then
chkpost=false
else
chkpost=true
end if
end function

------其他回答（1分）---------

<%
'===========================================
' 函数功能：实现向数据库中任何表中添加、删除、修改内容
' 作者：wangsdong
' 网站: http://www. aspprogram.cn
' 文章为作者原创，转载请注明文章出处、保留作者信息，谢谢支持！
' 参数意义：tablename为表名,str的值是insert,delete,update 表示
' 要执行的语句是添加、删除、修改。id为自动编号类型字段，使用方
' 法见举例
'===========================================
Function add_del_update(tablename,str,id)
Select Case str
Case "insert":
sql="select * from ["&tablename&"] where id=null"
rs.open sql,conn,1,3
rs.addnew
For Each key In request.Form
rs(CStr(key))=request(key)
Next
rs.update
rs.close
Case "update":
sql="select * from ["&tablename&"] where id="&id
rs.open sql,conn,1,3
For Each key In request.Form
if key<>"id" then
rs(CStr(key))=request(key)
end if
Next
rs.update
rs.close
Case "delete":
sql="delete from ["&tablename&"] where id in("&id&")"
rs.open sql,conn,1,3
Case ""
End Select
End Function
%>
使用方法：http://www.aspprogram.cn/html/article/2008413165114.html

------其他回答（1分）---------

ASP身份证号码验证函数

VBScript code

   
   
    
    
//var sss = "422324860305482";    
//Response.Write(checkIDCard(sss, "03/05/1986", 0));    
function checkIDCard(s, d, g)   
{   
if (!s) return false;   
d = new Date(d);   
if (!d.getTime()) return false;   
var t, r;   
t = "" + d.getFullYear() + dblNum(d.getMonth() + 1) + dblNum(d.getDate());   
if (g == null || isNaN(g)) return false;   
g = parseInt(g) % 2;   
switch (s.length)   
{   
case 8 :   
if (new Date() > d.setFullYear(d.getFullYear() + 19)) return false;   
r = /^[\d]{8}$/;   
if (!r.test(s)) return false;   
if (s != t) return false;   
break;   
case 15 :   
r = /^[\d]{15}$/;   
if (!r.test(s)) return false;   
if (s.substr(6, 6) != t.substr(2)) return false;   
if (parseInt(s.charAt(14)) % 2 != g) return false;   
break;   
case 18 :   
r = /^(?:[\d]{18}|[\d]{17}X)$/i;   
if (!r.test(s)) return false;   
if (s.substr(6, 8) != t) return false;   
if (parseInt(s.charAt(16)) % 2 != g) return false;   
var n = 0;   
var w = new Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2); // 加权因子   
var c = new Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2"); // 校验码   
for (var i = 0; i < 17; i++)   
{   
n += parseInt(s.charAt(i)) * w[i];   
}   
if (s.charAt(17).toUpperCase() != c[n % 11]) return false;   
break;   
default :   
return false;   
}   
return true;   
}   
function dblNum(n)   
{   
return parseInt(n) < 10 ? "0" + n : n;   
}  
本文来自 13COM.NET, 本文地址：http://www.13com.net/article/article.asp?articleid=49

------其他回答（1分）---------

' ============================================
' 格式化日期时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"yyyymmddhhmmss"
' 7:"yy-mm-dd"
' 8:"yy-mm-dd hh:mm:ss"
' 9:"yyyy年mm月"
' 10:"mm/dd/yyyy"
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
if y = "1900" then Exit Function
m = right("0"&month(s_Time),2)
d = right("0"&day(s_Time),2)
h = right("0"&hour(s_Time),2)
mi = right("0"&minute(s_Time),2)
s = right("0"&second(s_Time),2)
Select Case n_Flag
Case 1
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
Format_Time = y & "-" & m & "-" & d
Case 3
Format_Time = h & ":" & mi & ":" & s
Case 4
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
Format_Time = y & m & d
case 6
Format_Time= y & m & d & h & mi & s
case 7
Format_Time= right(y,2) & "-" & m & "-" & d
case 8
Format_Time= right(y,2) & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 9
Format_Time = y & "年" & m & "月"
Case 10
Format_Time = m & "/" & d & "/" & y & "/"
End Select
End Function

------其他回答（1分）---------

'小写数字转大写
function int2chn(n)
dim i,j,k,strlen,retval,x,y,z,str
z=array("零","壹","贰","叁","肆","伍","陆","柒","捌","玖")
y=array("","拾","佰","仟")
x=Array("","万","亿","万万亿")
strlen=len(n)
str1=n
for i= 1 to strlen
j=mid(str1,i,1)
retval=retval&z(j)
if j>0 then retval=retval&y((strlen-i) mod 4)'如果大于零，加入十进位字符
retval=replace(retval,z(0)&z(0),z(0))'出现两个零只留一个
if ((strlen-i) mod 4)=0 and right(retval,1)=z(0) then retval=left(retval,len(retval)-1)'每四位加入进阶
if ((strlen-i) mod 4)=0 then retval=retval&x(int((strlen-i)/4))'把最后的零去掉
next
int2chn=retval
end function
'小写金额转大写
Function UMoney(money)
Dim lnP,Prc,Tmp,NoB,Dx,Xx,Zhen
Dim China : China = "分角元拾佰仟万拾佰仟亿"
Dim str: str = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
Zhen = True
money = FormatNumber(money, 2)
Prc = CStr(money)
Prc = Replace(Prc, ",", "")
lnP = Len(Prc)
For i = lnP - 1 To 1 Step -1
If Mid(Prc, i, 1) = "." Then
Select Case lnP - i
Case 1
Prc = Replace(Prc, ".", "") + "0"
Case 2
Prc = Replace(Prc, ".", "")
End Select
Zhen = False
Exit For
End If
Next
If Zhen Then Prc = Prc + "00"
lnP = Len(Prc)
For i = 1 To lnP
Tmp = str(Mid(Prc, i, 1)) & Tmp
Next
UMoney = ""
fy = 1
For i = 1 To lnP
Xx = Mid(Tmp, i, 1)
Dx = Mid(China, i, 1)
If Xx <> "零" Then
UMoney = Xx & Dx & UMoney
f = 1
Else
If i = 3 Then
UMoney = Dx & UMoney
End If
If i = 7 Then
UMoney = Dx & UMoney
End If
If f Then
UMoney = "零" & UMoney
End If
f = 0
End If
Next
If Zhen Then UMoney = UMoney + "整"
UMoney = Replace(UMoney, "零万", "万")
UMoney = Replace(UMoney, "零元", "元")
End Function

------其他回答（1分）---------

随机选取5组彩票

VBScript code

   
   
    
    
Function rndtest(m_count,r_count) ''参数m_count号码总数，r_count为要取出的号码数
dim x,st,i
i=1
st=""
do while i<=r_count
randomize
x=int(rnd*m_count)+1 ''产生1~m_count的随机数
if i=r_count then
if not instr(st,x)>0 then
st=st&x 
i=i+1
end if
else
if not instr(st,x)>0 then
st=st&x&","  ''用,分割
i=i+1
end if
end if
if i>=m_count then
 exit do ''如果m_count小于r_count将出现死循环，于是判断并跳出循环
end if
loop
rndtest=st
end function
function sort(ary)'冒泡函数
ck=true
do Until ck = false 
 ck=false
 For f = 0 to UBound(ary) -1
  if clng(ary(f))>clng(ary(f+1)) then
   v1=clng(ary(f))
   v2=clng(ary(f+1))
   ary(f)=v2
   ary(f+1)=v1
   ck=true
  end if
 next
loop
sort=ary
end function
for i=0 to 4
Mycount=rndtest(33,7)
MyArray=split(Mycount,",")
newArray=sort(MyArray)
for i2=0 to UBound(newArray)
Response.Write(newArray(i2)&" ")
next
Response.Write("<br>")
next

------其他回答（1分）---------

Function GoRed(Str,keyword)
'***************************************
'GoRed函数 Str,搜索出来的内容,keyword 要替换的关键字
'***************************************
Dim RegObj
Set RegObj= New RegExp '定义新的正则表达式
With RegObj
.Global = True
.IgnoreCase = True
.Pattern="([.\n]*)("&Keyword&")([.\n]*)"
GoRed=.Replace(Str,"$1<font color='red'>$2</font>$3")
End With
Set RegObj=Nothing
End Function
示例：title=GoRed("Fditffdsdads","f")
输出title 会显示 Fditffdsdads

------其他回答（1分）---------

CSDN的编辑器用GOODLE的chrome看不到。。。safari核心。。。W3C标准。。。

------其他回答（1分）---------

Function IsInteger(byVal Para)
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function
Function DateToStr(byRef DateTime,byVal ShowType, byVal TimeZone)
Dim DateYear,DateMonth,DateDay,DateHour,DateMinute,DateSecond,DateAMPM
DateToStr=ShowType
DateYear=Year(DateTime)
DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
DateSecond=Second(DateTime)
IF Len(DateMonth)<2 Then DateMonth="0"&DateMonth
IF Len(DateDay)<2 Then DateDay="0"&DateDay
If instr(ShowType,"AMPM")>0Then
If DateHour>12 Then
DateToStr=Replace(DateToStr,"AMPM","PM")
DateHour=DateHour-12
Else
DateToStr=Replace(DateToStr,"AMPM","AM")
End IF
ElseIF Len(DateHour)<2 Then
DateHour="0"&DateHour
End IF
IF Len(DateMinute)<2 Then DateMinute="0"&DateMinute
IF Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Replace(DateToStr,"YYYY",DateYear)
DateToStr=Replace(DateToStr,"YY",Right(DateYear,2))
DateToStr=Replace(DateToStr,"MM",DateMonth)
DateToStr=Replace(DateToStr,"DD",DateDay)
DateToStr=Replace(DateToStr,"hh",DateHour)
DateToStr=Replace(DateToStr,"mm",DateMinute)
DateToStr=Replace(DateToStr,"ss",DateSecond)
DateToStr=Replace(DateToStr,"TZD",TimeZone)
End Function
'Cut String
Function cutStr(byVal str,byVal strlen)
dim l,t,c,i
l=Len(str)
t=0
For i=1 To l
'Unicode work around
c=AscW(Mid(str,i,1))
If c<0 Or c>255 then t=t+2 Else t=t+1
if t>=strlen then
cutStr=left(str,i-3)&"..."
exit for
else
cutStr=str
end if
next
End Function
function cutstr(tempstr,tempwid)
if len(tempstr)>tempwid then
cutstr=left(tempstr,tempwid)&"..."
else
cutstr=tempstr
end if
end function
Function RandomString(Length)
Dim i, tempS
tempS = "abcdefghijklmnopqrstuvwxyz1234567890"
RandomString = ""
If isNumeric(Length) = False Then
Exit Function
End If
For i = 1 to Length
Randomize
RandomString = RandomString & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
Next
End Function

------其他回答（1分）---------

VBScript code

   
   
    
    
'此文件可以对整站提交文字进行过滤
'编写者:逸风
'编写日期:2008-6-4
'函数说明:对非法字符进行过滤
'这个函数将过滤所有非中文字符
function ClearString(str) 
   dim re,str1,str2,i 
   set re = new regexp 
   re.Pattern = "^[\u4e00-\u9fa5\s\n\r\t]+$"
   for i=1 to len(str) 
     str1 = mid(str,i,1) 
     clearString = re.Test(str1) 
     if clearString=true then 
     str2 = str2&str1 
     end if 
   next
   str=str2
   ClearString = str 
end function
function KillKey(str)
    KillKey=str
end function
'编写者:逸风
'编写日期:2008-6-4
'函数说明:对非法字符进行过滤
'这个函数将过滤所有非中文字符
function SearchKey(str)
Key="这里是非法字符 嘎嘎`~~CSDN也屏蔽的"
KeyArray=split(Key,",")
K=ubound(KeyArray)
str2=ClearString(str) 
for i=0 to K
    if Instr(str2,KeyArray(i)) then
        response.Write("<font color=red>您所提交的信息中包含非法字符,请您返回后仔细检查所填写的内容然后再次提交您的信息!</font><a href='javascript:history.go(-1);'>返回</a><br/><font color=#0000FF>感谢您的支持!</font><br/>非法字符:" & KeyArray(i))
        response.End()
    end if
next
SearchKey=str
end function
function urldecode(encodestr)   'encodestr就是要解码的字符串
Dim newstr,havechar,lastchar,i,char_c,next_1_c,next_1_Num
newstr="" 
havechar=false 
lastchar="" 
for i=1 to len(encodestr) 
   char_c=mid(encodestr,i,1) 
   if char_c="+" then 
    newstr=newstr & " " 
   elseif char_c="%" then 
    next_1_c=mid(encodestr,i+1,2) 
    next_1_num=cint("&H" & next_1_c) 
   
    if havechar then 
     havechar=false 
     newstr=newstr & chr(cint("&H" & lastchar & next_1_c)) 
    else 
     if abs(next_1_num)<=127 then 
      newstr=newstr & chr(next_1_num) 
     else 
      havechar=true 
      lastchar=next_1_c 
     end if 
    end if 
    i=i+2 
   else 
    newstr=newstr & char_c 
   end if 
next 
urldecode=newstr 
end function
TempStr1=urldecode(request.QueryString)
TempStr2=urldecode(request.Form)
'查询提交的信息 如有非法字符 直接终止程序运行
SearchKey(TempStr1)
SearchKey(TempStr2)

------其他回答（1分）---------

VBScript code

   
   
    
    
'遍历文件夹，找到符合条件的文件
function bianli(sourcepath,str) 
    dim fso,objfolder,objsubfolders,objSubFolder
    set fso=server.CreateObject(Const_ScriptFileSystem)
    set objFolder=fso.GetFolder(server.mappath(sourcepath)) 
    set objSubFolders=objFolder.Subfolders 
    for each objSubFolder in objSubFolders 
        if left(objSubFolder.name,sile)=str Then
            response.write sourcepath&"/"&objSubFolder.name &"======================>"&objSubFolder.name &"<BR>"
            i=i+1
        End If
        Call bianli(sourcepath & "/" & objSubFolder.name ,str)'递归 
    next 
    set objFolder=nothing 
    set objSubFolders=nothing 
    set fso=nothing 
end function

------其他回答（1分）---------

Jmail 发送程序

VBScript code

   
   
    
    <%
  '参数说明
  'Subject     : 邮件标题
  'MailAddress : 发件
    
    服务器的地址,如smtp.163.com
  'Email       : 收件人邮件地址
  'Sender      : 发件人姓名
  'Content     : 邮件内容
  'Fromer      : 发件人的邮件地址
  Sub SendAction(subject, mailaddress, email, sender, content, fromer) 
      Set jmail = Server.CreateObject("JMAIL.SMTPMail")   '创建一个JMAIL对象
      jmail.silent = true   'JMAIL不会抛出例外错误，返回的值为FALSE跟TRUE
      jmail.logging = true   '启用使用日志
      jmail.Charset = "GB2312"  '邮件文字的代码为简体中文
      jmail.ContentType = "text/html"  '邮件的格式为HTML的
      jmail.ServerAddress =mailaddress  '发送邮件的服务器
      jmail.AddRecipient Email    '邮件的收件人
      jmail.SenderName = sender   '邮件发送者的姓名
      jmail.Sender = fromer    '邮件发送者的邮件地址
      jmail.Priority = 1   '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
      jmail.Subject = subject  '邮件的标题
      jmail.Body = content   '邮件的内容
      '由于没有用到密抄跟抄送，这里屏蔽掉这两句，如果您有需要的话，可以在这里恢复
      'jmail.AddRecipientBCC Email   '密件收件人的地址
      'jmail.AddRecipientCC Email   '邮件抄送者的地址
      jmail.Execute()   '执行邮件发送
if JMailerror then
response.write"发送成功！"
else
response.write JMailerror
end if
      jmail.Close    '关闭邮件对象
  End Sub
  
  '调用此Sub的例子
  Call SendAction (strSubject,strMailaddress,strEmail,strSender,strContent,strFromer)
%>

------其他回答（1分）---------

VBScript code

   
   
    
    
'==================================================
'函数名：BuildFolder
'作  用：创建文件夹
'参  数：path ----------要创建的文件夹(路径)
'==================================================
function BuildFolder(path)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
    fso.CreateFolder(Server.MapPath(path))
    fso.Close
    Set fso=Nothing
End Function
'==================================================
'函数名：Buildfile
'作  用：创建文件
'参  数：Htmlcode ------要创建的文件信息
'参  数：filex ----------要创建的文件名(路径)
'==================================================
function Buildfile(filex,Htmlcode)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
    Set html = fso.CreateTextFile(Server.MapPath(filex))
        html.WriteLine Htmlcode
        html.close
    Set html=Nothing
    fso.Close
    Set fso=Nothing
End Function
'==================================================
'函数名：Savefile
'作  用：修改文件
'参  数：file_body ------要创建的文件信息
'参  数：file_name ------要创建的文件名(路径)
'参  数：Cset -----------定义要创建的文件编码
'==================================================
Function Savefile(file_body,file_name,Cset)
Set OS=Server.CreateObject("ADODB.Stream")
        OS.Type=2
        OS.Open
        OS.Charset = Cset
        OS.Position=OS.Size
        OS.WriteText=file_body
        OS.SaveToFile Server.MapPath(file_name),2
        OS.Close
Set OS=Nothing
End Function
'==================================================
'函数名：DelFolder
'作  用：删除文件夹
'参  数：FolderPath ------要删除的文件夹路径
'==================================================
Function DelFolder(FolderPath)
    dim path
    path=FolderPath
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    Set DeleteFolder = FSO.GetFolder(Server.MapPath(path))
    DeleteFolder.Delete
    fso.Close
    Set fso=Nothing
    Response.Write("<script language=""Javascript"">alert(""文件夹已删除"");history.go(-1);</script>")
End Function
'==================================================
'函数名：ChkFile
'作  用：检索文件是否存在
'参  数：FilePath ------要检索的文件路径
'==================================================
Function ChkFile(FilePath)
    dim path
    path=Server.MapPath(FilePath)
    Set fso=Server.CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(path) then
       ChkFile="OK!"
    Else
       ChkFile="文件不存在"
    End IF
    fso.Close
    Set fso=Nothing
End Function
'==================================================
'函数名：DelFile
'作  用：删除文件
'参  数：FilePath ------要删除的文件的路径
'==================================================
Function DelFile(FilePath)
dim path
    path=Server.MapPath(FilePath)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
    '用两种方法删除文件
    fso.DeleteFile(path)'第一种方法
    Set File= FSO.GetFile(path)'第二种方法
        File.Delete
    fso.Close
    Set fso=Nothing
End Function
'===========================专门用来过滤Request的参数值===================================            
function GetVariable(strVariableName)
    if IsEmpty(Request(strVariableName)) then
        GetVariable=empty
        exit Function
    end if
    GetVariable=Replace(Request(strVariableName),"'","''")
    GetVariable=Replace(GetVariable,";","")
    GetVariable=Replace(GetVariable,"--","")
end function
function GetFormVariable(strVariableName)
    if IsEmpty(Request.Form(strVariableName)) then
        GetFormVariable=empty
        exit Function
    end if
    GetFormVariable=Replace(Request.Form(strVariableName),"'","''")
    GetFormVariable=Replace(GetFormVariable,"--","")
end function
    
function GetQueryString(strVariableName)
    if IsEmpty(Request.QueryString(strVariableName)) then
        GetQueryString=empty
        exit Function
    end if
    GetQueryString=Replace(Request.QueryString(strVariableName),"'","''")
    GetQueryString=Replace(GetQueryString,";","")
    GetQueryString=Replace(GetQueryString,"--","")
end function
'===========================专门用来过滤Request的参数值===================================    
'********************************************************************************************** 
'函数名称: HTMLcode(fString)
'函数功能: 过滤表单的特殊字符 
'参数说明: fString          要操作的字符串      
'返回值  : 格式化的字符串 
'**********************************************************************************************
Function HTMLcode(fString)
if not isnull(fString) then
    fString = replace(fString, ">", "&gt;")
    fString = replace(fString, "<", "&lt;")
    fString = Replace(fString, CHR(32), "&nbsp;")
    fString = Replace(fString, CHR(9), "&nbsp;")
    fString = Replace(fString, CHR(34), "&quot;")
    fString = Replace(fString, CHR(39), "&#39;")
    fString = Replace(fString, CHR(13), "")
    fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
    fString = Replace(fString, CHR(10), "<BR> ")
    HTMLcode = fString
end if
end Function 
'********************************************************************************************** 
'函数名称: GetTrueLength(strChinese, lenMaxWord, strSpaceBar)
'函数功能: 截取正确的英文/汉字长度
'参数说明: strChinese 为被检测字符串
'           lenMaxWord 为限制的字符长度
'         strSpaceBar 为要过滤(去掉)的字符
'返回 值 : 格式化的字符串(注：一个中文两个字符。)
'********************************************************************************************** 
Function GetTrueLength(strChinese, lenMaxWord, strSpaceBar)
dim i, j, strTail, lenTotal, lenWord, lenNow
dim strWord, bOverFlow, RetString
if strChinese = "" or vartype(strChinese) = 
    
    vbNull or CLng(lenMaxWord) <= 0 then
GetTrueLength = ""
exit function
end if
strTail = "..."        '标题截取后的表示,如“…”
bOverFlow = False
lenTotal = 0
for i=1 to Len(strChinese)
strWord = mid(strChinese, i, 1)
if asc(strWord) < 0 or asc(strWord) > 127 then
lenTotal = lenTotal + 2
else
lenTotal = lenTotal + 1
end if
next
'判断字符是否溢出
if lenTotal > lenMaxWord then bOverFlow = True
strSpaceBar = ""
if bOverFlow = True then
'字符溢出,去尾
lenWord = 0
RetString = ""
for i=1 to Len(strChinese)
strWord = mid(strChinese, i, 1)
if asc(strWord) < 0 or asc(strWord) > 127 then lenNow = 2 else lenNow = 1
lenWord = lenWord + lenNow
'截掉多余部分
if lenWord <= (lenMaxWord - Len(strTail)) then
    RetString = RetString + strWord
else
    RetString = RetString + strTail
    lenWord = lenWord + Len(strTail) - lenNow
    if (lenMaxWord-lenWord)>0 then
        for j =1 to lenMaxWord-lenWord
        strSpaceBar = strSpaceBar + "&nbsp;"
        next
    end if
    GetTrueLength = RetString
    exit for
end if
next
else
'字符不溢出,填充空位
RetString = strChinese
if (lenMaxWord-lenTotal)>0 then
    for i =1 to lenMaxWord-lenTotal
        strSpaceBar = strSpaceBar + "&nbsp;"
    next
end if
    GetTrueLength = RetString ''''''''''& strSpaceBar
end if
end function

------其他回答（1分）---------

VBScript code

   
   
    
    
'==================================================
'函数名：GetHttpPage
'作  用：获取网页源码
'参  数：HttpUrl ------网页地址
'==================================================
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl)=True Or Len(HttpUrl)<5 Then
      GetHttpPage="$False$"
      Exit Function
   End If
   Dim Http
   Set Http=server.createobject("MSXML2.XMLHTTP")
   Http.open "GET",HttpUrl,False
   Http.Send()
   If Http.Readystate<>4 then
      Set Http=Nothing 
          GetHttpPage="False"
      Exit function
   End if
   GetHTTPPage=BytesToBstr(Http.responseBody,"GB2312")
   Set Http=Nothing
   If Err.number<>0 then
      Err.Clear
   End If
End Function
'==================================================
'函数名：BytesToBstr
'作  用：将获取的源码转换为中文
'参  数：Body ------要转换的变量
'参  数：Cset ------要转换的类型
'==================================================
Function BytesToBstr(Body,Cset)
   Dim Objstream
   Set Objstream = Server.CreateObject("adodb.stream")
   objstream.Type = 1
   objstream.Mode =3
   objstream.Open
   objstream.Write body
   objstream.Position = 0
   objstream.Type = 2
   objstream.Charset = Cset
   BytesToBstr = objstream.ReadText 
   objstream.Close
   set objstream = nothing
End Function
'============================================
'函数名：OpenFile
'作  用：用FSO打开文件
'参  数：txt ------文件的路径
'============================================
Function OpenFile(txt)
Set fso= Server.CreateObject( "Scripting.FileSystemObject" )
    set ObjFile=fso.OpenTextFile(Server.MapPath(txt),1)
       OpenFile=ObjFile.ReadAll
       ObjFile.close
       Set ObjFile=Nothing
End Function
'============================================
'函数名：isChkInteger
'作  用：判断数字是否整形
'参  数: para 要检测的参数
'============================================
function isChkInteger(para)
       on error resume next
       dim str
       dim l,i
       if isNUll(para) then 
          isChkInteger=false
          exit function
       end if
       str=cstr(para)
       if trim(str)="" then
          isChkInteger=false
          exit function
       end if
       l=len(str)
       for i=1 to l
           if mid(str,i,1)>"9" or mid(str,i,1)<"0" then
              isChkInteger=false 
              exit function
           end if
       next
       isChkInteger=true
       if err.number<>0 then err.clear
end function
'============================================
'函数名：srequest(ParaName,ParaType) 
'作  用：判断数字是否为整形，过滤特殊字符串
'参  数: ParaName 要检测的参数
'        ParaType 值为1时,判断数字是否为整形;
'                 值为0时,过滤特殊字符串。
'============================================
Function srequest(ParaName,ParaType) 
    Dim ParaValue 
    ParaValue=ParaName 
    If ParaType=1 then 
        If not isNumeric(ParaValue) then 
            Response.write "参数" & ParaName & "必须为数字型！" 
            Response.end 
        End if 
    end if
    if  ParaType=0 then 
        ParaValue=replace(ParaValue,"'","''")
        ParaValue=replace(ParaValue,"'","’")
        ParaValue=replace(ParaValue,";","；")
        ParaValue=replace(ParaValue,">","》")
        ParaValue=replace(ParaValue,"<","《")
        ParaValue=replace(ParaValue,"=","＝")
        ParaValue=replace(ParaValue,"%","％")
        ParaValue=replace(ParaValue,",","，")
        ParaValue=replace(ParaValue,".","。")
        ParaValue=replace(ParaValue,"@","￥")
        ParaValue=replace(ParaValue,"*","＊")
        ParaValue=replace(ParaValue,"?","？")
        ParaValue=replace(ParaValue,"(","（")
        ParaValue=replace(ParaValue,")","）")
        ParaValue=replace(ParaValue,"#","＃")
        ParaValue=replace(ParaValue,"!","！")
        ParaValue=Lcase(ParaValue)
        If Instr(ParaValue,"select") or Instr(ParaValue,"insert") or Instr(ParaValue,"delete") or Instr(ParaValue,"count(") or Instr(ParaValue,"table") or Instr(ParaValue,"update") or Instr(ParaValue,"truncate") or Instr(ParaValue,"asc(") or Instr(ParaValue,"mid(") or Instr(ParaValue,"char(") or Instr(ParaValue,"xp_cmdshell") or Instr(ParaValue,"exec%20master") or Instr(ParaValue,"net%20localgroup%20administrators")  or Instr(ParaValue,":") or Instr(ParaValue,"net%20user") or Instr(ParaValue,"'") or Instr(ParaValue,"%20or%20") then
            Response.write "参数" & ParaName & "有问题！" 
            Response.end 
        end if
        ParaValue=replace(ParaValue,"'","''")
    End if 
    SRequest=ParaValue
    End function

------其他回答（1分）---------

收藏一下好了。。。。

------其他回答（1分）---------

转贴一个MD5 加密代码:

VBScript code

   
   
    
    
Private Const BITS_TO_A_BYTE = 8
Private Const BYTES_TO_A_WORD = 4
Private Const BITS_TO_A_WORD = 32
Private m_lOnBits(30)
Private m_l2Power(30)
 
Private Function LShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        LShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And 1 Then
            LShift = &H80000000
        Else
            LShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    If (lValue And m_l2Power(31 - iShiftBits)) Then
        LShift = ((lValue And m_lOnBits(31 - (iShiftBits + 1))) * m_l2Power(iShiftBits)) Or &H80000000
    Else
        LShift = ((lValue And m_lOnBits(31 - iShiftBits)) * m_l2Power(iShiftBits))
    End If
End Function
Private Function RShift(lValue, iShiftBits)
    If iShiftBits = 0 Then
        RShift = lValue
        Exit Function
    ElseIf iShiftBits = 31 Then
        If lValue And &H80000000 Then
            RShift = 1
        Else
            RShift = 0
        End If
        Exit Function
    ElseIf iShiftBits < 0 Or iShiftBits > 31 Then
        Err.Raise 6
    End If
    
    RShift = (lValue And &H7FFFFFFE) \ m_l2Power(iShiftBits)
    If (lValue And &H80000000) Then
        RShift = (RShift Or (&H40000000 \ m_l2Power(iShiftBits - 1)))
    End If
End Function
Private Function RotateLeft(lValue, iShiftBits)
    RotateLeft = LShift(lValue, iShiftBits) Or RShift(lValue, (32 - iShiftBits))
End Function
Private Function AddUnsigned(lX, lY)
    Dim lX4
    Dim lY4
    Dim lX8
    Dim lY8
    Dim lResult
 
    lX8 = lX And &H80000000
    lY8 = lY And &H80000000
    lX4 = lX And &H40000000
    lY4 = lY And &H40000000
 
    lResult = (lX And &H3FFFFFFF) + (lY And &H3FFFFFFF)
 
    If lX4 And lY4 Then
        lResult = lResult Xor &H80000000 Xor lX8 Xor lY8
    ElseIf lX4 Or lY4 Then
        If lResult And &H40000000 Then
            lResult = lResult Xor &HC0000000 Xor lX8 Xor lY8
        Else
            lResult = lResult Xor &H40000000 Xor lX8 Xor lY8
        End If
    Else
        lResult = lResult Xor lX8 Xor lY8
    End If
 
    AddUnsigned = lResult
End Function
Private Function 
    
    md5_F(x, y, z)
    
    
    md5_F = (x And y) Or ((Not x) And z)
End Function
Private Function md5_G(x, y, z)
    md5_G = (x And z) Or (y And (Not z))
End Function
Private Function md5_H(x, y, z)
    md5_H = (x Xor y Xor z)
End Function
Private Function md5_I(x, y, z)
    md5_I = (y Xor (x Or (Not z)))
End Function
Private Sub md5_FF(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_F(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub
Private Sub md5_GG(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_G(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub
Private Sub md5_HH(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_H(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub
Private Sub md5_II(a, b, c, d, x, s, ac)
    a = AddUnsigned(a, AddUnsigned(AddUnsigned(md5_I(b, c, d), x), ac))
    a = RotateLeft(a, s)
    a = AddUnsigned(a, b)
End Sub
Private Function ConvertToWordArray(sMessage)
    Dim lMessageLength
    Dim lNumberOfWords
    Dim lWordArray()
    Dim lBytePosition
    Dim lByteCount
    Dim lWordCount
    
    Const MODULUS_BITS = 512
    Const CONGRUENT_BITS = 448
    
    lMessageLength = Len(sMessage)
    
    lNumberOfWords = (((lMessageLength + ((MODULUS_BITS - CONGRUENT_BITS) \ BITS_TO_A_BYTE)) \ (MODULUS_BITS \ BITS_TO_A_BYTE)) + 1) * (MODULUS_BITS \ BITS_TO_A_WORD)
    ReDim lWordArray(lNumberOfWords - 1)
    
    lBytePosition = 0
    lByteCount = 0
    Do Until lByteCount >= lMessageLength
        lWordCount = lByteCount \ BYTES_TO_A_WORD
        lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
        lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage, lByteCount + 1, 1)), lBytePosition)
        lByteCount = lByteCount + 1
    Loop
    lWordCount = lByteCount \ BYTES_TO_A_WORD
    lBytePosition = (lByteCount Mod BYTES_TO_A_WORD) * BITS_TO_A_BYTE
    lWordArray(lWordCount) = lWordArray(lWordCount) Or LShift(&H80, lBytePosition)
    lWordArray(lNumberOfWords - 2) = LShift(lMessageLength, 3)
    lWordArray(lNumberOfWords - 1) = RShift(lMessageLength, 29)
    
    ConvertToWordArray = lWordArray
End Function
Private Function WordToHex(lValue)
    Dim lByte
    Dim lCount
    
    For lCount = 0 To 3
        lByte = RShift(lValue, lCount * BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE - 1)
        WordToHex = WordToHex & Right("0" & Hex(lByte), 2)
    Next
End Function

------其他回答（1分）---------

接上页

VBScript code

   
   
    
    
Public Function MD5(sMessage)
    m_lOnBits(0) = CLng(1)
    m_lOnBits(1) = CLng(3)
    m_lOnBits(2) = CLng(7)
    m_lOnBits(3) = CLng(15)
    m_lOnBits(4) = CLng(31)
    m_lOnBits(5) = CLng(63)
    m_lOnBits(6) = CLng(127)
    m_lOnBits(7) = CLng(255)
    m_lOnBits(8) = CLng(511)
    m_lOnBits(9) = CLng(1023)
    m_lOnBits(10) = CLng(2047)
    m_lOnBits(11) = CLng(4095)
    m_lOnBits(12) = CLng(8191)
    m_lOnBits(13) = CLng(16383)
    m_lOnBits(14) = CLng(32767)
    m_lOnBits(15) = CLng(65535)
    m_lOnBits(16) = CLng(131071)
    m_lOnBits(17) = CLng(262143)
    m_lOnBits(18) = CLng(524287)
    m_lOnBits(19) = CLng(1048575)
    m_lOnBits(20) = CLng(2097151)
    m_lOnBits(21) = CLng(4194303)
    m_lOnBits(22) = CLng(8388607)
    m_lOnBits(23) = CLng(16777215)
    m_lOnBits(24) = CLng(33554431)
    m_lOnBits(25) = CLng(67108863)
    m_lOnBits(26) = CLng(134217727)
    m_lOnBits(27) = CLng(268435455)
    m_lOnBits(28) = CLng(536870911)
    m_lOnBits(29) = CLng(1073741823)
    m_lOnBits(30) = CLng(2147483647)
    
    m_l2Power(0) = CLng(1)
    m_l2Power(1) = CLng(2)
    m_l2Power(2) = CLng(4)
    m_l2Power(3) = CLng(8)
    m_l2Power(4) = CLng(16)
    m_l2Power(5) = CLng(32)
    m_l2Power(6) = CLng(64)
    m_l2Power(7) = CLng(128)
    m_l2Power(8) = CLng(256)
    m_l2Power(9) = CLng(512)
    m_l2Power(10) = CLng(1024)
    m_l2Power(11) = CLng(2048)
    m_l2Power(12) = CLng(4096)
    m_l2Power(13) = CLng(8192)
    m_l2Power(14) = CLng(16384)
    m_l2Power(15) = CLng(32768)
    m_l2Power(16) = CLng(65536)
    m_l2Power(17) = CLng(131072)
    m_l2Power(18) = CLng(262144)
    m_l2Power(19) = CLng(524288)
    m_l2Power(20) = CLng(1048576)
    m_l2Power(21) = CLng(2097152)
    m_l2Power(22) = CLng(4194304)
    m_l2Power(23) = CLng(8388608)
    m_l2Power(24) = CLng(16777216)
    m_l2Power(25) = CLng(33554432)
    m_l2Power(26) = CLng(67108864)
    m_l2Power(27) = CLng(134217728)
    m_l2Power(28) = CLng(268435456)
    m_l2Power(29) = CLng(536870912)
    m_l2Power(30) = CLng(1073741824)
    Dim x
    Dim k
    Dim AA
    Dim BB
    Dim CC
    Dim DD
    Dim a
    Dim b
    Dim c
    Dim d
    
    Const S11 = 7
    Const S12 = 12
    Const S13 = 17
    Const S14 = 22
    Const S21 = 5
    Const S22 = 9
    Const S23 = 14
    Const S24 = 20
    Const S31 = 4
    Const S32 = 11
    Const S33 = 16
    Const S34 = 23
    Const S41 = 6
    Const S42 = 10
    Const S43 = 15
    Const S44 = 21
    x = ConvertToWordArray(sMessage)
    
    a = &H67452301
    b = &HEFCDAB89
    c = &H98BADCFE
    d = &H10325476
    For k = 0 To UBound(x) Step 16
        AA = a
        BB = b
        CC = c
        DD = d
    
        md5_FF a, b, c, d, x(k + 0), S11, &HD76AA478
        md5_FF d, a, b, c, x(k + 1), S12, &HE8C7B756
        md5_FF c, d, a, b, x(k + 2), S13, &H242070DB
        md5_FF b, c, d, a, x(k + 3), S14, &HC1BDCEEE
        md5_FF a, b, c, d, x(k + 4), S11, &HF57C0FAF
        md5_FF d, a, b, c, x(k + 5), S12, &H4787C62A
        md5_FF c, d, a, b, x(k + 6), S13, &HA8304613
        md5_FF b, c, d, a, x(k + 7), S14, &HFD469501
        md5_FF a, b, c, d, x(k + 8), S11, &H698098D8
        md5_FF d, a, b, c, x(k + 9), S12, &H8B44F7AF
        md5_FF c, d, a, b, x(k + 10), S13, &HFFFF5BB1
        md5_FF b, c, d, a, x(k + 11), S14, &H895CD7BE
        md5_FF a, b, c, d, x(k + 12), S11, &H6B901122
        md5_FF d, a, b, c, x(k + 13), S12, &HFD987193
        md5_FF c, d, a, b, x(k + 14), S13, &HA679438E
        md5_FF b, c, d, a, x(k + 15), S14, &H49B40821
    
        md5_GG a, b, c, d, x(k + 1), S21, &HF61E2562
        md5_GG d, a, b, c, x(k + 6), S22, &HC040B340
        md5_GG c, d, a, b, x(k + 11), S23, &H265E5A51
        md5_GG b, c, d, a, x(k + 0), S24, &HE9B6C7AA
        md5_GG a, b, c, d, x(k + 5), S21, &HD62F105D
        md5_GG d, a, b, c, x(k + 10), S22, &H2441453
        md5_GG c, d, a, b, x(k + 15), S23, &HD8A1E681
        md5_GG b, c, d, a, x(k + 4), S24, &HE7D3FBC8
        md5_GG a, b, c, d, x(k + 9), S21, &H21E1CDE6
        md5_GG d, a, b, c, x(k + 14), S22, &HC33707D6
        md5_GG c, d, a, b, x(k + 3), S23, &HF4D50D87
        md5_GG b, c, d, a, x(k + 8), S24, &H455A14ED
        md5_GG a, b, c, d, x(k + 13), S21, &HA9E3E905
        md5_GG d, a, b, c, x(k + 2), S22, &HFCEFA3F8
        md5_GG c, d, a, b, x(k + 7), S23, &H676F02D9
        md5_GG b, c, d, a, x(k + 12), S24, &H8D2A4C8A
            
        md5_HH a, b, c, d, x(k + 5), S31, &HFFFA3942
        md5_HH d, a, b, c, x(k + 8), S32, &H8771F681
        md5_HH c, d, a, b, x(k + 11), S33, &H6D9D6122
        md5_HH b, c, d, a, x(k + 14), S34, &HFDE5380C
        md5_HH a, b, c, d, x(k + 1), S31, &HA4BEEA44
        md5_HH d, a, b, c, x(k + 4), S32, &H4BDECFA9
        md5_HH c, d, a, b, x(k + 7), S33, &HF6BB4B60
        md5_HH b, c, d, a, x(k + 10), S34, &HBEBFBC70
        md5_HH a, b, c, d, x(k + 13), S31, &H289B7EC6
        md5_HH d, a, b, c, x(k + 0), S32, &HEAA127FA
        md5_HH c, d, a, b, x(k + 3), S33, &HD4EF3085
        md5_HH b, c, d, a, x(k + 6), S34, &H4881D05
        md5_HH a, b, c, d, x(k + 9), S31, &HD9D4D039
        md5_HH d, a, b, c, x(k + 12), S32, &HE6DB99E5
        md5_HH c, d, a, b, x(k + 15), S33, &H1FA27CF8
        md5_HH b, c, d, a, x(k + 2), S34, &HC4AC5665
    
        md5_II a, b, c, d, x(k + 0), S41, &HF4292244
        md5_II d, a, b, c, x(k + 7), S42, &H432AFF97
        md5_II c, d, a, b, x(k + 14), S43, &HAB9423A7
        md5_II b, c, d, a, x(k + 5), S44, &HFC93A039
        md5_II a, b, c, d, x(k + 12), S41, &H655B59C3
        md5_II d, a, b, c, x(k + 3), S42, &H8F0CCC92
        md5_II c, d, a, b, x(k + 10), S43, &HFFEFF47D
        md5_II b, c, d, a, x(k + 1), S44, &H85845DD1
        md5_II a, b, c, d, x(k + 8), S41, &H6FA87E4F
        md5_II d, a, b, c, x(k + 15), S42, &HFE2CE6E0
        md5_II c, d, a, b, x(k + 6), S43, &HA3014314
        md5_II b, c, d, a, x(k + 13), S44, &H4E0811A1
        md5_II a, b, c, d, x(k + 4), S41, &HF7537E82
        md5_II d, a, b, c, x(k + 11), S42, &HBD3AF235
        md5_II c, d, a, b, x(k + 2), S43, &H2AD7D2BB
        md5_II b, c, d, a, x(k + 9), S44, &HEB86D391
    
        a = AddUnsigned(a, AA)
        b = AddUnsigned(b, BB)
        c = AddUnsigned(c, CC)
        d = AddUnsigned(d, DD)
    Next
    
    '32位MD5值:
    'MD5 = LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
    '16位MD5值:
    'MD5=LCase(WordToHex(b) & WordToHex(c))  'I crop this to fit 16byte database password :D
End Function

------其他回答（1分）---------

学习

------其他回答（1分）---------

用asp程序显示sql数据库所有表的名称
<%
' Define your sql info here
strSQLDSN = "xxxx"
strSQLUsername = "sa"
strSQLPassword = ""
' This is where we connect to our sql server
Set adoConn = Server.CreateObject("ADODB.Connection")
ConnectionString = "dsn=" = strSQLDSN = ";uid=" = strSQLUsername = ";pwd=" = strSQLPassword = ""
adoConn.Open ConnectionString
Set adoRS = Server.CreateObject("ADODB.Recordset")
' now we will just difine a couple things
showblank = " "
shownull = "-null-"
If Request.QueryString("action") = "del" Then
Delete_Data
Else
If Request.QueryString("table") <> "" Then
' A table has been selected
Page_Head
Display_Table_Names
If Request.QueryString("msg") = "deleted" Then
Response.Write("<p><br></p>")
Response.Write("<font color=""#FF0000"">成功删除数据")
Else
Response.Write("<p><br></p>")
End If
Display_Table_Info
Else
' No table has been selected.
Page_Head
Display_Table_Names
End If
End If
Sub Page_Head
%>
<HTML>
<HEAD>
<TITLE>SQL Viewer</TITLE>
<BODY aLink=#0663bf leftMargin="0" link="#0663bf" topMargin="0" vLink="#0663bf" MARGINHEIGHT="0"
MARGINWIDTH="0">
</HEAD>
<p><br></p>
<%
End Sub
Sub Delete_Data
strSQL = "Delete From " = Request.QueryString("table") = " Where ID='" =
Request.QueryString("id") = "'"
Set adoRS = adoConn.Execute(strSQL)
strURL = "index.asp?table=" = Request.QueryString("table") = "=msg=deleted"
Response.Redirect(strURL)
End Sub
Sub Display_Table_Names
Response.Write("<div align=""center""><center>" = vbCrLf)
Response.Write("" = vbCrLf)
Response.Write("<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""36%""
bordercolor=""#9b9180"">" = vbCrLf)
Response.Write(" <tr bgColor=""#9b9180"">" = vbCrLf)
Response.Write(" <td width=""100%""><p align=""center""><font
color=""#FFFFFF""><strong>SQL Viewer</strong></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr bgColor=""#dcd8d1"">" = vbCrLf)
Response.Write(" <td width=""100%""><div align=""center""><center><table border=""0""
cellpadding=""0""" = vbCrLf)
Response.Write(" cellspacing=""0"" width=""100%"">" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
Response.Write(" <td width=""100%""> </td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
Response.Write(" <td width=""100%"" NOWRAP><center> <select size=""1""
name=""Table"" style=""font-family: Verdana; font-size: 8pt""
onChange=""top.location.href=this.options[this.selectedIndex].value"">" = vbCrLf)
Response.Write(" <option selected value>请选择表名进行查看.</option>" = vbCrLf)
strSQL = "SELECT name FROM sysobjects WHERE xtype = 'U' AND (Not (id) = 133575514) ORDER
BY name"
Set adoRS = adoConn.Execute(strSQL)
Do While Not adoRS.EOF
Response.Write "<option value=""index.asp?table=" = adoRS("name") = """>" =
adoRS("name") = "</option>"
adoRS.MoveNext
Loop
Response.Write(" </select> </center></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
Response.Write(" <td width=""100%""> </td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" </table>" = vbCrLf)
Response.Write(" </center></div></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write("</table>" = vbCrLf)
Response.Write("</center></div>" = vbCrLf)
End Sub
Sub Display_Table_Info
Response.Write("<div align=""center""><center>" = vbCrLf)
Response.Write("<table border=""1"" cellpadding=""0"" cellspacing=""0"" width=""36%""
bordercolor=""#9b9180"">" = vbCrLf)
Response.Write(" <tr bgColor=""#9b9180"">" = vbCrLf)
Response.Write(" <td width=""100%""><p align=""center""><font
color=""#FFFFFF""><strong>SQL 破戒</strong></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr bgColor=""#dcd8d1"">" = vbCrLf)
Response.Write(" <td width=""100%""><div align=""center""><center><table border=""0""
cellpadding=""0""" = vbCrLf)
Response.Write(" cellspacing=""0"" width=""100%"">" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
Response.Write(" <td></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
' This selects the table that we want to use.
strSQL="select * from " = Request.QueryString("table") = ""
set adoRS=adoConn.execute(strSQL)
' Now lets start the table
Response.Write("<table border=""1""><tr>" = vbCrLf)
' this will find all the fields in that table and write them out
FOR EACH fieldname IN adoRS.fields
Response.Write("<td><font size=""2"">" = fieldname.name = "</TD>")
NEXT ' fieldname
Response.Write("<td><font size=""2"">删除</TD>")
Response.Write(" </tr>" = vbCrLf)
DO UNTIL adoRS.eof
Response.Write("<tr>")
FOR EACH fieldname IN adoRS.fields
strFieldValue=fieldname.value
strField=fieldname.name
IF isnull(strFieldValue) THEN
strFieldValue=shownull
END IF
IF trim(strFieldValue)="" THEN
strFieldValue=showblank
END IF
IF strField = "ID" OR strField = "id" THEN
strRecordID = strFieldValue
END IF
Response.Write("<td valign=top><font size=""2"">" = strFieldValue =
"</td>" = vbCrLf)
NEXT
Response.Write("<td valign=top><font size=""2""><a href=""index.asp?table=" =
Request.QueryString("table") = "=id=" = strRecordID = "=action=del"">删除</td>" =
vbCrLf)
adoRS.movenext
LOOP
Response.Write("</table>")
adoRS.close
Response.Write(" </tr>" = vbCrLf)
Response.Write(" <tr>" = vbCrLf)
Response.Write(" <td></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write(" </table>" = vbCrLf)
Response.Write(" </center></div></td>" = vbCrLf)
Response.Write(" </tr>" = vbCrLf)
Response.Write("</table>" = vbCrLf)
Response.Write("</center></div>" = vbCrLf)
End Sub
%>

------其他回答（1分）---------

很好对于初学者很好

------其他回答（1分）---------

不错，收藏！！

------其他回答（1分）---------

VBScript code

   
   
    
    格式化
Function ZeroFill(Num,Num_Length) 
Dim ZeroFill_i,ZeroFill_ReturnNum 
For ZeroFill_i=len(Num) To Num_Length-1 
ZeroFill_ReturnNum=ZeroFill_ReturnNum&"0" 
Next 
ZeroFill_ReturnNum=ZeroFill_ReturnNum&Num 
ZeroFill=ZeroFill_ReturnNum 
End Function

------其他回答（1分）---------

好好学习一下啊

------其他回答（1分）---------

谢谢大家的分享啊

------其他回答（1分）---------

好东西啊，赶紧做个记号先

------其他回答（1分）---------

恐怕是目前国内免费最好的ASP空间了
无广告，稳定！！！福娃免费空间 [注意：连接必须能点！]
发完贴后请将您发表内容的地址输入下面！工作人员会在当天内检测帖子,通过后成为正式用户！可以绑定自己的顶级域名，可以申请更大的空间和支持。遇到问题通过“有问必答”联系管理员解决！技术交流Q群1：68762718（已满） Q群2：71801300

------其他回答（1分）---------

呵呵学习了~~~ 多多发点儿C#的代码哈

------其他回答（1分）---------

mark

------其他回答（1分）---------

太好了，谁能给个权限分配的源码啊？，就是可以给不同的角色分配不同的权限，要用chkboxList实现

------其他回答（1分）---------

哇,好详细的代码,Mark,接分..

------其他回答（1分）---------

好东西，mark

------其他回答（1分）---------

还在跟帖....
那再来点吧
'验证第一个字符是否为字母_
'false ：不是；true ：是
'*****************************************************
function IsFirstStr(str)
IsFirstStr = true
str=LCase(str)
strSource ="abcdefghijklmnopqrstuvwxyz"
if InStr(strSource,mid(str,1,1))<=0 then
IsFirstStr = false
else
IsFirstStr = true
end if
end function

------其他回答（1分）---------

不错，收藏！！

------其他回答（1分）---------

学习！收藏！

------其他回答（1分）---------

好东西,值得收藏.

------其他回答（1分）---------

mark

------其他回答（1分）---------

MARK.

------其他回答（1分）---------

ding

------其他回答（2分）---------

好啊,要收起来.

------其他回答（1分）---------

呵呵确实是好贴期待大家再次更新

------其他回答（1分）---------

不同列的遍历:

VBScript code

   
   
    
    <%
dim dep1,dep2
set rs=server.CreateObject("adodb.recordset") 
Sql="select 大类名,中类名,小类名 from ProClass order by 大类名,中类名,小类名"
rs.open sql,conn,1,1 
if rs.eof then 
  response.Write "..........." 
else 
  do while not rs.eof 
    dep1=rs(0)
    dep2=rs(1)
    Response.Write rs(0)&"<br>"
    Response.Write rs(1)&"<br>"
    Response.Write rs(2)&"<br>"
    rs.movenext
    do while not rs.eof and rs(0)=dep1
      do while not rs.eof and rs(0)=dep1 and rs(1)=dep2
        Response.Write rs(2)&"<br>"
        rs.movenext
      loop
      dep2=rs(1)
      Response.Write rs(1)&"<br>"
      rs.movenext
    loop
    dep1=rs(0)
    rs.movenext 
  loop 
end if 
rs.close 
set rs=nothing 
conn.close 
set conn=nothing 
%>

------其他回答（1分）---------

跟帖子

------其他回答（1分）---------

dinging

------其他回答（1分）---------

狂顶

------其他回答（1分）---------

好东东,不过俺现在还用不上,等要用时才来拿。

------其他回答（1分）---------

关注下。。。
请问我在asp中怎么维护cache和文件中数据的一致性？？？能否举个例子

------其他回答（1分）---------

正则查找字符串，返回数组
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches ' 建立变量。
Dim i, RetStr()
i = 0
Set regEx = New RegExp ' 建立正则表达式。
regEx.Pattern = patrn ' 设置模式。
regEx.IgnoreCase = True ' 设置是否区分大小写。
regEx.Global = True ' 设置全局替换。
regEx.MultiLine = True
Set Matches = regEx.Execute(strng) ' 执行搜索。
For Each Match in Matches ' 遍历 Matches 集合。
Redim Preserve RetStr(i)
RetStr(i) = Match.Value
i = i + 1
Next
RegExpTest = RetStr
End Function

------其他回答（1分）---------

好东西啊

------其他回答（1分）---------

收藏拉

------其他回答（1分）---------

学习下

------其他回答（1分）---------

引用 60 楼 qianjin036a 的回复:
不同列的遍历:
VBScript code<%dimdep1,dep2setrs=server.CreateObject("adodb.recordset")
Sql="select 大类名,中类名,小类名 from ProClass order by 大类名,中类名,小类名"rs.open sql,conn,1,1ifrs.eofthenresponse.Write"..........."elsedowhilenotrs.eof
dep1=rs(0)
dep2=rs(1)
Response.Write rs(0)&"<br>"Response.Write rs(1)&"<br>"Response.Write rs(2)&"<br>"rs.movenextdowhilenotrs.eofandrs(0)=d…

顶，JF

------其他回答（2分）---------

收藏一下
不会写哦
刚开始学

------其他回答（2分）---------

Response.Write("<script>alert('登录失败！用户名或密码错误！')</script>");
弹出一个确认筐的代码

------其他回答（3分）---------

Response.Write("<script>alert('编辑成功！');window.location='SelRoom.aspx'</script>");
弹出一个确认框并跳转到另一个页面

------其他回答（2分）---------

真是强人呀..这么多好用的代码呀

------其他回答（1分）---------

<%
function makefilename(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,"下午","")
makefilename=fname
end function
%>

------其他回答（1分）---------

看看，很不错啊！

------其他回答（1分）---------

不错，收藏了

------其他回答（1分）---------

引用 40 楼 happy002 的回复:
VBScript code格式化
Function ZeroFill(Num,Num_Length)
Dim ZeroFill_i,ZeroFill_ReturnNum
For ZeroFill_i=len(Num) To Num_Length-1
ZeroFill_ReturnNum=ZeroFill_ReturnNum&"0"
Next
ZeroFill_ReturnNum=ZeroFill_ReturnNum&Num
ZeroFill=ZeroFill_ReturnNum
End Function

呵呵！竟然能看见我的代码！哈哈

------其他回答（1分）---------

不错不错

------其他回答（1分）---------

学习

------其他回答（1分）---------

发个自己写的日历控件吧

JScript code

   
   
    
    
index.html
<html>
<body>
<script src="Calendar.js"></script>
<script>
EnabledDate=new Date(CurrentYear,CurrentDate.getMonth(),CurrentDay-1);
showday(CurrentMonth.toString());
</script>
<input type="text" name="btime" readonly οnclick="getdate(this);" size="15" />
</body>
</html>
Calendar.js
window.iif=function(fstr){return typeof(fstr)=="string"?document.getElementById(fstr):fstr}
var StarDate=1900;
var EndDate=2099;
var EnabledDate=new Date(1900,0,1);
var CurrentDate=new Date();
var CurrentYear=CurrentDate.getYear();
var CurrentMonth=CurrentDate.getMonth()+1;
var CurrentDay=CurrentDate.getDate();
var OutObj;
function getdate(obj){
 var curDate = new Date();
 OutObj=obj;
 var x=iif(obj)["offsetLeft"];
 var y=iif(obj)["offsetTop"];
 Layer1.style.pixelLeft=x;
 Layer1.style.pixelTop=y+iif(obj)["offsetHeight"];
 Layer1.style.display=Layer1.style.display=='none'?'block':'none';
}
function outMonth(){
 for(var m=0;m<12;m++){
  iif("AllMonth").cells[m].innerHTML=(m+1).toString()+'月';
  iif("AllMonth").cells[m].style.border='';
  iif("AllMonth").cells[m].style.cursor='hand';
  if(m==(CurrentMonth-1)){
   iif("AllMonth").cells[m].style.border='1px solid #FFA64D';
  }
 }
}
function showday(val){
 var tempcell,tempdate;
 var currMonth=Math.floor(val.replace('月',''));
 CurrentMonth=currMonth;
 CurrentDate=new Date(CurrentYear,CurrentMonth-1,CurrentDay);
 StatDay=new Date(CurrentYear,CurrentMonth-1,1);
 EndDay=new Date(CurrentYear,CurrentMonth-1,MaxDay(StatDay));
 tempcell=6+StatDay.getDay()+1;
 for(var tempi=7;tempi<=48;tempi++){
  iif("AllDay").cells[tempi].innerHTML='';
 }
 for(var day=1;day<=EndDay.getDate();day++){
  tempdate=new Date(CurrentYear,CurrentMonth-1,day);
  if(EnabledDate<tempdate){
   iif("AllDay").cells[tempcell].innerHTML='<a href=javascript:; οnclick="dayclick(AllDay.cells['+tempcell+'],this.innerHTML);" style="text-decoration:none;color:#000000">'+day.toString()+'</a>';
  }
  else
   iif("AllDay").cells[tempcell].innerHTML=day;
  if(day==CurrentDay){
   setDayStyle(iif("AllDay").cells[tempcell]);
  }
  tempcell++;
 }
 if(CurrentDay>EndDay.getDate())
  setDayStyle(iif("AllDay").cells[tempcell-1]);
}
function dayclick(obj,txt){
 if(typeof(obj)=='object')
  setDayStyle(obj);
 CurrentDay=txt;
 OutObj.value=CurrentYear.toString()+'-'+CurrentMonth.toString()+'-'+CurrentDay.toString();
 di
    
    vclose();
}
function setDayStyle(obj){
 for(var tempi=7;tempi<=48;tempi++){
  iif("AllDay").cells[tempi].style.fontstyle='';
  iif("AllDay").cells[tempi].style.background='';
  iif("AllDay").cells[tempi].style.fontweight='';
  iif("AllDay").cells[tempi].style.border='';
 }
 iif(obj).style.background='#F0F0F0';
 iif(obj).style.fontstyle='italic';
 iif(obj).style.fontweight='bold';
 iif(obj).style.border='1px solid #FFA64D';
}
function MaxDay(fDate){
 var newdate=new Date(fDate.getYear(),fDate.getMonth()+1,0)
 return newdate.getDate();
}
function NextYear(obj,fYear){
 var currYear=Math.floor(fYear.replace('年',''));
 if(currYear<EndDate){
  iif(obj).innerHTML=(currYear+1).toString()+'年';
  CurrentYear=currYear+1;
 }
 else{
  CurrentYear=EndDate;
  alert('已经到达系统支持的最大年份');
 }
 showday(CurrentMonth.toString());
}
function PrevYear(obj,fYear){
 var currYear=Math.floor(fYear.replace('年',''));
 if(currYear>StarDate){
  iif(obj).innerHTML=(currYear-1).toString()+'年';
  CurrentYear=currYear-1;
 }
 else{
  CurrentYear=StarDate;
  alert('已经到达系统支持的最小年份');
 }
 showday(CurrentMonth.toString());
}
function today(){
 CurrentDate=new Date();
 CurrentYear=CurrentDate.getYear();
 CurrentMonth=CurrentDate.getMonth()+1;
 CurrentDay=CurrentDate.getDate();
 showday(CurrentMonth.toString());
 dayclick('',CurrentDay);
}
function di
    
    vclose(){
 Layer1.style.display='none';
}

------其他回答（1分）---------

接上

JScript code

   
   
    
    
function CalenderInit(){
 var content;
 content='<div id="Layer1" style="position:absolute;width:10px;height:10px;z-index:1;display:none; ">';
 content+='<table width="162" height="25" cellpadding="0" cellspacing="0" border="0" style="border:1px solid #F8BACF;">';
 content+='<tr><td width="20" align="center"><img src="arrowl.jpg" width="20" height="18" style="cursor:hand" onClick="PrevYear(CurY,CurY.innerHTML);"></td>';
 content+='<td width="120" align="center" id="CurY" style="font-weight:bold; font:宋体; font-size:12px">'+CurrentYear.toString()+'年</td>';
 content+='<td width="20" align="center"><img src="arrowr.jpg" width="20" height="18" style="cursor:hand"onClick="NextYear(CurY,CurY.innerHTML);"></td>';
 content+='</tr><tr><td colspan="3" align="center"><table width="158" height="25" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff" id="AllMonth" ';
 content+='style="font:宋体; font-size:12px;border:1px solid #999999;padding-top:2px;"><tr><td width="24" height="18" align="center" bgcolor="CCCCCC" ';
 content+='οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td width="24" align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" ';
 content+='nowrap></td><td width="24" align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td width="26"';
 content+=' align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td width="26" align="center" bgcolor="CCCCCC" onclick';
 content+='="showday(this.innerHTML);outMonth();" nowrap></td><td width="26" align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap>';
 content+='</td></tr><tr><td height="18" align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor';
 content+='="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();"';
 content+=' nowrap></td><td align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" onclick';
 content+='="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" οnclick="showday(this.innerHTML);outMonth();" nowrap></td>';
 content+='</tr></table></td></tr></table><table id="AllDay" width="162" height="25" cellpadding="0" cellspacing="0" border="0" style="border:1px solid #F8BACF;';
 content+=' padding-top:3px; padding-bottom:1px; padding-left:2px; padding-right:2px; font:宋体; font-size:12px"><tr bgcolor="#F8BACF"><td align="center">日';
 content+='</td><td align="center">一</td><td align="center">二</td><td align="center">三</td><td align="center">四</td><td align="center">五</td><td align';
 content+='="center">六</td></tr><tr><td align="center" style="color:#FF0000;"></td><td align="center"></td><td align="center"></td><td align="center"></td>';
 content+='<td align="center"></td><td align="center"></td><td align="center" style="color:#FF0000;"></td></tr><tr><td align="center" style="color:#FF0000">';
 content+='</td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center" ';
 content+='style="color:#FF0000"></td></tr><tr><td align="center" style="color:#FF0000;"></td><td align="center"></td><td align="center"></td><td ';
 content+='align="center"></td><td align="center"></td><td align="center"></td><td align="center" style="color:#FF0000"></td></tr><tr><td align="center" style';
 content+='="color:#FF0000"></td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center"></td><td ';
 content+='align="center" style="color:#FF0000"></td></tr><tr><td align="center" style="color:#FF0000"></td><td align="center"></td><td align="center"></td>';
 content+='<td align="center"></td><td align="center"></td><td align="center"></td><td align="center" style="color:#FF0000"></td></tr><tr>';
 content+='<td align="center" style="color:#FF0000"></td><td align="center"></td><td align="center"></td><td align="center"></td><td align="center">';
 content+='</td><td align="center"></td><td align="center" style="color:#FF0000"></td></tr></table><table width="162" border="0" cellspacing="0"';
 content+=' cellpadding="0"><tr><td width="81" align="center"><input type="button" name="btoday" value="今天" οnclick="today();" style="width:81px"></td>';
 content+='<td align="center"><input type="button" name="bclose" value="关闭" οnclick="divclose();" style="width:81px"></td></tr></table></div>';
 document.write(content);
}
CalenderInit();
outMonth();
showday(CurrentMonth.toString())

------其他回答（1分）---------

VBScript code

   
   
    
    
'计算一个月有几天
'参数：fYM 格式 YYYYMM
Function MonthDay(fYM)
 t_Date = DateAdd("m",1,Left(fYM,4)&"-"&Right(fYM,2)&"-1")
 MonthDay = Day(DateAdd("d",-1,t_Date))
End Function
'计算一个月有几个周六周日
'参数：fDate 格式 YYYYMM
Function WeekSum(fDate)
 t_Day = MonthDay(fDate)
 t_NDate = Left(fDate,4)&"-"&Right(fDate,2)&"-"
 t_Sum = 0
 For i = 1 To t_Day
  If Weekday(t_NDate&i) = 1 Or Weekday(t_NDate&i) = 7 Then
   t_Sum = t_Sum + 1
  End If
 Next
 WeekSum = t_Sum
End Function

------其他回答（2分）---------

VBScript code

   
   
    
    
'计算一个月有几天
'参数：fYM 格式 YYYYMM
Function MonthDay(fYM)
 t_Date = DateAdd("m",1,Left(fYM,4)&"-"&Right(fYM,2)&"-1")
 MonthDay = Day(DateAdd("d",-1,t_Date))
End Function
'计算一个月有几个周六周日
'参数：fDate 格式 YYYYMM
Function WeekSum(fDate)
 t_Day = MonthDay(fDate)
 t_NDate = Left(fDate,4)&"-"&Right(fDate,2)&"-"
 t_Sum = 0
 For i = 1 To t_Day
  If Weekday(t_NDate&i) = 1 Or Weekday(t_NDate&i) = 7 Then
   t_Sum = t_Sum + 1
  End If
 Next
 WeekSum = t_Sum
End Function

------其他回答（1分）---------

晕，多发了一次，我说怎么提示我不要恶意灌水呢。。
-_-||

------其他回答（1分）---------

真的是很好~~收藏了

------其他回答（1分）---------

现在不搞这个了,以前我也疯狂的喜欢这些东西.

------其他回答（1分）---------

100以内还能接到分吧

------其他回答（1分）---------

太好了～

------其他回答（1分）---------

来一段，获取客户端IP：

VBScript code

   
   
    
    Function GetIP()
    Dim sIP
    If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
        sIP = Request.ServerVariables("REMOTE_ADDR")
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
        sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
        sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
    Else
        sIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
    End If
    GetIP = sIP
End Function

KoneyZheng

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
ASP常用代码段

原文地址：http://biancheng.dnbcw.info/94/94887.htmlVBScript codeFunction GetSafeStr(str) GetSafeStr=Replace(Replace(Replace(Replace(Replace(str,"'","‘"),"""","“"),"&",""),"",">")End Function
复制链接

扫一扫

专栏目录