西安网站建设asp常用函数

13692015-04-26

西安网站建设asp常用函数

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<%

Function DateToStr(DateTime,ShowType)  '日期转换函数

   Dim DateMonth,DateDay,DateHour,DateMinute

   DateMonth=Month(DateTime)

   DateDay=Day(DateTime)

   DateHour=Hour(DateTime)

   DateMinute=Minute(DateTime)

   If Len(DateMonth)<2 Then DateMonth="0"&DateMonth

   If Len(DateDay)<2 Then DateDay="0"&DateDay

   Select Case ShowType

   Case "Y-m-d"  

       DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay

   Case "Y-m-d H:I A"

       Dim DateAMPM

       If DateHour>12 Then

           DateHour=DateHour-12

           DateAMPM="PM"

       Else

           DateHour=DateHour

           DateAMPM="AM"

       End If

       If Len(DateHour)<2 Then DateHour="0"&DateHour    

       If Len(DateMinute)<2 Then DateMinute="0"&DateMinute

       DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM

   Case "Y-m-d H:I:S"

       Dim DateSecond

       DateSecond=Second(DateTime)

       If Len(DateHour)<2 Then DateHour="0"&DateHour    

       If Len(DateMinute)<2 Then DateMinute="0"&DateMinute

       If Len(DateSecond)<2 Then DateSecond="0"&DateSecond

       DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond

   Case "YmdHIS"

       DateSecond=Second(DateTime)

       If Len(DateHour)<2 Then DateHour="0"&DateHour    

       If Len(DateMinute)<2 Then DateMinute="0"&DateMinute

       If Len(DateSecond)<2 Then DateSecond="0"&DateSecond

       DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond    

   Case "ym"

       DateToStr=Right(Year(DateTime),2)&DateMonth

   Case "d"

       DateToStr=DateDay

   Case Else

       If Len(DateHour)<2 Then DateHour="0"&DateHour

       If Len(DateMinute)<2 Then DateMinute="0"&DateMinute

       DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute

   End Select

End Function

Function Date2Chinese(iDate) '获得ASP的中文日期字符串

    Dim num(10)

    Dim iYear

    Dim iMonth

    Dim iDay

    num(0) = "〇"

    num(1) = "一"

    num(2) = "二"

    num(3) = "三"

    num(4) = "四"

    num(5) = "五"

    num(6) = "六"

    num(7) = "七"

    num(8) = "八"

    num(9) = "九"

    iYear = Year(iDate)

    iMonth = Month(iDate)

    iDay = Day(iDate)

    Date2Chinese = num(iYear \ 1000) + num((iYear \ 100) Mod 10) + num((iYear\ 10) Mod 10) + num(iYear Mod 10) + "年"

    If iMonth >= 10 Then

        If iMonth = 10 Then

            Date2Chinese = Date2Chinese + "十" + "月"

        Else

            Date2Chinese = Date2Chinese + "十" + num(iMonth Mod 10) + "月"

        End If

    Else

        Date2Chinese = Date2Chinese + num(iMonth Mod 10) + "月"

    End If

    If iDay >= 10 Then

        If iDay = 10 Then

            Date2Chinese = Date2Chinese +"十" + "日"

        ElseIf iDay = 20 Or iDay = 30 Then

            Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" + "日"

        ElseIf iDay > 20 Then

            Date2Chinese = Date2Chinese + num(iDay \ 10) + "十" +num(iDay Mod 10) + "日"

        Else

           Date2Chinese = Date2Chinese + "十" + num(iDay Mod 10) + "日"

        End If

    Else

        Date2Chinese = Date2Chinese + num(iDay Mod 10) + "日"

    End If

End Function

Function lenStr(str)'计算字符串长度(字节)

   dim l,t,c

   dim i

   l=len(str)

   t=0

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

   if c>255 then t=t+2

next

  lenstr=t

End Function

Function CreateArr(str) '生成二维数组 数据如:"1,a1,b1,c1,d1|2,a2,b2,c2,d2|5,a3,b3,c3,d3|8,a4,b4,c4,d4"

dim arr()

str=split(str,"|")

for i=0 to UBound(str)

   arrstr=split(str(i),",")

   for j=0 to Ubound(arrstr)

       ReDim Preserve arr(UBound(str),UBound(arrstr))

       arr(i,j)=arrstr(j)

   next

next

CreateArr=arr

End Function

Function ShowRsArr(rsArr) '用表格显示记录集getrows生成的数组的表结构

showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>"

   If Not IsEmpty(rsArr) Then

       For y=0 To Ubound(rsArr,2)

       showHtml=showHtml&"<tr>"

           for x=0 to Ubound(rsArr,1)

               showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>"

           next

       showHtml=showHtml&"</tr>"

       next

   Else

       RshowHtml=showHtml&"<tr>"

       showHtml=showHtml&"<td>No Records</td>"

       showHtml=showHtml&"</tr>"

   End If

       showHtml=showHtml&"</table>"

   ShowRsArr=showHtml

End Function

'---------------------检测网页是否有效-----------------------

Function IsValidUrl(url)

       Set xl = Server.CreateObject("Microsoft.XMLHTTP")

       xl.Open "HEAD",url,False

       xl.Send

       IsValidUrl = (xl.status=200)

End Function

'If IsValidUrl(""&fileurl&"") Then

'    response.redirect fileurl

'Else

'    Response.Write "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"

'End If

'------------------检查某一目录是否存在-------------------

Function getHTMLPage(filename) '获取文件内容

   Dim fso,file

   Set fso = Server.CreateObject("Scripting.FileSystemObject")

   Set File=fso.OpenTextFile(server.mappath(filename))

   showHtml=File.ReadAll

   File.close

   Set File=nothing

   Set fso=nothing

   getHTMLPage=showHtml '输出

End function

Function CheckDir(FolderPath)

   dim fso

   folderpath=Server.MapPath(".")&"\"&folderpath

   Set fso = Server.CreateObject("Scripting.FileSystemObject")

   If fso.FolderExists(FolderPath) then

   '存在

       CheckDir = True

   Else

   '不存在

       CheckDir = False

   End if

   Set fso = nothing

End Function

Function CheckFile(FilePath) '检查某一文件是否存在

   Dim fso

   Filepath=Server.MapPath(FilePath)

   Set fso = Server.CreateObject("Scripting.FileSystemObject")

   If fso.FileExists(FilePath) then

   '存在

       CheckFile = True

   Else

   '不存在

       CheckFile = False

   End if

   Set fso = nothing

End Function

'-------------根据指定名称生成目录---------

Function MakeNewsDir(foldername)

   dim fso,f

   Set fso = Server.CreateObject("Scripting.FileSystemObject")

   Set f = fso.CreateFolder(foldername)

   MakeNewsDir = True

   Set fso = nothing

End Function

Function CreateHTMLPage(filename,FileData,C_mode) '生成文件

   if C_mode=0 then '使用FSO生成

       Dim fso,txt

       Set fso = CreateObject("Scripting.FileSystemObject")

       Filepath=Server.MapPath(filename)

       if CheckFile(filename) then fso.DeleteFile Filepath,True '防止续写

       Set txt=fso.OpenTextFile(Filepath,8,True)  

       txt.Write FileData

       txt.Close

       Set fso = nothing

   elseif C_mode=1 then '使用Stream生成

       Dim viboStream

       On Error Resume Next

       Set viboStream = Server.createObject("ADODB.Stream")

       If Err.Number=-2147221005 Then

           Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"

           Err.Clear

           Response.End

       End If

       With viboStream

       .Type = 2

       .Open

       .CharSet = "GB2312"

       .Position = objStream.Size

       .WriteText = FileData

       .SaveToFile Server.MapPath(filename),2

       .Close

       End With

       Set viboStream = Nothing    

   end if

   Response.Write "<div align='center' style=""font-size:12px;font-family:Tahoma;"">恭喜!文件 <a href="""&filename&""" target=""_blank"" style=""font-weight: bold;color: #FF0000;"">"&filename&"</a> 已经生成完毕!...</div>"

   Response.Flush()

End Function

Function CheckBadWord(byVal ChkStr)'过滤脏字

   Dim Str:Str = ChkStr

   Str = Trim(Str)

   If IsNull(Str) Then

       CheckBadWord = ""

       Exit Function

   End If

   DIC = getHTMLPage("include/badWord.txt")'载入脏字词典

   DICArr = split(DIC,CHR(10))

   For i  =0 To Ubound(DICArr )

       WordDIC = split(DICArr(i),"=")

       Str = Replace(Str,WordDIC(0),WordDIC(1))

   next

   CheckBadWord = Str

End function

%>

通过本文您对西安网站建设有了进一步了解,本公司温馨提醒:找西安做网站公司,请选择手续齐全、业务精、服务好的正规公司。

工商网上亮照

版权所有:西安点墨网络科技有限公司 信息备案编号: 陕ICP备11004160号-1

客户服务电话:15229292610

公司注册地址:西安市雁塔区融鑫路丽湾蓝岛1幢3单元16层31605号

临时办公地址:西安市雁塔区朱雀大街紫郡长安F3

Sitemap 网站地图 手机版

服务热线:15229292610

客服信箱:vip@dianmo.cc

846461336327

版权所有:西安点墨网络科技有限公司 信息备案编号: 陕ICP备11004160号-1