ASP常用代码段

转载 2016年06月01日 20:24:42
原文地址: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分)---------

'**********************************************************************************************
'函数名称: 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=ZeroFill_ReturnNum
End Function
------其他回答(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") '保存
%>&nbsp;<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分)---------

oncontextmenu="window.event.returnvalue=false"将彻底屏蔽鼠标右键
或者
<script language="javascript">
function click() 
{
if (event.button==0) //event.button依环境值不同
{
alert("对不起,本页的内容不经允许不得拷备。");
}
}
window.document.onmousedown=click;
</script>
onpaste="returnfalse"不准粘贴
oncopy="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, "'", "&#39;")
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分)---------

jf
------其他回答(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分)---------

学习
------其他回答(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 onclick="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:; onclick="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(); divclose(); } 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 divclose(){ 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+='onclick="showday(this.innerHTML);outMonth();" nowrap></td><td width="24" align="center" bgcolor="CCCCCC" onclick="showday(this.innerHTML);outMonth();" '; content+='nowrap></td><td width="24" align="center" bgcolor="CCCCCC" onclick="showday(this.innerHTML);outMonth();" nowrap></td><td width="26"'; content+=' align="center" bgcolor="CCCCCC" onclick="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" onclick="showday(this.innerHTML);outMonth();" nowrap>'; content+='</td></tr><tr><td height="18" align="center" bgcolor="CCCCCC" onclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor'; content+='="CCCCCC" onclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" onclick="showday(this.innerHTML);outMonth();"'; content+=' nowrap></td><td align="center" bgcolor="CCCCCC" onclick="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" onclick'; content+='="showday(this.innerHTML);outMonth();" nowrap></td><td align="center" bgcolor="CCCCCC" onclick="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="今天" onclick="today();" style="width:81px"></td>'; content+='<td align="center"><input type="button" name="bclose" value="关闭" onclick="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

相关文章推荐

ASP.NET常用代码段

  • 2009-04-24 16:17
  • 158KB
  • 下载

ASP常用代码段.txt

  • 2008-11-06 16:48
  • 101KB
  • 下载

Asp.NET 生成验证码的代码段

思路: 1. 前台代码cshtml中 即此处出现一个img,此img的src来自AAA控制器下的Aaa函数 2.后台代码如下     2.1  一个函数生成随机字符串,字母数字...

css常用 代码段

  • 2017-03-13 21:41
  • 58.42MB
  • 下载

javascript 常用代码段

  • 2017-03-13 21:38
  • 18.42MB
  • 下载

asp.NET中常用到的一些操作功能代码段。。

CS代码 using System; using System.Collections; using System.Configuration; using System.Data; using Sy...

jQuery 常用代码段

  • 2017-03-13 21:39
  • 20.80MB
  • 下载

jquery常用代码段

  • 2013-02-22 16:01
  • 14KB
  • 下载

常用JS代码段

最近尝试封装一些常用的JS功能,算是一种锻炼吧////////////////////页面跳转开始///////////////// /* Dom结构: 点击我,这个是访问本站点的链接,不可...

C常用代码段实现源码

  • 2013-08-27 23:04
  • 943KB
  • 下载
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

(最多只允许输入30个字)