ASP函数库3

'option explicit

'001.function lpad(desstr,padchar,lenint) 左填充
 '002.function rpad(desstr,padchar,lenint) 右填充
 '003.function MakeRndPass(passlen,passtype) 生成随机密码
 '004.function readFile(filepath) 读文件
 '005.function WriteFile(filepath,fileContent) 写文件
 '006.function DelFile(filepath) 删除文件
 '007.sub alert(str,weburl) 弹出对话框
 '008.function max(info) 取最大值
 '009.function min(info) 取最小值
 '010.function get1stMonth() 返回本月第一天的日期
 '011.function get1stYear() 返回本年第一天的日期
 '012.function get1stWeek() 返回本周第一天的日期
 '013.function get1stQua() 返回本季度第一天的日期
 '014.function ShowArticleContent() 分页显示长文章内容
 '015.function IsObjInstalled() 检查组件是否已经安装
 '016.function isHTTP() 检查字符串是否以HTTP开头或以"/"开头
 '017.function strLength() 求字符串长度
 '018.function checkNull() 检查str是否为空
 '019.function getHTTPPage() 获取远程的网页内容
 '020.function SendMailEx() 例如利用Jmail发信,适合于smtp需要验证的情况
 '021.Function nohtml(str,strlen) 去掉所有html标记,并截取相应长度的字符串
 '022.Function splitCount(str,splitchar) 拆分字符串,取拆分后的子串数
 '023.function checkIMG(str) 检查字符中是否有IMG字样
 '024.function doWrap() 解决DW显示字段值不能换行的问题
 '025.function deleteparm() 删除指定网页参数中的某一项
 '026.function findStr() 按分隔符查找字符串,找到返回True
 '027.function makeID() 产生20位长度的唯一标识ID
 '028.function findparm() 查询网页参数字符中某项的值
 '029.function showIMG() 显示图片
 '030.function showSWF() 显示flash,rm等
 '031.function showRm() 播放rm
 '032.function orderImg() 用于列标题排序时后面加上下箭头
 '033.function orderURL() 用于列标题排序时生成相应地址
 '034.function showPage() 用于显示翻页导航
 '035.function DoDelFile() 删除文件,必须使用虚拟路径
 '036.function Format_Time() 格式化日期
 '037.function outHTML() 显示输出html代码
 '038.function inHTML() 显示输出html代码,一般放在input框的值中
 '039.IsSelfRefer() 是否从本站提交
 '040.Get_SafeStr() 取得安全字符
 '041.JimmyCode() 过滤html相关标记
 '042.Function makeMonthDir() 上传时生成自动目录
 '043.Function imgUpload() 利用aspJpeg,aspUpload上传图片,并自动生成缩略图

'上传图片(需要aspupload,aspjpeg支持,上传时会自动根据参数,按比例)
 '参数:
 'with small :上传图片时,是否同步生成小的缩略图(true是 false否)
 'bigwidth:大图片的规定宽度
 'bigheight:大图片的规定高度
 'smallwidth:小图片的规定宽度
 'smallheight:小图片的规定高度
 'virturaluploadPath:上传的虚拟路径
 'maxsize:上传图片的最大尺寸(字节,1K=1024字节)
 'response.write imgUpload(true,700,400,150,200,"/upload",1024*100)
 Function imgUpload

(withSmall,bigWidth,bigHeight,smallWidth,smallHeight,virturluploadPath,maxSize)
 imgUpload = ""
 dim Upload,Jpeg,tempFile,File,scale
 if (not IsObjInstalled("Persits.Upload")) or (not IsObjInstalled("Persits.Jpeg")) then
 response.write "<font color=red>尚未安装 ASPUpload 和 ASPJpeg组件 !</font>"
 exit function
 end if
 Set Upload = Server.CreateObject("Persits.Upload")
 Set Jpeg = Server.CreateObject("Persits.Jpeg")

 Upload.OverwriteFiles = True '如果存在文件,强制overwrite

 Upload.SetMaxSize maxSize, True '设置最大上传值 1K为1024,100K为100*1024

on error resume next

 Upload.Save '上传到服务器内存中

 if Err.Number = 8 then
 response.write "<font color=red>文件太大,只允许上传" & formatnumber(maxSize/1024,0)

& "K以内的图片文件!</font>"
 exit function
 end if

 For Each File in Upload.Files
 If not(File.ImageType = "JPG" or File.ImageType = "GIF" or File.ImageType ="PNG")

Then
 Response.Write "<font color=red>只允许上传有效的图片文件(如

GIF,PNG,JPEG,JPG).</font>"
 File.Delete '如果是非法图片,则删除掉
 Response.End
 Else
 tempfile =makeMonthDir(virturluploadPath,true) & MakeID() & File.Ext
 imgupload = imgupload & "|" & tempfile
 File.SaveAs server.mappath(tempFile) '自动重命名并保存到指定路径中
 End If

 Jpeg.Open File.Path
 scale = resizeImg(Jpeg.OriginalWidth,Jpeg.OriginalHeight,bigwidth,bigheight)
 Jpeg.Width = Jpeg.OriginalWidth * Scale
 Jpeg.Height = Jpeg.OriginalHeight * Scale
 Jpeg.Save makeMonthDir(virturluploadPath,false) & File.FileName '调整大图片大小

 if withSmall then
 scale = resizeImg

(Jpeg.OriginalWidth,Jpeg.OriginalHeight,smallWidth,smallheight)
 Jpeg.Width = Jpeg.OriginalWidth * Scale
 Jpeg.Height = Jpeg.OriginalHeight * Scale
 Jpeg.Save makeMonthDir(virturluploadPath,false) & "small_" & File.FileName '

调整小图片大小
 end if
 Next
 Set Upload = Nothing
 Set Jpeg = Nothing
 if left(imgUpload,1)="|" then imgUpload = right(imgupload,len(imgupload)-1)
 End Function

'重新设定图片大小,返回百分比
 function resizeImg(ox,oy,nx,ny)
 resizeimg = 1
 If ox<=nx And oy<=ny Then Exit function
 dim x,y
 '先算x
 x = ny * ox / oy
 if x > nx then 'x不行
 y = nx * oy / ox
 resizeImg = y / oy
 else
 resizeImg = x / ox
 end if
 resizeImg = formatNumber(resizeImg,4)
 end function

'042
 '上传时生成自动目录(以2005_6 类似的名称)
 Function makeMonthDir(vitualRoot,virtual)
 Dim dirName,dirNameV,fso
 dirNameV = vitualRoot & "/" & Year(Now()) & "_" & Month(Now())
 dirName = server.MapPath(dirNameV)
 'response.write DirName & "<br>"
 Set fso = server.CreateObject("Scripting.FileSystemObject")
 if not fso.FolderExists(dirName) then
 fso.CreateFolder(dirName)
 end if
 set fso = Nothing
 If virtual Then
 makeMonthDir = dirNameV & "/"
 Else
 makeMonthDir = dirName & "\"
 End if
 End Function

'035
 ' 删除指定的文件,必须传入虚拟路径
 Sub DoDelFile(sPathFile)
 On Error Resume Next
 Dim oFSO
 Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
 'response.write "<br>" & Server.MapPath(sPathFile)
 oFSO.DeleteFile(Server.MapPath(sPathFile))
 Set oFSO = Nothing
 End Sub

'036
 ' ============================================
 ' 格式化时间(显示)
 ' 参数:n_Flag
 ' 1:"yyyy-mm-dd hh:mm:ss"
 ' 2:"yyyy-mm-dd"
 ' 3:"hh:mm:ss"
 ' 4:"yyyy年mm月dd日"
 ' 5:"yyyymmdd"
 ' 6:"MM/DD"
 ' ============================================
 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))
 m = cstr(month(s_Time))
 If len(m) = 1 Then m = "0" & m
 d = cstr(day(s_Time))
 If len(d) = 1 Then d = "0" & d
 h = cstr(hour(s_Time))
 If len(h) = 1 Then h = "0" & h
 mi = cstr(minute(s_Time))
 If len(mi) = 1 Then mi = "0" & mi
 s = cstr(second(s_Time))
 If len(s) = 1 Then s = "0" & s
 Select Case n_Flag
 Case 1
 ' yyyy-mm-dd hh:mm:ss
 Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
 Case 2
 ' yyyy-mm-dd
 Format_Time = y & "-" & m & "-" & d
 Case 3
 ' hh:mm:ss
 Format_Time = h & ":" & mi & ":" & s
 Case 4
 ' yyyy年mm月dd日
 Format_Time = y & "年" & m & "月" & d & "日"
 Case 5
 ' yyyymmdd
 Format_Time = y & m & d
 Case 6
 'mm/dd
 Format_Time = m & "/" & d
 case 7
 Format_Time = m & "/" & d & "/" & right(y,2)
 End Select
 End Function

