ASP开发中有用的function集合

\'*************************************\'日期转换函数\'*************************************Function DateToStr(DateTime,ShowType)Dim DateMonth,DateDay,DateHour,DateMinute,DateWeek,DateSecondDim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2TimeZone1=\"+0800\"TimeZone2=\"+08:00\"FullWeekday=Array(\"Sunday\",\"Monday\",\"Tuesday\",\"Wednesday\",\"Thursday\",\"Friday\",\"Saturday\")shortWeekday=Array(\"Sun\",\"Mon\",\"Tue\",\"Wed\",\"Thu\",\"Fri\",\"Sat\")Fullmonth=Array(\"January\",\"February\",\"March\",\"April\",\"May\",\"June\",\"July\",\"August\",\"September\",\"October\",\"November\",\"December\")Shortmonth=Array(\"Jan\",\"Feb\",\"Mar\",\"Apr\",\"May\",\"Jun\",\"Jul\",\"Aug\",\"Sep\",\"Oct\",\"Nov\",\"Dec\")DateMonth=Month(DateTime)DateDay=Day(DateTime)DateHour=Hour(DateTime)DateMinute=Minute(DateTime)DateWeek=weekday(DateTime)DateSecond=Second(DateTime)If Len(DateMonth)<2 Then DateMonth=\"0\"&DateMonthIf Len(DateDay)<2 Then DateDay=\"0\"&DateDayIf Len(DateMinute)<2 Then DateMinute=\"0\"&DateMinuteSelect Case ShowTypeCase \"Y-m-d\"DateToStr=Year(DateTime)\"-\"&DateMonth\"-\"&DateDayCase \"Y-m-d H:I A\"Dim DateAMPMIf DateHour>12 ThenDateHour=DateHour-12DateAMPM=\"PM\"ElseDateHour=DateHourDateAMPM=\"AM\"End IfIf Len(DateHour)<2 Then DateHour=\"0\"&DateHourDateToStr=Year(DateTime)\"-\"&DateMonth\"-\"&DateDay\" \"&DateHour\":\"&DateMinute\" \"&DateAMPMCase \"Y-m-d H:I:S\"If Len(DateHour)<2 Then DateHour=\"0\"&DateHourIf Len(DateSecond)<2 Then DateSecond=\"0\"&DateSecondDateToStr=Year(DateTime)\"-\"&DateMonth\"-\"&DateDay\" \"&DateHour\":\"&DateMinute\":\"&DateSecondCase \"YmdHIS\"DateSecond=Second(DateTime)If Len(DateHour)<2 Then DateHour=\"0\"&DateHourIf Len(DateSecond)<2 Then DateSecond=\"0\"&DateSecondDateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecondCase \"ym\"DateToStr=Right(Year(DateTime),2)&DateMonthCase \"d\"DateToStr=DateDayCase \"ymd\"DateToStr=Right(Year(DateTime),4)&DateMonth&DateDayCase \"mdy\"Dim DayEndselect Case DateDayCase 1DayEnd=\"st\"Case 2DayEnd=\"nd\"Case 3DayEnd=\"rd\"Case ElseDayEnd=\"th\"End SelectDateToStr=Fullmonth(DateMonth-1)\" \"&DateDay&DayEnd\" \"&Right(Year(DateTime),4)Case \"w,d m y H:I:S\"DateSecond=Second(DateTime)If Len(DateHour)<2 Then DateHour=\"0\"&DateHourIf Len(DateSecond)<2 Then DateSecond=\"0\"&DateSecondDateToStr=shortWeekday(DateWeek-1)\",\"&DateDay\" \"& Left(Fullmonth(DateMonth-1),3) \" \"&Right(Year(DateTime),4)\" \"&DateHour\":\"&DateMinute\":\"&DateSecond\" \"&TimeZone1Case \"y-m-dTH:I:S\"If Len(DateHour)<2 Then DateHour=\"0\"&DateHourIf Len(DateSecond)<2 Then DateSecond=\"0\"&DateSecondDateToStr=Year(DateTime)\"-\"&DateMonth\"-\"&DateDay\"T\"&DateHour\":\"&DateMinute\":\"&DateSecond&TimeZone2Case ElseIf Len(DateHour)<2 Then DateHour=\"0\"&DateHourDateToStr=Year(DateTime)\"-\"&DateMonth\"-\"&DateDay\" \"&DateHour\":\"&DateMinuteEnd SelectEnd Function\'*************************************\'分页函数\'*************************************dim FirstShortCut,ShortCutFirstShortCut=falseFunction MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)CurPage=Int(Curpage)Numbers=Int(Numbers)Dim URLURL=Request.ServerVariables(\"Script_Name\")&Url_AddMultiPage=\"\"Dim Page,Offset,PageI\'   If Int(Numbers)>Int(PerPage) ThenPage=9Offset=4Dim Pages,FromPage,ToPageIf Numbers Mod Cint(Perpage)=0 ThenPages=Int(Numbers/Perpage)ElsePages=Int(Numbers/Perpage)+1End IfFromPage=Curpage-OffsetToPage=Curpage+Page-Offset-1If Page>Pages ThenFromPage=1ToPage=PagesElseIf FromPage<1 ThenTopage=Curpage+1-FromPageFromPage=1If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then ToPage=PageElseIF Topage>Pages ThenFromPage =Curpage-Pages +ToPageToPage=PagesIf (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1End IfEnd IfMultiPage=\"<div class=\"\"page\"\" style=\"\"\"&Style\"\"\"><ul>\"\'if Curpage<>1 then MultiPage=MultiPage&\"<li class=\"\"PageL\"\"><a href=\"\"\"&Url&\"page=1\"\" class=\"\"PageLbutton\"\" title=\"\"第一页\"\"></a></li>\"MultiPage=MultiPage\"<li class=\"\"pageNumber\"\">\"if Curpage<>1 then MultiPage=MultiPage\"<a href=\"\"\"&Url\"page=1\"\" title=\"\"第一页\"\" style=\"\"text-decoration:none\"\"><</a> | \"if not FirstShortCut then ShortCut=\" accesskey=\"\",\"\"\" else ShortCut=\"\"if Curpage<>1 then MultiPage=MultiPage\"<a href=\"\"\"&Url\"page=\"&CurPage-1\"\"\" title=\"\"上一页\"\" style=\"\"text-decoration:none;\"\"\"&ShortCut\"></a>\"For PageI=FromPage TO ToPageIf PageI<>CurPage ThenMultiPage=MultiPage\"<a href=\"\"\"&Url\"page=\"&PageI&aname\"\"\">\"&PageI\"</a> | \"ElseMultiPage=MultiPage\"<strong>\"&PageI\"</strong>\"if PageI<>Pages then MultiPage=MultiPage\" | \"End IfNextif not FirstShortCut then ShortCut=\" accesskey=\"\".\"\"\" else ShortCut=\"\"if Curpage<>pages then MultiPage=MultiPage\"<a href=\"\"\"&Url\"page=\"&CurPage+1\"\"\" title=\"\"下一页\"\" style=\"\"text-decoration:none\"\"\"&ShortCut\"></a>\"if Curpage<>pages then MultiPage=MultiPage\"<a href=\"\"\"&Url\"page=\"&Pages&aname\"\"\" title=\"\"最后一页\"\" style=\"\"text-decoration:none\"\">></a>\"MultiPage=MultiPage\"</li>\"\'If Int(Pages)>Int(Page) Then\'   MultiPage=MultiPage&\"<li>...</li><li><a href=\"\"\"&Url&\"page=\"&Pages&aname&\"\"\">\"&pages&\"</a></li>\"\'End If\'if Curpage<>pages then MultiPage=MultiPage&\"<li class=\"\"PageR\"\"><a href=\"\"\"&Url&\"page=\"&Pages&aname&\"\"\" class=\"\"PageRbutton\"\" title=\"\"最后一页\"\"></a></li>\"MultiPage=MultiPage\"</ul></div>\"\'   End IfFirstShortCut=trueEnd Function\'*************************************\'切割内容 - 按行分割\'*************************************Function SplitLines(byVal Content,byVal ContentNums)Dim ts,i,lContentNums=int(ContentNums)If IsNull(Content) Then Exit Functioni=1ts = 0For i=1 to Len(Content)l=Lcase(Mid(Content,i,5))If l=\"<br/>\" Thents=ts+1End Ifl=Lcase(Mid(Content,i,4))If l=\"<br>\" Thents=ts+1End Ifl=Lcase(Mid(Content,i,3))If l=\"<p>\" Thents=ts+1End IfIf ts>ContentNums Then Exit ForNextIf ts>ContentNums ThenContent=Left(Content,i-1)End IfSplitLines=ContentEnd Function\'*************************************\'切割内容 - 按字符分割\'*************************************Function CutStr(byVal Str,byVal StrLen)Dim l,t,c,iIf IsNull(Str) Then CutStr=\"\":Exit Functionl=Len(str)StrLen=int(StrLen)t=0For i=1 To lc=Asc(Mid(str,i,1))If c<0 Or c>255 Then t=t+2 Else t=t+1IF t>=StrLen ThenCutStr=left(Str,i)\"...\"Exit ForElseCutStr=StrEnd IfNextEnd Function\'*************************************\'删除引用标签\'*************************************Function DelQuote(strContent)If IsNull(strContent) Then Exit FunctionDim reSet re=new RegExpre.IgnoreCase =Truere.Global=Truere.Pattern=\"/[quote/](.[^/]]*?)/[//quote/]\"strContent= re.Replace(strContent,\"\")re.Pattern=\"/[quote=(.[^/]]*)/](.[^/]]*?)/[//quote/]\"strContent= re.Replace(strContent,\"\")Set re=NothingDelQuote=strContentEnd Function\'*************************************\'获取客户端IP\'*************************************function getIP()dim strIP,IP_Ary,strIP_liststrIP_list=Replace(Request.ServerVariables(\"HTTP_X_FORWARDED_FOR\"),\"\'\",\"\")If InStr(strIP_list,\",\")<>0 ThenIP_Ary = Split(strIP_list,\",\")strIP = IP_Ary(0)ElsestrIP = strIP_listEnd IFIf strIP=Empty Then strIP=Replace(Request.ServerVariables(\"REMOTE_ADDR\"),\"\'\",\"\")getIP=strIPEnd Function\'*************************************\'获取客户端浏览器信息\'*************************************function getBrowser(strUA)dim arrInfo,strType,temp1,temp2strType=\"\"strUA=LCase(strUA)arrInfo=Array(\"Unkown\",\"Unkown\")\'浏览器判断if Instr(strUA,\"mozilla\")>0 then arrInfo(0)=\"Mozilla\"if Instr(strUA,\"icab\")>0 then arrInfo(0)=\"iCab\"if Instr(strUA,\"lynx\")>0 then arrInfo(0)=\"Lynx\"if Instr(strUA,\"links\")>0 then arrInfo(0)=\"Links\"if Instr(strUA,\"elinks\")>0 then arrInfo(0)=\"ELinks\"if Instr(strUA,\"jbrowser\")>0 then arrInfo(0)=\"JBrowser\"if Instr(strUA,\"konqueror\")>0 then arrInfo(0)=\"konqueror\"if Instr(strUA,\"wget\")>0 then arrInfo(0)=\"wget\"if Instr(strUA,\"ask jeeves\")>0 or Instr(strUA,\"teoma\")>0 then arrInfo(0)=\"Ask Jeeves/Teoma\"if Instr(strUA,\"wget\")>0 then arrInfo(0)=\"wget\"if Instr(strUA,\"opera\")>0 then arrInfo(0)=\"opera\"if Instr(strUA,\"gecko\")>0 thenstrType=\"[Gecko]\"arrInfo(0)=\"Mozilla\"if Instr(strUA,\"aol\")>0 then arrInfo(0)=\"AOL\"if Instr(strUA,\"netscape\")>0 then arrInfo(0)=\"Netscape\"if Instr(strUA,\"firefox\")>0 then arrInfo(0)=\"FireFox\"if Instr(strUA,\"chimera\")>0 then arrInfo(0)=\"Chimera\"if Instr(strUA,\"camino\")>0 then arrInfo(0)=\"Camino\"if Instr(strUA,\"galeon\")>0 then arrInfo(0)=\"Galeon\"if Instr(strUA,\"k-meleon\")>0 then arrInfo(0)=\"K-Meleon\"arrInfo(0)=arrInfo(0)+strTypeend ifif Instr(strUA,\"bot\")>0 or Instr(strUA,\"crawl\")>0 thenstrType=\"[Bot/Crawler]\"arrInfo(0)=\"\"if Instr(strUA,\"grub\")>0 then arrInfo(0)=\"Grub\"if Instr(strUA,\"googlebot\")>0 then arrInfo(0)=\"GoogleBot\"if Instr(strUA,\"msnbot\")>0 then arrInfo(0)=\"MSN Bot\"if Instr(strUA,\"slurp\")>0 then arrInfo(0)=\"Yahoo! Slurp\"arrInfo(0)=arrInfo(0)+strTypeend ifif Instr(strUA,\"applewebkit\")>0 thenstrType=\"[AppleWebKit]\"arrInfo(0)=\"\"if Instr(strUA,\"omniweb\")>0 then arrInfo(0)=\"OmniWeb\"if Instr(strUA,\"safari\")>0 then arrInfo(0)=\"Safari\"arrInfo(0)=arrInfo(0)+strTypeend ifif Instr(strUA,\"msie\")>0 thenstrType=\"[MSIE\"temp1=mid(strUA,(Instr(strUA,\"msie\")+4),6)temp2=Instr(temp1,\";\")temp1=left(temp1,temp2-1)strType=strType & temp1 \"]\"arrInfo(0)=\"Internet Explorer\"if Instr(strUA,\"msn\")>0 then arrInfo(0)=\"MSN\"if Instr(strUA,\"aol\")>0 then arrInfo(0)=\"AOL\"if Instr(strUA,\"webtv\")>0 then arrInfo(0)=\"WebTV\"if Instr(strUA,\"myie2\")>0 then arrInfo(0)=\"MyIE2\"if Instr(strUA,\"maxthon\")>0 then arrInfo(0)=\"Maxthon\"if Instr(strUA,\"gosurf\")>0 then arrInfo(0)=\"GoSurf\"if Instr(strUA,\"netcaptor\")>0 then arrInfo(0)=\"NetCaptor\"if Instr(strUA,\"sleipnir\")>0 then arrInfo(0)=\"Sleipnir\"if Instr(strUA,\"avant browser\")>0 then arrInfo(0)=\"AvantBrowser\"if Instr(strUA,\"greenbrowser\")>0 then arrInfo(0)=\"GreenBrowser\"if Instr(strUA,\"slimbrowser\")>0 then arrInfo(0)=\"SlimBrowser\"arrInfo(0)=arrInfo(0)+strTypeend if\'操作系统判断if Instr(strUA,\"windows\")>0 then arrInfo(1)=\"Windows\"if Instr(strUA,\"windows ce\")>0 then arrInfo(1)=\"Windows CE\"if Instr(strUA,\"windows 95\")>0 then arrInfo(1)=\"Windows 95\"if Instr(strUA,\"win98\")>0 then arrInfo(1)=\"Windows 98\"if Instr(strUA,\"windows 98\")>0 then arrInfo(1)=\"Windows 98\"if Instr(strUA,\"windows 2000\")>0 then arrInfo(1)=\"Windows 2000\"if Instr(strUA,\"windows xp\")>0 then arrInfo(1)=\"Windows XP\"if Instr(strUA,\"windows nt\")>0 thenarrInfo(1)=\"Windows NT\"if Instr(strUA,\"windows nt 5.0\")>0 then arrInfo(1)=\"Windows 2000\"if Instr(strUA,\"windows nt 5.1\")>0 then arrInfo(1)=\"Windows XP\"if Instr(strUA,\"windows nt 5.2\")>0 then arrInfo(1)=\"Windows 2003\"end ifif Instr(strUA,\"x11\")>0 or Instr(strUA,\"unix\")>0 then arrInfo(1)=\"Unix\"if Instr(strUA,\"sunos\")>0 or Instr(strUA,\"sun os\")>0 then arrInfo(1)=\"SUN OS\"if Instr(strUA,\"powerpc\")>0 or Instr(strUA,\"ppc\")>0 then arrInfo(1)=\"PowerPC\"if Instr(strUA,\"macintosh\")>0 then arrInfo(1)=\"Mac\"if Instr(strUA,\"mac osx\")>0 then arrInfo(1)=\"MacOSX\"if Instr(strUA,\"freebsd\")>0 then arrInfo(1)=\"FreeBSD\"if Instr(strUA,\"linux\")>0 then arrInfo(1)=\"Linux\"if Instr(strUA,\"palmsource\")>0 or Instr(strUA,\"palmos\")>0 then arrInfo(1)=\"PalmOS\"if Instr(strUA,\"wap \")>0 then arrInfo(1)=\"WAP\"\'arrInfo(0)=strUAgetBrowser=arrInfoend function\'*************************************\'计算随机数\'*************************************function randomStr(intLength)dim strSeed,seedLength,pos,str,istrSeed = \"abcdefghijklmnopqrstuvwxyz1234567890\"seedLength=len(strSeed)str=\"\"Randomizefor i=1 to intLengthstr=str+mid(strSeed,int(seedLength*rnd)+1,1)nextrandomStr=strend function\'*************************************\'自动闭合UBB\'*************************************function closeUBB(strContent)dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,MatchSet re=new RegExpre.IgnoreCase =Truere.Global=TruearrTags=array(\"code\",\"quote\",\"list\",\"color\",\"align\",\"font\",\"size\",\"b\",\"i\",\"u\",\"html\")for i=0 to ubound(arrTags)OpenPos=0ClosePos=0re.Pattern=\"/[\"+arrTags(i)+\"(=[^/[/]]+|)/]\"Set strMatchs=re.Execute(strContent)For Each Match in strMatchsOpenPos=OpenPos+1nextre.Pattern=\"/[/\"+arrTags(i)+\"/]\"Set strMatchs=re.Execute(strContent)For Each Match in strMatchsClosePos=ClosePos+1nextfor j=1 to OpenPos-ClosePosstrContent=strContent+\"[/\"+arrTags(i)+\"]\"nextnextcloseUBB=strContentend function\'*************************************\'自动闭合HTML\'*************************************function closeHTML(strContent)dim arrTags,i,OpenPos,ClosePos,re,strMatchs,j,MatchSet re=new RegExpre.IgnoreCase =Truere.Global=TruearrTags=array(\"p\",\"div\",\"span\",\"table\",\"ul\",\"font\",\"b\",\"u\",\"i\",\"h1\",\"h2\",\"h3\",\"h4\",\"h5\",\"h6\")for i=0 to ubound(arrTags)OpenPos=0ClosePos=0re.Pattern=\"/<\"+arrTags(i)+\"( [^/</>]+|)/>\"Set strMatchs=re.Execute(strContent)For Each Match in strMatchsOpenPos=OpenPos+1nextre.Pattern=\"/</\"+arrTags(i)+\"/>\"Set strMatchs=re.Execute(strContent)For Each Match in strMatchsClosePos=ClosePos+1nextfor j=1 to OpenPos-ClosePosstrContent=strContent+\"</\"+arrTags(i)+\">\"nextnextcloseHTML=strContentend function\'*************************************\'读取文件\'*************************************Function LoadFromFile(ByVal File)Dim objStreamDim RTextRText=array(0,\"\")On Error Resume NextSet objStream = Server.CreateObject(\"ADODB.Stream\")If Err ThenRText=array(Err.Number,Err.Description)LoadFromFile=RTextErr.Clearexit functionEnd IfWith objStream.Type = 2.Mode = 3.Open.Charset = \"utf-8\".Position = objStream.Size.LoadFromFile Server.MapPath(File)If Err.Number<>0 ThenRText=array(Err.Number,Err.Description)LoadFromFile=RTextErr.Clearexit functionEnd IfRText=array(0,.ReadText).CloseEnd WithLoadFromFile=RTextSet objStream = NothingEnd Function\'*************************************\'保存文件\'*************************************Function SaveToFile(ByVal strBody,ByVal File)Dim objStreamDim RTextRText=array(0,\"\")On Error Resume NextSet objStream = Server.CreateObject(\"ADODB.Stream\")If Err ThenRText=array(Err.Number,Err.Description)Err.Clearexit functionEnd IfWith objStream.Type = 2.Open.Charset = \"utf-8\".Position = objStream.Size.WriteText = strBody.SaveToFile Server.MapPath(File),2.CloseEnd WithRText=array(0,\"保存文件成功!\")SaveToFile=RTextSet objStream = NothingEnd Function\'*************************************\'数据库添加修改操作\'*************************************function DBQuest(table,DBArray,Action)dim AddCount,TempDB,i,vif Action<>\"insert\" or Action<>\"update\" then Action=\"insert\"if Action=\"insert\" then v=2 else v=3if not IsArray(DBArray) thenDBQuest=-1exit functionelseSet TempDB=Server.CreateObject(\"ADODB.RecordSet\")On Error Resume NextTempDB.Open table,Conn,1,vif err thenDBQuest=-2exit functionend ifif Action=\"insert\" then TempDB.addNewAddCount=UBound(DBArray,1)for i=0 to AddCountTempDB(DBArray(i)(0))=DBArray(i)(1)nextTempDB.updateTempDB.closeset TempDB=nothingDBQuest=0end ifend Function

• 点赞
• 收藏
• 分享
• 文章举报

emuming发布了0 篇原创文章 · 获赞 0 · 访问量 1838私信关注