'037
 ' ============================================
 ' 把字符串进行HTML解码,替换server.htmlencode
 ' 去除Html格式,用于显示输出
 ' ============================================
 Function outHTML(str)
 Dim sTemp
 sTemp = str
 outHTML = ""
 If IsNull(sTemp) = True Then
 Exit Function
 End If
 sTemp = Replace(sTemp, "&", "&")
 sTemp = Replace(sTemp, "<", "<")
 sTemp = Replace(sTemp, ">", ">")
 sTemp = Replace(sTemp, Chr(34), """)
 sTemp = Replace(sTemp, Chr(10), "<br>")
 outHTML = sTemp
 End Function

'038
 ' ============================================
 ' 去除Html格式,用于从数据库中取出值填入输入框时
 ' 注意:value="?"这边一定要用双引号
 ' ============================================
 Function inHTML(str)
 Dim sTemp
 sTemp = str
 inHTML = ""
 If IsNull(sTemp) = True Then
 Exit Function
 End If
 sTemp = Replace(sTemp, "&", "&")
 sTemp = Replace(sTemp, "<", "<")
 sTemp = Replace(sTemp, ">", ">")
 sTemp = Replace(sTemp, Chr(34), """)
 inHTML = sTemp
 End Function

'039
 ' ============================================
 ' 检测上页是否从本站提交
 ' 返回:True,False
 ' ============================================
 Function IsSelfRefer()
 Dim sHttp_Referer, sServer_Name
 sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
 sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
 If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
 IsSelfRefer = True
 Else
 IsSelfRefer = False
 End If
 End Function

'040
 ' ============================================
 ' 得到安全字符串,在查询中使用
 ' ============================================
 Function Get_SafeStr(str)
 Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
 End Function

' ============================================
 ' 取实际字符长度
 ' ============================================
 Function Get_TrueLen(str)
 Dim l, t, c, i
 l = Len(str)
 t = l
 For i = 1 To l
 c = Asc(Mid(str, i, 1))
 If c < 0 Then c = c + 65536
 If c > 255 Then t = t + 1
 Next
 Get_TrueLen = t
 End Function

' ============================================
 ' 判断是否安全字符串,在注册登录等特殊字段中使用
 ' ============================================
 Function IsSafeStr(str)
 Dim s_BadStr, n, i
 s_BadStr = "'  &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
 n = Len(s_BadStr)
 IsSafeStr = True
 For i = 1 To n
 If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
 IsSafeStr = False
 Exit Function
 End If
 Next
 End Function

'================================================
 ' 显示解释函数,返回根据参数允许显示的格式字符串,具体调用方法可从后台管理获得
 ' 输入参数:
 ' s_Content : 要转换的数据字符串
 ' s_Filters : 要过滤掉的格式集,用逗号分隔多个
 '================================================
 Function jimmycode(s_Content, sFilters)
 Dim a_Filter, i, s_Result, s_Filters
 jimmycode = s_Content
 If IsNull(s_Content) Then Exit Function
 If s_Content = "" Then Exit Function
 's_Content = Replace(s_Content, Chr(10), "<br>")
 s_Result = s_Content
 s_Filters = sFilters

' 设置默认过滤
 If sFilters = "" Then s_Filters = "script,object"

a_Filter = Split(s_Filters, ",")
 For i = 0 To UBound(a_Filter)
 s_Result = jimmycodeFilter(s_Result, a_Filter(i))
 Next
 jimmycode = s_Result
 End Function

' ===============================================
 ' 初始化下拉框
 ' s_FieldName : 返回的下拉框名
 ' a_Name : 定值名数组
 ' a_Value : 定值值数组
 ' v_InitValue : 初始值
 ' s_Sql : 从数据库中取值时,select name,value from table
 ' s_AllName : 空值的名称,如:"全部","所有","默认"
 ' ===============================================
 Function InitSelect(s_FieldName, a_Name, a_Value, v_InitValue, s_Sql, s_AllName,s_onchange)
 Dim i
 InitSelect = "<select name='" & s_FieldName & "' size=1 onChange='" & s_onchange & "'>"
 If s_AllName <> "" Then
 InitSelect = InitSelect & "<option value=''>" & s_AllName & "</option>"
 End If
 If s_Sql <> "" Then
 ors.Open s_Sql, oConn, 0, 1
 Do While Not ors.Eof
 InitSelect = InitSelect & "<option value=""" & inHTML(oRs(1)) & """"
 If ors(1) = v_InitValue Then
 InitSelect = InitSelect & " selected"
 End If
 InitSelect = InitSelect & ">" & outHTML(oRs(0)) & "</option>"
 ors.MoveNext
 Loop
 ors.Close
 Else
 For i = 0 To UBound(a_Name)
 InitSelect = InitSelect & "<option value=""" & inHTML(a_Value(i)) & """"
 If a_Value(i) = v_InitValue Then
 InitSelect = InitSelect & " selected"
 End If
 InitSelect = InitSelect & ">" & outHTML(a_Name(i)) & "</option>"
 Next
 End If
 InitSelect = InitSelect & "</select>"
 End Function

%>

<Script Language=JavaScript RunAt=Server>
 //===============================================
 // 单个过滤
 // 输入参数:
 // s_Content : 要转换的数据字符串
 // s_Filter : 要过滤掉的单个格式
 //===============================================
 function jimmycodeFilter(html, filter){
 switch(filter.toUpperCase()){
 case "SCRIPT": // 去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
 html = eWebEditor_execRE("</?script[^>]*>", "", html);
 html = eWebEditor_execRE("(javascript|jscript|vbscript|vbs):", "$1:", html);
 html = eWebEditor_execRE("on(mouse|exit|error|click|key)", "<I>on$1</I>", html);
 html = eWebEditor_execRE("&#", "<I>&#</I>", html);
 break;
 case "TABLE": // 去除表格<table><tr><td><th>
 html = eWebEditor_execRE("</?table[^>]*>", "", html);
 html = eWebEditor_execRE("</?tr[^>]*>", "", html);
 html = eWebEditor_execRE("</?th[^>]*>", "", html);
 html = eWebEditor_execRE("</?td[^>]*>", "", html);
 break;
 case "CLASS": // 去除样式类class=""
 html = eWebEditor_execRE("(<[^>]+) class=[^ |^>]*([^>]*>)", "$1 $2", html) ;
 break;
 case "STYLE": // 去除样式style=""
 html = eWebEditor_execRE("(<[^>]+) style=\"[^\"]*\"([^>]*>)", "$1 $2", html);
 break;
 case "XML": // 去除XML<?xml>
 html = eWebEditor_execRE("<\\?xml[^>]*>", "", html);
 break;
 case "NAMESPACE": // 去除命名空间<o:p></o:p>
 html = eWebEditor_execRE("<\/?[a-z]+:[^>]*>", "", html);
 break;
 case "FONT": // 去除字体<font></font>
 html = eWebEditor_execRE("</?font[^>]*>", "", html);
 break;
 case "P": // 去除字体<P></P>
 html = eWebEditor_execRE("</?p[^>]*>", "", html);
 break;
 case "IMG": // 去除图片<IMG></IMG>
 html = eWebEditor_execRE("</?img[^>]*>", "", html);
 break;
 case "MARQUEE": // 去除字幕<marquee></marquee>
 html = eWebEditor_execRE("</?marquee[^>]*>", "", html);
 break;
 case "OBJECT": // 去除对象<object><param><embed></object>
 html = eWebEditor_execRE("</?object[^>]*>", "", html);
 html = eWebEditor_execRE("</?param[^>]*>", "", html);
 html = eWebEditor_execRE("</?embed[^>]*>", "", html);
 break;
 case "HTML":
 html = eWebEditor_execRE("</?[^>]*>", "", html);
 break;
 default:
 }
 return html;
 }

// ============================================
 // 执行正则表达式替换
 // ============================================
 function eWebEditor_execRE(re, rp, content) {
 oreg = new RegExp(re, "ig");
 r = content.replace(oReg, rp);
 return r;
 }

</Script>

<%

'034
 '用途:翻页函数尾数(用于SqlServer存储过程翻页)
 '参数:totalcount(记录总数),totalpage(总页数),pagenumber(显示几个页码),
 ' mypagesize(每页显示记录数),page(当前页数),style(为"text"时,带快速跳转框)
 '示例:call showPage(TotalRecord,totalpage,5,10,page,"text")
 function showPage(totalcount,totalpage,pagenumber,mypagesize,page,style)
 dim url,parm,i,s_mid
 if totalpage<=1 then exit function
 if clng(page)<1 then page = 1
 if clng(page)>clng(totalpage) then page=totalpage
 if pagenumber="" then pagenumber=10
 if lcase(trim(style))="" then style="none"
 url = request.ServerVariables("url")
 parm = request.ServerVariables("Query_String")
 parm = deleteparm(parm,"page")
 if parm<>"" then
 url = url & "?" & parm & "&"
 else
 url = url & "?"
 end if
 showPage= "<table width='98%' align=center border=0><tr><td align=left>共有<font

color=red>" & totalcount & "</font>条,第:<font color=red>" & page & "</font>页/共<font

color=red>" & totalpage & "</font>页,<font color=red>" & mypagesize & "</font>/每页</td><td

align=right>"
 '处理首页问题
 if page>1 then
 showPage = showPage & "<a href='" & url & "page=1' title='首页'>"
 showPage = showPage & "<img src='/images/first.gif' align=absmiddle border=0></a>"
 end if

 s_mid = 0
 s_mid = clng(pagenumber\2)

 if pagenumber mod 2 <>0 then s_mid = s_mid+1

 if clng(page)<=clng(totalpage) and clng(page)>=clng(s_mid) then
 '处理中间页码的生成问题
 for i=page-s_mid+1 to page-s_mid+pagenumber
 if i<=totalpage then
 if clng(i)=clng(page) then
 showPage = showPage & " <font color=red>[" & i & "]</font>"


 else
 showPage = showPage & " <a href='" & url & "page=" & i & "'>" & i &

"</a>"
 end if
 end if
 next
 end if

 if page>=1 and clng(page)<clng(s_mid) then
 '第一页时的中间页码生成问题
 for i=1 to pagenumber
 if i<=totalpage then
 if clng(i)=clng(page) then
 showPage = showPage & " <font color=red>[" & i & "]</font>"


 else
 showPage = showPage & " <a href='" & url & "page=" & i & "'>" & i &

"</a>"
 end if
 end if
 next
 end if

 if clng(page)<clng(totalpage) then '不是最后一页
 showPage = showPage & " <a href='" & url & "page=" & totalpage & "' title='尾页'>"
 showPage = showPage & "<img src='/images/last.gif' align=absmiddle border=0></a>"
 end if

 showPage = showPage & "</td>"
 if style="text" then
 if right(url,1)="?" or right(url,1)="&" then url = left(url,len(url)-1)
 showPage = showPage & "<form name='frmpage' method='post' action='" & url &

"'><td><input size=2 name='page' value='" & page & "' style='border:1px inset #808080;

font-size: 9pt'> <input name='btnGo' type=submit value='Go' style='font-size: 9pt; border-

style: outset;border-width:1'></td></form></tr></table>"
 else
 showPage = showPage & "</tr></table>"
 end if
 Response.write showPage
 end function

'033
 '用途:用于列标题排序时生成相应地址
 '参数:s_field(排序字段名)
 '编写:杨俊明 2006-02-18
 function orderURL(s_field,s_Page)
 dim url,parm,orderway
 Url = Request.ServerVariables("URL")
 Parm = Request.ServerVariables("Query_String")
 s_field = lcase(s_field)
 parm = deleteparm(parm,"orderfield")
 parm = deleteparm(parm,"page")
 if parm = "" then
 orderURL = url & "?orderfield=" & s_field & "&page=" & s_Page
 else
 orderURL = url & "?" & parm & "&orderfield=" & s_field & "&page=" & s_Page
 end if
 end function

'032
 '用途:用于列标题排序时后面加上下箭头
 '参数:s_field(排序字段名)))
 '编写:杨俊明 2006-02-18
 function orderImg(s_field)
 dim parm,myfield
 Parm = Request.ServerVariables("Query_String")
 if parm = "" then exit function
 s_field = trim(lcase(s_field))
 myfield = findparm(parm,"orderfield")
 myfield = lcase(trim(myfield))
 if myfield="" then exit function
 if myfield = s_field then
 if session("sort")="asc" then
 response.write "<font color=red>↑</font>"
 else
 response.write "<font color=red>↓</font>"
 end if
 end if
 end function

'031 播放rm文件
 sub showrm(rmpath,iwidth,iheight)
 response.write "<OBJECT ID=RVOCX CLASSID='clsid:CFCDAA03-8BE4-11cf-B84B-0020AFBBCCFA'

WIDTH=" & iwidth & " HEIGHT=" & iheight & ">" & vbcrlf
 response.write " <PARAM NAME='SRC' VALUE='" & rmpath & "'>" & vbcrlf
 response.write " <PARAM NAME='CONTROLS' VALUE='ImageWindow'>" & vbcrlf
 response.write " <PARAM NAME='CONSOLE' VALUE='one'>" & vbcrlf
 response.write " <PARAM NAME='AUTOSTART' VALUE='true'>" & vbcrlf
 response.write " <param name='LOOP' value='true'>" & vbcrlf
 response.write " <EMBED SRC="" WIDTH=" & iwidth & " HEIGHT=" & iheight & " NOJAVA=true

CONTROLS=ImageWindow CONSOLE=one AUTOSTART=true>" & vbcrlf
 response.write "</OBJECT>"
 end sub

'利用java显示3d全景图 ,根目录下,需要放rubberneck.zip rubberneck.properties 两个文件
 sub show3D(jpgpath,iwidth,iheight)
 response.write "<APPLET name='rubber' archive='rubberneck.zip' code=RubberNeck.class

width=" & iwidth & " height=" & iheight & " MAYSCRIPT=true>" & vbcrlf
 response.write " <PARAM name='enablefiltering' value='true'>" & vbcrlf
 response.write " <PARAM name='revealhotspots' value='true'>" & vbcrlf
 response.write " <PARAM name='incRate' value='100'>" & vbcrlf
 response.write " <PARAM name='actions.length' value='1'>" & vbcrlf
 response.write " <PARAM name='actions[0]' value='PositionAction'>" & vbcrlf
 response.write " <PARAM name='actions[0].time' value='5000'>" & vbcrlf
 response.write " <PARAM name='actions[0].isRel' value='true'>" & vbcrlf
 response.write " <PARAM name='actions[0].pos.zoom' value='0'>" & vbcrlf
 response.write " <PARAM name='actions[0].pos.yaw' value='360'>" & vbcrlf
 response.write " <PARAM name='actions[0].pos.pitch' value='0'>" & vbcrlf
 response.write " <PARAM name='rooms[0]' value='CylinderRoom'>" & vbcrlf
 response.write " <PARAM name='rooms[0].initAction' value='0'>" & vbcrlf
 response.write " <PARAM name='rooms[0].image' value='" & jpgpath & "'>" & vbcrlf
 response.write " </APPLET>"
 end sub


 '030
 function showSWF(imgpath,iwidth,iheight,cssOver,cssOut,salign,sborder)
 showSWF = "<embed wmode='transparent' src='" & imgpath & "'"
 if iwidth<>"" then showSWF = showSWF & " width=" & iwidth
 if iheight<>"" then showSWF = showSWF & " height=" & iwidth
 if cssOver<>"" then showSWF = showSWF & " onmouseover = " & chr(34) &

"this.className='" & cssOver & "'" & chr(34)
 if cssOut<>"" then showSWF = showSWF & " onmouseOut = " & chr(34) & "this.className='"

& cssOut & "'" & chr(34) & " class='" & cssout & "'"
 if sAlign<>"" then showSWF = showSWF & " align=" & sAlign
 if sborder<>"" then showSWF = showSWF & " border=" & sborder
 showSWF = showSWF & "></embed>"
 response.write showSWF
 end function

'029
 function showIMG(imgpath,iwidth,iheight,cssOver,cssOut,salign,sborder)
 showIMG = "<img src='" & imgpath & "'"
 if iwidth<>"" then showIMG = showIMG & " width=" & iwidth
 if iheight<>"" then showIMG = showIMG & " height=" & iwidth
 if cssOver<>"" then showIMG = showIMG & " onmouseover = " & chr(34) &

"this.className='" & cssOver & "'" & chr(34)
 if cssOut<>"" then showIMG = showIMG & " onmouseOut = " & chr(34) & "this.className='"

& cssOut & "'" & chr(34) & " class='" & cssout & "'"
 if sAlign<>"" then showIMG = showIMG & " align=" & sAlign
 if sborder<>"" then showIMG = showIMG & " border=" & sborder
 showIMG = showIMG & ">"
 response.write showIMG
 end function

function showIMGex(imgpath,iwidth,iheight,cssOver,cssOut,salign,sborder)
 showIMGex = "<img src='" & imgpath & "'"
 if iwidth<>"" then showIMGex = showIMGex & " width=" & iwidth
 if iheight<>"" then showIMGex = showIMGex & " height=" & iwidth
 if cssOver<>"" then showIMGex = showIMGex & " onMouseOver = " & chr(34) &

"this.className='" & cssOver & "'" & chr(34)
 if cssOut<>"" then showIMGex = showIMGex & " onMouseOut = " & chr(34) &

"this.className='" & cssOut & "'" & chr(34) & " class='" & cssout & "'"
 if sAlign<>"" then showIMGex = showIMGex & " align=" & sAlign
 if sborder<>"" then showIMGex = showIMGex & " border=" & sborder
 showIMGex = showIMGex & ">"
 end function

'028
 '用途:查询网页参数字符中某项的值
 '参数:t_urlparm(IE地址栏参数,可用request.ServerVariables("QUERY_STRING")得到,
 ' 比如xxx.asp?sex=man&age=18&name=杨 这个地址中参数为"sex=man&age=18&name=杨")
 '示例:findparm("sex=man&age=18&name=杨","age")将显示结果18
 '编写:杨俊明 QQ:278919507 Email:yjmyzz@126.com 2006-2-9 10:49
 function findparm(t_urlparm,t_findparm)
 if t_urlparm="" then
 findparm=""
 exit function
 end if
 dim temp,kk
 temp = split(t_urlparm,"&")
 for kk=0 to ubound(temp)
 if instr(temp(kk),t_findparm)>0 then
 findparm = right(temp(kk),len(temp(kk))-1-len(t_findparm))
 exit function
 end if
 next
 end function

'027 产生20位长度的唯一标识ID
 'response.write makeID()
 function makeID()
 dim datestr,mytime,myyear,mymonth,myday,i
 myyear = cstr(year(date()))
 mymonth = cstr(month(date()))
 myday = cstr(day(date()))
 mymonth = lpad(mymonth,0,2)
 makeID = myyear & "_" & mymonth & "_" & myday & "_"
 datestr=cstr(now())
 i = instr(datestr," ")
 mytime = right(datestr,len(datestr)-i)
 mytime = replace(mytime,":","_")
 randomize
 i = Int((9999 - 1000 + 1) * Rnd + 1000)
 makeID = makeID & mytime & "_" & i
 makeID = replace(makeID,"_","")
 end function

'026
 '用途:按分隔符查找字符串,找到返回True
 '示例:if findStr("1,2,3,13,23","43") then
 'response.write findStr("1,2,5,13,23",",","3")
 function findStr(strSrc,strSplit,strFind)
 dim s_temp,i
 findStr = false
 if strSrc = "" or isnull(strSrc) then exit function
 if strSplit = "" or isnull(strSplit) then exit function
 if strFind = "" or isnull(strFind) then exit function
 s_temp = split(strSrc,strSplit)
 for i = 0 to ubound(s_temp)
 if cstr(s_temp(i))=cstr(strFind) then
 findStr = True
 exit function
 end if
 next
 end function

'025
 '用途:删除指定网页参数中的某一项
 '编写:杨俊明 2006-2-17 14:29
 '示例:response.write deleteparm("abc=3&name=jimmy&sex=male","name") 结果为abc=3&sex=male
 'response.write deleteparm("abc=3&name=jimmy&sex=male","name")
 function deleteparm(parmlist,findparm)
 dim i,parmFront,parmBack
 i = instr(parmlist,findparm)
 if i>0 then
 if i>2 then
 parmfront = left(parmlist,i-2)
 else
 parmfront = ""
 end if

 parmlist = right(parmlist,len(parmlist)-i+1)
 i = instr(parmlist,"&")
 if i>0 then
 parmback = right(parmlist,len(parmlist)-i)
 else
 parmback = ""
 end if
 else
 deleteparm = parmlist
 exit function
 end if

 if parmfront<>"" and parmback<>"" then
 deleteparm = parmfront & "&" & parmback
 else
 deleteparm = parmfront & parmback
 end if
 end function

'024****************************************************
 '函数名:doWrap
 '作 用:解决DW显示字段值不能换行的问题
 '参 数:str,注str不能为NULL值
 '编 写:网上搜集
 '****************************************************
 function doWrap(str)
 if str=NULL then
 doWrap=""
 else
 doWrap = Replace((Replace(str, vbCrlf, "<br>")), chr(32)&chr(32), " ")
 end if
 End Function

'023****************************************************
 '函数名:checkIMG(适用于HTML代码)
 '作 用:检查字符中是否有IMG字样
 '参 数:str,注str不能为NULL值
 '编 写:杨俊明
 '****************************************************
 'response.write checkIMG("<img src=>")
 function checkIMG(str)
 if isnull(str) then
 str=""
 end if
 checkIMG = false
 str = ucase(str)
 if instr(str,"<IMG")>=1 then
 checkIMG = true
 end if
 end function

'函数名:checkIMGUBB(适用于UBB代码)
 '作 用:检查字符中是否有IMG字样,即检查ubb代码中是否图片
 '参 数:str,注str不能为NULL值
 '编写:杨俊明 *********************************************
 function checkIMGUBB(str)
 if isnull(str) then
 str=""
 end if
 checkIMGUBB = false
 str = ucase(str)
 if instr(str,"[IMG]")>=1 then
 checkIMGUBB = true
 end if
 end function

'022
 '用途:拆分字符串,取拆分后的子串数
 '示例: response.write splitCount("abc|def|123","|") 结果显示3
 '编写:杨俊明
 'response.write splitCount("abc|def|123","|")
 function splitCount(str,splitchar)
 dim temp
 if isnull(str) or str="" then
 splitCount=0
 exit function
 end if
 temp = split(str,splitchar)
 splitCount=ubound(temp)+1
 end function

'021
 '用途:去掉所有html标记,并截取相应长度的字符串
 '示例:response.write nohtmlex("<br><font color=red>abc</font>",3)
 '编写:来自互联网
 'response.write nohtmlex("<br><font color=red>abc</font>",3)
 Function nohtml(str,strlen)
 if isnull(str) then str=""
 '去掉所有HTML标记
 Dim re
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="<(.[^>]*)>"
 're.Pattern="</?[^>]*>"
 str=re.Replace(str,"")
 set re=Nothing
 Dim l,t,c,i
 l=Len(str)
 t=0
 For i=1 to l
 c=Abs(Asc(Mid(str,i,1)))
 If c>255 Then
 t=t+2
 Else
 t=t+1
 End If
 If t>=strlen Then
 nohtml=left(str,i)&"..."
 Exit For
 Else
 nohtml=str
 End If
 Next
 'nohtml=Replace(nohtml,chr(10),"<br>")
 nohtml=Replace(nohtml,chr(13),"<br>")
 End Function

'用途:去掉所有html标记,包括回车,空格,并截取相应长度的字符串
 '示例:response.write nohtmlex("<br><font color=red>abc</font>",3)
 '编写:杨俊明 修改于网上源程序
 Function nohtmlEx(str,strlen)
 if isnull(str) then str=""
 '去掉所有HTML标记
 Dim re
 Set re=new RegExp
 re.IgnoreCase =True
 re.Global=True
 re.Pattern="<(.[^>]*)>"
 're.Pattern="</?[^>]*>"
 str=re.Replace(str,"")
 set re=Nothing
 Dim l,t,c,i
 l=Len(str)
 t=0
 For i=1 to l
 c=Abs(Asc(Mid(str,i,1)))
 If c>255 Then
 t=t+2
 Else
 t=t+1
 End If
 If t>=strlen Then
 nohtmlEx=left(str,i)
 Exit For
 Else
 nohtmlEx=str
 End If
 Next
 nohtmlEx=Replace(nohtmlEx," ","")
 nohtmlEx=Replace(nohtmlEx," ","")
 nohtmlEx=Replace(nohtmlEx,chr(13),"")
 nohtmlEx=Replace(nohtmlEx,chr(10),"")
 nohtmlEx=Replace(nohtmlEx," ","")
 End Function

'020
 '用途:例如利用Jmail发信,适合于smtp需要验证的情况 
 '示例:
 'dim subject,mailaddress,sendername,email,content,fromer,SerEmailUser,SerEmailPass
 'subject ="你好,我是CPP114"
 'mailaddress = "mail.cpp114.net"
 'senderName = "我不是杨过"
 'email = "yjmyzz@126.com"
 'content = "欢迎访问中华印刷包装网!<br><a

href=http://www.cpp114.com>www.cpp114.com</a><br>发送成功了,苍天啊,大地啊,不容易啊!"
 'fromer = "yangjm@cpp114.net"
 'SerEmailUser = "yangjm@cpp114.net"
 'SerEmailPass = "3power"
 'call SendMailEx(subject, mailaddress, senderName,email, content,

fromer,serEmailUser,serEmailPass)
 Sub SendMailEx(subject, mailaddress, senderName,email, content,

fromer,serEmailUser,serEmailPass)
 dim Jmail
 Set jmail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
 jmail.silent = true '屏蔽例外错误,返回FALSE跟TRUE两值
 jmail.logging = true '启用邮件日志
 jmail.Charset = "GB2312" '邮件的文字编码为国标
 jmail.ContentType = "text/html" '邮件的格式为HTML格式
 JMail.FromName = senderName '邮件发送者名称
 jmail.AddRecipient Email '邮件收件人的地址
 jmail.From = fromer '发件人的E-MAIL地址
 jmail.MailServerUserName = serEmailUser '登录邮件服务器所需的用户名
 jmail.MailServerPassword = serEmailPass '登录邮件服务器所需的密码
 jmail.Subject = subject '邮件的标题
 jmail.Body = content '邮件的内容
 jmail.Priority = 1 '邮件的紧急程序,1 为最快,5 为最慢, 3 为默认值
 jmail.Send(mailaddress) '执行邮件发送(通过邮件服务器地址)
 jmail.Close() '关闭对象
 end Sub


 '用途:例如利用Jmail发信,适合于smtp不用验证的情况 
 '示例:
 'subject = "新闻系统_美女脱衣"
 'mailaddress = "61.152.108.148" '换成smtp.cpp114.net也行
 'email = "yjm@cpp114.net"
 'sender = "我不是杨过"
 'content = "您好,收到这封邮件,表示你今天会有好运气!<a href=http://www.baidu.com

target=_blank>百度搜索</a>"
 'fromer = "yangjm@cpp114.net"
 'call SendMail(subject, mailaddress, email, sender, content, fromer)
 Sub SendMail(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() '执行邮件发送
 jmail.Close '关闭邮件对象
 End Sub

'019
 '用途:获取远程的网页内容
 '示例:response.write getHTTPPage("http://www.baidu.com")
 'response.write getHTTPPage("http://www.baidu.com")
 function getHTTPPage(url)
 on error resume next
 dim http
 set http=Server.createobject("Microsoft.XMLHTTP")
 Http.open "GET",url,false
 Http.send()
 if Http.readystate<>4 then
 exit function
 end if
 getHTTPPage=bytes2BSTR(Http.responseBody)
 set http=nothing
 if err.number<>0 then err.Clear
 end function

Function bytes2BSTR(vIn)
 dim strReturn
 dim i,ThisCharCode,NextCharCode
 strReturn = ""
 For i = 1 To LenB(vIn)
 ThisCharCode = AscB(MidB(vIn,i,1))
 If ThisCharCode < &H80 Then
 strReturn = strReturn & Chr(ThisCharCode)
 Else
 NextCharCode = AscB(MidB(vIn,i+1,1))
 strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
 i = i + 1
 End If
 Next
 bytes2BSTR = strReturn
 End Function

'018
 '用途:检查str是否为空
 Function checkNull(str)
 checkNull = False
 if trim(str)="" or isnull(str) then
 checkNull = True
 end if
 end Function

'017**************************************************
 '函数名:strLength
 '作 用:求字符串长度。汉字算两个字符,英文算一个字符。
 '参 数:str ----要求长度的字符串
 '返回值:字符串长度
 '**************************************************
 'response.write strLength("中国")
 function strLength(str)
 ON ERROR RESUME NEXT
 dim WINNT_CHINESE
 WINNT_CHINESE = (len("中国")=2)
 if WINNT_CHINESE then
 dim l,t,c
 dim i
 l=len(str)
 t=l
 for i=1 to l
 c=asc(mid(str,i,1))
 if c<0 then c=c+65536
 if c>255 then
 t=t+1
 end if
 next
 strLength=t
 else
 strLength=len(str)
 end if
 if err.number<>0 then err.clear
 end function

'016****************************************************
 '函数名:isHTTP
 '作 用:检查字符串是否以HTTP开头或以"/"开头
 '参 数:str,注str不能为NULL值
 '编 写:杨俊明
 '****************************************************
 'response.write isHTTP("http://")
 Function isHTTP(MyString)
 if isnull(MyString) then isHTTP = false
 if mid(lcase(trim(MyString)),1,7)="http://" or left(MyString,1)="/" then
 isHTTP = true
 else
 isHTTP = False
 end if
 end function

'015
 '作 用:检查组件是否已经安装
 '参 数:strClassString ----组件名
 '返回值:True ----已经安装
 ' False ----没有安装
 '示例: response.write IsObjInstalled("Adodb.recordset")
 '编写:网上搜索
 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

'014========网上搜集=====================================
 '过程名:ShowArticleContent
 '作 用:显示文章具体的内容,可以分页显示
 '参 数:ShowContentByPage,s_content,MaxPerPage_Content
 '调用示例:
 'ShowContentByPage="yes" '是否使用文章分页(为No,则表示关闭)
 's_content = "一1<font color=red>二2三3四</font>4五六七八九十" '要分页显示的字符串
 'MaxPerPage_Content = 15 '每页显示的字数(注意,html源代码也计算在内)
 'call ShowArticleContent(ShowContentByPage,s_content,MaxPerPage_Content)
 '=================================================
 'call ShowArticleContent("yes","123456789",4)有问题
 sub ShowArticleContent(ShowContentByPage,s_content,MaxPerPage_Content)
 on error resume next
 dim ArticleID,strContent,CurrentPage,GoUrl,GoParm
 dim ContentLen,MaxPerPage,pages,i,lngBound
 dim BeginPoint,EndPoint
 GoUrl = request.ServerVariables("url")
 GoParm = trim(request.ServerVariables("query_string"))
 if isNull(GoPram) then GoParm=""
 if instr(GoParm,"ArticlePage")>0 then GoParm = left(GoParm,instr(GoParm,"ArticlePage")

-1)
 if right(GoParm,1)="&" then GoParm = left(GoParm,len(GoParm)-1)
 if GoParm<>"" then
 GoUrl = GoUrl & "?" & GoParm & "&"
 else
 GoUrl = GoUrl & "?"
 end if
 ShowContentByPage = ucase(ShowContentByPage)
 ArticleID=cint(s_id)
 strContent=s_content
 ContentLen=len(strContent)
 CurrentPage=trim(request("ArticlePage"))
 if ShowContentByPage="NO" or ContentLen<=MaxPerPage_Content then
 response.write strContent
 if ShowContentByPage="YES" then
 response.write "</p><p align='center'></p>"
 end if
 else
 if CurrentPage="" then
 CurrentPage=1
 else
 CurrentPage=Cint(CurrentPage)
 end if
 pages=ContentLen\MaxPerPage_Content
 if MaxPerPage_Content*pages<ContentLen then
 pages=pages+1
 end if
 lngBound=MaxPerPage_Content '最大误差范围
 if CurrentPage<1 then CurrentPage=1
 if CurrentPage>pages then CurrentPage=pages

dim lngTemp
 dim

lngTemp1,lngTemp1_1,lngTemp1_2,lngTemp1_1_1,lngTemp1_1_2,lngTemp1_1_3,lngTemp1_2_1,lngTemp1

_2_2,lngTemp1_2_3
 dim

lngTemp2,lngTemp2_1,lngTemp2_2,lngTemp2_1_1,lngTemp2_1_2,lngTemp2_2_1,lngTemp2_2_2
 dim

lngTemp3,lngTemp3_1,lngTemp3_2,lngTemp3_1_1,lngTemp3_1_2,lngTemp3_2_1,lngTemp3_2_2
 dim

lngTemp4,lngTemp4_1,lngTemp4_2,lngTemp4_1_1,lngTemp4_1_2,lngTemp4_2_1,lngTemp4_2_2
 dim lngTemp5,lngTemp5_1,lngTemp5_2
 dim lngTemp6,lngTemp6_1,lngTemp6_2

 if CurrentPage=1 then
 BeginPoint=1
 else
 BeginPoint=MaxPerPage_Content*(CurrentPage-1)+1

 lngTemp1_1_1=instr(BeginPoint,strContent,"</table>",1)
 lngTemp1_1_2=instr(BeginPoint,strContent,"</TABLE>",1)
 lngTemp1_1_3=instr(BeginPoint,strContent,"</Table>",1)
 if lngTemp1_1_1>0 then
 lngTemp1_1=lngTemp1_1_1
 elseif lngTemp1_1_2>0 then
 lngTemp1_1=lngTemp1_1_2
 elseif lngTemp1_1_3>0 then
 lngTemp1_1=lngTemp1_1_3
 else
 lngTemp1_1=0
 end if

 lngTemp1_2_1=instr(BeginPoint,strContent,"<table",1)
 lngTemp1_2_2=instr(BeginPoint,strContent,"<TABLE",1)
 lngTemp1_2_3=instr(BeginPoint,strContent,"<Table",1)
 if lngTemp1_2_1>0 then
 lngTemp1_2=lngTemp1_2_1
 elseif lngTemp1_2_2>0 then
 lngTemp1_2=lngTemp1_2_2
 elseif lngTemp1_2_3>0 then
 lngTemp1_2=lngTemp1_2_3
 else
 lngTemp1_2=0
 end if

 if lngTemp1_1=0 and lngTemp1_2=0 then
 lngTemp1=BeginPoint
 else
 if lngTemp1_1>lngTemp1_2 then
 lngtemp1=lngTemp1_2
 else
 lngTemp1=lngTemp1_1+8
 end if
 end if

lngTemp2_1_1=instr(BeginPoint,strContent,"</p>",1)
 lngTemp2_1_2=instr(BeginPoint,strContent,"</P>",1)
 if lngTemp2_1_1>0 then
 lngTemp2_1=lngTemp2_1_1
 elseif lngTemp2_1_2>0 then
 lngTemp2_1=lngTemp2_1_2
 else
 lngTemp2_1=0
 end if

 lngTemp2_2_1=instr(BeginPoint,strContent,"<p",1)
 lngTemp2_2_2=instr(BeginPoint,strContent,"<P",1)
 if lngTemp2_2_1>0 then
 lngTemp2_2=lngTemp2_2_1
 elseif lngTemp2_2_2>0 then
 lngTemp2_2=lngTemp2_2_2
 else
 lngTemp2_2=0
 end if

 if lngTemp2_1=0 and lngTemp2_2=0 then
 lntTemp2=BeginPoint
 else
 if lngTemp2_1>lngTemp2_2 then
 lngtemp2=lngTemp2_2
 else
 lngTemp2=lngTemp2_1+4
 end if
 end if

lngTemp3_1_1=instr(BeginPoint,strContent,"</ur>",1)
 lngTemp3_1_2=instr(BeginPoint,strContent,"</UR>",1)
 if lngTemp3_1_1>0 then
 lngTemp3_1=lngTemp3_1_1
 elseif lngTemp3_1_2>0 then
 lngTemp3_1=lngTemp3_1_2
 else
 lngTemp3_1=0
 end if

 lngTemp3_2_1=instr(BeginPoint,strContent,"<ur",1)
 lngTemp3_2_2=instr(BeginPoint,strContent,"<UR",1)
 if lngTemp3_2_1>0 then
 lngTemp3_2=lngTemp3_2_1
 elseif lngTemp3_2_2>0 then
 lngTemp3_2=lngTemp3_2_2
 else
 lngTemp3_2=0
 end if

 if lngTemp3_1=0 and lngTemp3_2=0 then
 lngTemp3=BeginPoint
 else
 if lngTemp3_1>lngTemp3_2 then
 lngtemp3=lngTemp3_2
 else
 lngTemp3=lngTemp3_1+5
 end if
 end if

 if lngTemp1<lngTemp2 then
 lngTemp=lngTemp2
 else
 lngTemp=lngTemp1
 end if
 if lngTemp<lngTemp3 then
 lngTemp=lngTemp3
 end if

if lngTemp>BeginPoint and lngTemp<=BeginPoint+lngBound then
 BeginPoint=lngTemp
 else
 lngTemp4_1_1=instr(BeginPoint,strContent,"</li>",1)
 lngTemp4_1_2=instr(BeginPoint,strContent,"</LI>",1)
 if lngTemp4_1_1>0 then
 lngTemp4_1=lngTemp4_1_1
 elseif lngTemp4_1_2>0 then
 lngTemp4_1=lngTemp4_1_2
 else
 lngTemp4_1=0
 end if

 lngTemp4_2_1=instr(BeginPoint,strContent,"<li",1)
 lngTemp4_2_1=instr(BeginPoint,strContent,"<LI",1)
 if lngTemp4_2_1>0 then
 lngTemp4_2=lngTemp4_2_1
 elseif lngTemp4_2_2>0 then
 lngTemp4_2=lngTemp4_2_2
 else
 lngTemp4_2=0
 end if

 if lngTemp4_1=0 and lngTemp4_2=0 then
 lngTemp4=BeginPoint
 else
 if lngTemp4_1>lngTemp4_2 then
 lngtemp4=lngTemp4_2
 else
 lngTemp4=lngTemp4_1+5
 end if
 end if

 if lngTemp4>BeginPoint and lngTemp4<=BeginPoint+lngBound then
 BeginPoint=lngTemp4
 else
 lngTemp5_1=instr(BeginPoint,strContent,"<img",1)
 lngTemp5_2=instr(BeginPoint,strContent,"<IMG",1)
 if lngTemp5_1>0 then
 lngTemp5=lngTemp5_1
 elseif lngTemp5_2>0 then
 lngTemp5=lngTemp5_2
 else
 lngTemp5=BeginPoint
 end if

 if lngTemp5>BeginPoint and lngTemp5<BeginPoint+lngBound then
 BeginPoint=lngTemp5
 else
 lngTemp6_1=instr(BeginPoint,strContent,"<br>",1)
 lngTemp6_2=instr(BeginPoint,strContent,"<BR>",1)
 if lngTemp6_1>0 then
 lngTemp6=lngTemp6_1
 elseif lngTemp6_2>0 then
 lngTemp6=lngTemp6_2
 else
 lngTemp6=0
 end if

 if lngTemp6>BeginPoint and lngTemp6<BeginPoint+lngBound then
 BeginPoint=lngTemp6+4
 end if
 end if
 end if
 end if
 end if

if CurrentPage=pages then
 EndPoint=ContentLen
 else
 EndPoint=MaxPerPage_Content*CurrentPage
 if EndPoint>=ContentLen then
 EndPoint=ContentLen
 else
 lngTemp1_1_1=instr(EndPoint,strContent,"</table>",1)
 lngTemp1_1_2=instr(EndPoint,strContent,"</TABLE>",1)
 lngTemp1_1_3=instr(EndPoint,strContent,"</Table>",1)
 if lngTemp1_1_1>0 then
 lngTemp1_1=lngTemp1_1_1
 elseif lngTemp1_1_2>0 then
 lngTemp1_1=lngTemp1_1_2
 elseif lngTemp1_1_3>0 then
 lngTemp1_1=lngTemp1_1_3
 else
 lngTemp1_1=0
 end if

 lngTemp1_2_1=instr(EndPoint,strContent,"<table",1)
 lngTemp1_2_2=instr(EndPoint,strContent,"<TABLE",1)
 lngTemp1_2_3=instr(EndPoint,strContent,"<Table",1)
 if lngTemp1_2_1>0 then
 lngTemp1_2=lngTemp1_2_1
 elseif lngTemp1_2_2>0 then
 lngTemp1_2=lngTemp1_2_2
 elseif lngTemp1_2_3>0 then
 lngTemp1_2=lngTemp1_2_3
 else
 lngTemp1_2=0
 end if

 if lngTemp1_1=0 and lngTemp1_2=0 then
 lngTemp1=EndPoint
 else
 if lngTemp1_1>lngTemp1_2 then
 lngtemp1=lngTemp1_2-1
 else
 lngTemp1=lngTemp1_1+7
 end if
 end if

lngTemp2_1_1=instr(EndPoint,strContent,"</p>",1)
 lngTemp2_1_2=instr(EndPoint,strContent,"</P>",1)
 if lngTemp2_1_1>0 then
 lngTemp2_1=lngTemp2_1_1
 elseif lngTemp2_1_2>0 then
 lngTemp2_1=lngTemp2_1_2
 else
 lngTemp2_1=0
 end if

 lngTemp2_2_1=instr(EndPoint,strContent,"<p",1)
 lngTemp2_2_2=instr(EndPoint,strContent,"<P",1)
 if lngTemp2_2_1>0 then
 lngTemp2_2=lngTemp2_2_1
 elseif lngTemp2_2_2>0 then
 lngTemp2_2=lngTemp2_2_2
 else
 lngTemp2_2=0
 end if

 if lngTemp2_1=0 and lngTemp2_2=0 then
 lngTemp2=EndPoint
 else
 if lngTemp2_1>lngTemp2_2 then
 lngTemp2=lngTemp2_2-1
 else
 lngTemp2=lngTemp2_1+3
 end if
 end if

lngTemp3_1_1=instr(EndPoint,strContent,"</ur>",1)
 lngTemp3_1_2=instr(EndPoint,strContent,"</UR>",1)
 if lngTemp3_1_1>0 then
 lngTemp3_1=lngTemp3_1_1
 elseif lngTemp3_1_2>0 then
 lngTemp3_1=lngTemp3_1_2
 else
 lngTemp3_1=0
 end if

 lngTemp3_2_1=instr(EndPoint,strContent,"<ur",1)
 lngTemp3_2_2=instr(EndPoint,strContent,"<UR",1)
 if lngTemp3_2_1>0 then
 lngTemp3_2=lngTemp3_2_1
 elseif lngTemp3_2_2>0 then
 lngTemp3_2=lngTemp3_2_2
 else
 lngTemp3_2=0
 end if

 if lngTemp3_1=0 and lngTemp3_2=0 then
 lngTemp3=EndPoint
 else
 if lngTemp3_1>lngTemp3_2 then
 lngtemp3=lngTemp3_2-1
 else
 lngTemp3=lngTemp3_1+4
 end if
 end if

 if lngTemp1<lngTemp2 then
 lngTemp=lngTemp2
 else
 lngTemp=lngTemp1
 end if
 if lngTemp<lngTemp3 then
 lngTemp=lngTemp3
 end if

if lngTemp>EndPoint and lngTemp<=EndPoint+lngBound then
 EndPoint=lngTemp
 else
 lngTemp4_1_1=instr(EndPoint,strContent,"</li>",1)
 lngTemp4_1_2=instr(EndPoint,strContent,"</LI>",1)
 if lngTemp4_1_1>0 then
 lngTemp4_1=lngTemp4_1_1
 elseif lngTemp4_1_2>0 then
 lngTemp4_1=lngTemp4_1_2
 else
 lngTemp4_1=0
 end if

 lngTemp4_2_1=instr(EndPoint,strContent,"<li",1)
 lngTemp4_2_1=instr(EndPoint,strContent,"<LI",1)
 if lngTemp4_2_1>0 then
 lngTemp4_2=lngTemp4_2_1
 elseif lngTemp4_2_2>0 then
 lngTemp4_2=lngTemp4_2_2
 else
 lngTemp4_2=0
 end if

 if lngTemp4_1=0 and lngTemp4_2=0 then
 lngTemp4=EndPoint
 else
 if lngTemp4_1>lngTemp4_2 then
 lngtemp4=lngTemp4_2-1
 else
 lngTemp4=lngTemp4_1+4
 end if
 end if

 if lngTemp4>EndPoint and lngTemp4<=EndPoint+lngBound then
 EndPoint=lngTemp4
 else
 lngTemp5_1=instr(EndPoint,strContent,"<img",1)
 lngTemp5_2=instr(EndPoint,strContent,"<IMG",1)
 if lngTemp5_1>0 then
 lngTemp5=lngTemp5_1-1
 elseif lngTemp5_2>0 then
 lngTemp5=lngTemp5_2-1
 else
 lngTemp5=EndPoint
 end if

 if lngTemp5>EndPoint and lngTemp5<EndPoint+lngBound then
 EndPoint=lngTemp5
 else
 lngTemp6_1=instr(EndPoint,strContent,"<br>",1)
 lngTemp6_2=instr(EndPoint,strContent,"<BR>",1)
 if lngTemp6_1>0 then
 lngTemp6=lngTemp6_1+3
 elseif lngTemp6_2>0 then
 lngTemp6=lngTemp6_2+3
 else
 lngTemp6=EndPoint
 end if

 if lngTemp6>EndPoint and lngTemp6<EndPoint+lngBound then
 EndPoint=lngTemp6
 end if
 end if
 end if
 end if
 end if
 end if
 response.write mid(strContent,BeginPoint,EndPoint-BeginPoint)
 response.write "</p><p align='center'>"
 if CurrentPage>1 then
 response.write "<a href=" & Gourl & "ArticlePage=" & CurrentPage-1 & ">上一页

</a> "
 end if
 for i=1 to pages
 if i=CurrentPage then
 response.write "<font color='red'>[" & cstr(i) & "]</font> "
 else
 response.write "<a href=" & Gourl & "ArticlePage=" & i & ">[" & i & "]</a>

"
 end if
 next
 if CurrentPage<pages then
 response.write " <a href=" & Gourl & "ArticlePage=" & CurrentPage+1 & ">下一页

</a>"
 end if
 response.write "</p>"
 end if
 end sub


 '010
 '用途:返回本月第一天的日期
 '编写:杨俊明 2006-2-10 11:57
 function get1stMonth()
 get1stMonth = cdate(year(date) & "-" & month(date) & "-1")
 end function

'011
 '用途:返回本年第一天的日期
 '编写:杨俊明 2006-2-10 11:58
 function get1stYear()
 get1stYear = cdate(year(date) & "-1-1")
 end function

'012
 '用途:返回本周第一天的日期
 '编写:杨俊明 2006-2-10 11:58
 'response.write get1stWeek
 function get1stWeek()
 dim s_weekday
 s_weekday = Weekday(date())
 if s_weekday>2 then
 get1stWeek=date()-(s_weekday-2)
 elseif s_weekday=2 then
 get1stWeek= date()
 else
 get1stWeek = date()-6
 end if
 end function

'013
 '用途:返回本季度每一天的日期
 '编写:杨俊明 2006-2-10 11:59
 function get1stQua()
 dim s_month
 s_month = month(date())
 s_month = s_month \ 3
 if s_month<=1 then
 get1stQua = year(date) & "-1-1"
 elseif s_month<=2 then
 get1stQua = year(date) & "-4-1"
 elseif s_month<=3 then
 get1stQua = year(date) & "-7-1"
 else
 get1stQua = year(date) & "-10-1"
 end if
 get1stQua = cdate(get1stQua)
 end function

'009
 '用途:取最小值,调用示例i=min("12,34,45,67")
 '编写:杨俊明 2006-2-10 11:56
 'response.write min("12,34,45,67")
 function min(info)
 dim arr,i
 arr=split(info,",")
 min=clng(arr(0))
 for i=1 to ubound(arr)
 if clng(arr(i))<clng(min) then min=clng(arr(i))
 next
 end function

'008
 '用途:取最大值,调用示例i=max("12,34,45,67")
 '编写:杨俊明 2006-2-10 11:56
 function max(info)
 dim arr,i
 arr=split(info,",")
 max=clng(arr(0))
 for i=1 to ubound(arr)
 if clng(arr(i))>clng(max) then max=clng(arr(i))
 next
 end function

'007
 '用途:弹出一个对话框(根据用户需要还可跳转到相关地址)
 '参数:str(弹出内容),weburl(弹出对话框后,跳转后的地址)
 '示例:call alert("你没有权限打开此页","")
 '编写:杨俊明 2006-2-10 11:56
 sub alert(str,weburl)
 if trim(str)="" then exit sub
 response.write "<script>alert('" & str & "');</script>"
 if trim(weburl) <>"" then response.write "<script>window.location='" & weburl &

"';</script>"
 End sub

'001
 '用途:用于左填充指定数量的字符,以达到规范长度
 '参数:desstr(目标字符),lpad(填充字符),lenint(填充后的字符总长度)
 '示例:response.write lpad(4,0,5),结果显示00004
 '编写:杨俊明 2006-2-4 20:09 QQ:278919507 Email:yjmyzz@126.com
 'response.write lpad(4,0,5)
 function lpad(desstr,padchar,lenint)
 dim d,p,t
 d = cstr(desstr)
 p = cstr(padchar)
 lpad=""
 for t=1 to lenint-len(d)
 lpad = p & lpad
 next
 lpad = lpad & d
 end function


 '002
 '用途:用于右填充指定数量的字符
 '参数:desstr(目标字符),lpad(填充字符),lenint(填充后的字符总长度)
 '示例:response.write rpad('a',0,5),结果显示a0000
 '编写:杨俊明 2006-2-4 20:17 QQ:278919507 Email:yjmyzz@126.com
 function rpad(desstr,padchar,lenint)
 dim d,p,t
 d = cstr(desstr)
 p = cstr(padchar)
 rpad=""
 for t=1 to lenint-len(d)
 rpad = p & rpad
 next
 rpad = d & rpad
 end function

'003
 '用途:生成指定长度的随机密码
 '参数:passlen(密码的长度),passtype(密码类型,可选值有
 ' passFull,passNumber,passSpecial,passCharNumber,
 ' passChar,passUpperCharNumber,passLowerCharNumber,passUpperChar,passLowerChar)
 '示例:reponse.write makeRndPass(20,"passcharnumber")生成20位由字母和数字组合的密码
 '编写:杨俊明 2006-2-8 12:48 QQ:278919507 Email:yjmyzz@126.com
 'response.write makeRndPass(20,"passcharnumber")
 function MakeRndPass(passlen,passtype)
 dim

passFull,passNumber,passSpecial,passCharNumber,passChar,pass,passUpperCharNumber,passLowerC

harNumber,passUpperChar,passLowerChar,ii,jj
 passFull = "1234567890!@#$%^&*()[];',./{}:?`~-

=\_+|abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
 passNumber = "1234567890"
 passSpecial = "!@#$%^&*()[];',./{}:?`~-=\_+|"
 passCharNumber = "abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 passUpperCharNumber = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 passLowerCharNumber = "abcdefghijklmnopqrstuvwxyz1234567890"
 passChar = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
 passUpperChar = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
 passLowerChar = "abcdefghijklmnopqrstuvwxyz"
 select case lcase(trim(passType))
 case "passfull"
 pass = passFull
 case "passnumber"
 pass = passNumber
 case "passspecial"
 pass = passSpecial
 case "passcharnumber"
 pass = passCharNumber
 case "passchar"
 pass = passChar
 case "passupperchar"
 pass = passUpperChar
 case "passlowerchar"
 pass = passLowerChar
 case "passuppercharnumber"
 pass = passUpperCharNumber
 case "passlowercharnumber"
 pass = passLowerCharNumber
 case else
 pass = passlowercharnumber
 end select
 makeRndPass=""

for ii=1 to cint(passlen)
 randomize
 jj = int(rnd()*len(pass)+1)
 makeRndPass = cstr(makeRndPass) & mid(pass,jj,1)
 next
 end function

'004
 '用途:读取指定的文本文件,返回文件内容
 '参数:filepath(包含路径的文件名,支持虚拟路径),fileContent(文件内容)
 '示例:response.write readfile("/abc.txt")
 '编写:杨俊明 2006-2-8 13:10 QQ:278919507 Email:yjmyzz@126.com
 'response.write readfile("/abc.txt")
 function readFile(filepath)
 readFile = ""
 if instr(filepath,"/") then filepath = server.mappath(filepath)
 Dim t_keyFile, t_fso, t_f ,ts
 set t_fso = Server.CreateObject("Scripting.FileSystemObject")
 if t_fso.fileexists(filepath) then
 set t_f = t_fso.GetFile(filepath)
 set ts = t_f.OpenAsTextStream(1, -2)
 Do While not ts.AtEndOfStream
 readFile = readFile & ts.ReadLine & vbcrlf
 Loop
 ts.close
 end if
 set ts = nothing
 set t_f = nothing
 set t_fso = nothing
 end function

'005
 '用途:将指定内容,写入文本文件
 '参数:filepath(包含路径的文件名,支持虚拟路径),fileContent(文件内容)
 '示例:WriteFile "/abc.txt","abcde" 或WriteFile "c:\abc.txt","abcde"
 '编写:杨俊明 2006-2-8 13:10 QQ:278919507 Email:yjmyzz@126.com
 'WriteFile "/abc.txt","abcde"
 function WriteFile(filepath,fileContent)
 dim t_fso,t_keyFile
 if instr(filepath,"/") then filepath = server.mappath(filepath)
 set t_fso = Server.CreateObject("scripting.FileSystemObject")
 set t_keyFile = t_fso.CreateTextFile(filepath, true)
 t_keyFile.WriteLine(fileContent)
 t_keyFile.Close
 set t_keyfile = nothing
 set t_fso = nothing
 end function

'006
 '用途:删除指定文件
 '参数:filepath(包含路径的文件名,支持虚拟路径),fileContent(文件内容)
 '示例:delFile "/abc.txt"
 '编写:杨俊明 2006-2-8 13:21 QQ:278919507 Email:yjmyzz@126.com
 'delFile "/abc.txt"
 function DelFile(filepath)
 dim t_fso
 if instr(filepath,"/") then filepath = server.mappath(filepath)
 set t_fso = Server.CreateObject("scripting.FileSystemObject")
 if t_fso.fileExists(filepath) then
 t_fso.deletefile(filepath)
 end if
 set t_fso=nothing
 end function
 %>

知识共享许可协议
《ASP函数库3》常伟华 创作。
采用 知识共享 署名-相同方式共享 3.0 中国大陆 许可协议进行许可。
相邻依据:发表时间
  • 多说评论
  • 签名
  • 新浪微博
  • 默认评论
  • Tab Header 5

0 条评论 / 点击此处发表评论

Tab Content 5

开发技术


开发平台和工具

sitemap     157.37ms