ASP自定义函数收集专帖(非函数谢绝回复)

代码:

'----------------------------------------------------------------'
'功能描述： 用正则除去HTML标记
'输入参数： fString : 待处理的字符串
'返回值： String : 已处理的字符串
Function RemoveHTMLTag(ObjReg,fString)
 ObjReg.Pattern = "<[^>]+>|</[^>]+>"
 fString = ObjReg.Replace(fString,"")
 RemoveHTMLTag = fString
End Function 
'----------------------------------------------------------------'

 

代码:

'----------------------------------------------------------------'
'功能描述：URL编码函数
'输入参数：v中英文混合字符串，f是否对ASCII字符编码
'返回值：编码后的ASC字符串
Public Function URLEncoding(v,f)
Dim s,t,i,j,h,l,x : s = "" : x=Len(v)
For i = 1 To x
t = Mid(v,i,1) : j = Asc(t)
If j> 0 Then
If f Then
s = s & "%" & Right("00" & Hex(Asc(t)),2)
Else
s = s & t
End If
Else
If j < 0 Then j = j + &H10000
h = (j And &HFF00) \ &HFF
l = j And &HFF
s = s & "%" & Hex(h) & "%" & Hex(l)
End If
Next
URLEncoding = s
End Function
'----------------------------------------------------------------'

代码:

'功能描述：URL解码码函数
'输入参数：vURL编码的字符串
'返回值：解码后的字符串
Public Function URLDecoding(sIn)
Dim s,i,l,c,t,n : s="" : l=Len(sIn)
For i=1 To l
c=Mid(sIn,i,1)
If c<>"%" Then
s = s & c
Else
c=Mid(sIn,i+1,2) : i=i+2 : t=CInt("&H" & c)
If t<&H80 Then
s=s & Chr(t)
Else
c=Mid(sIn,i+1,3)
If Left(c,1)<>"%" Then
URLDecoding=s
Exit Function
Else
c=Right(c,2) : n=CInt("&H" & c)
t=t*256+n-65536
s = s & Chr(t) : i=i+3
End If
End If
End If
Next
URLDecoding=s
End Function
'----------------------------------------------------------------'

 

PHP:

<%@ Language=VBScript %>
<%
    function bianli(path)
        dim fso            'fso对象
        dim objFolder      '文件夹对象
        dim objSubFolders  '子文件夹集合
        dim objSubFolder   '子文件夹对象
        dim objFiles       '文件集合
        dim objFile        '文件对象

        set fso=server.CreateObject("scripting.filesystemobject")    
        on error resume next
        set objFolder=fso.GetFolder(path)'创建文件夹对象
        set objSubFolders=objFolder.Subfolders'创建的子文件夹对象
        for each objSubFolder in objSubFolders
            nowpath=path + "\\" + objSubFolder.name
            Response.Write nowpath
            set objFiles=objSubFolder.Files
            for each objFile in objFiles
                Response.Write "<br>---"
                Response.Write objFile.name
            next
            Response.Write "<p>"
            bianli(nowpath)    '调用递归
        next
        set objFolder=nothing
        set objSubFolders=nothing
        set fso=nothing
    end function
%>
<%
    bianli("F:\") '调用bianli()函数,这里是遍历F:盘
%>

 

PHP:

<%
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\
'\\    来自 codeproject.com
'\\    计算js和asp代码
'\\    修改 bluedestiny
'\\    mail:bluedestiny at 126.com
'\\
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 
 

option explicit
response.buffer=false 
 

class COUNT_CODE
private fso,spath
private asplines, jslines, aspbytes, jsbytes, aspwords
private sub class_initialize
  set fso = createobject("scripting.filesystemobject") 
end sub
private sub class_terminate
  set fso=nothing
end sub
private function iterate(path)
  dim folder, folders, files, file, ts, txt, arr, f
  set folder = fso.getfolder(path)
  set files = folder.files
  dim rx, c
  set rx = new regexp
  rx.ignorecase = true
  rx.global = true
  rx.pattern = "  +"
  for each file in files
   if right(file.name,4)=".asp" or right(file.name,3)=".js" then
    set ts = file.openastextstream
    if ts.atendofstream then txt = "" else txt = ts.readall
    ts.close
    txt = rx.replace(txt," ")
    txt = replace(txt,vbcrlf&vbcrlf,vbcrlf)
    arr = split(replace(txt,vbcrlf," ")," ")
    aspwords = aspwords + ubound(arr)
    arr = split(txt,vbcrlf)
    if right(file.name,4)=".asp" then
     asplines = asplines + ubound(arr)
     aspbytes = aspbytes + len(txt)
    else
     jslines = jslines + ubound(arr)
     jsbytes = jsbytes + len(txt)
    end if
   end if
  next
  set folders = folder.subfolders
  for each f in folders
   iterate f.path
  next
end function 
 

public property let path(s)
  spath=server.mappath(s)
end property
public sub count
  iterate(spath)
end sub
public sub printf
  response.write "ASP:" & "<br/>"
  response.write "Total Lines Coded: " & asplines & "<br/>"
  response.write "Total Bytes: " & aspbytes & "" & "<br/>"
  response.write "Total Individual Elements (words) Typed: " & aspwords & "<br/>"
  response.write "JScript:" & "<br/>"
  response.write "Total Lines Coded: " & jslines & "<br/>"
  response.write "Total Bytes: " & jsbytes
end sub
end class 
 

'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'\\示例代码
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ 
 

dim o
set o=new COUNT_CODE
o.path="bluedestiny/"
o.count
o.printf
%>

 

PHP:

字符截取函数：

'************************
'函数名：字符截取函数
'strlen：测试字符串长度
'功能：返回字符串长度
'参数：
'str 要测试的字符串
'************************

function strlen(str)
 dim p_len,xx
 p_len=0
 strlen=0
 if trim(str)<>"" then
  p_len=len(trim(str))
  for xx=1 to p_len
   if asc(mid(str,xx,1))<0 then
    strlen=int(strlen) + 2
   else
    strlen=int(strlen) + 1
   end if
  next
 end if
end function

function strvalue(str,lennum)
 dim p_num,x,i
 if strlen(str)<=lennum then
  strvalue=str
 else
  p_num=0
  x=0
  do while not p_num > lennum-2
   x=x+1
   if asc(mid(str,x,1))<0 then
    p_num=int(p_num) + 2
   else
    p_num=int(p_num) + 1
   end if
   strvalue=left(trim(str),x)&"..."
  loop
 end if
end function

'*************************

 

1.使用FSO修改文件特定内容的函数
以下是引用片段：

PHP:

function FSOchange(filename,Target,String) 
    Dim objFSO,objCountFile,FiletempData 
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
    Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True) 
    FiletempData = objCountFile.ReadAll 
    objCountFile.Close 
    FiletempData=Replace(FiletempData,Target,String) 
    Set objCountFile=objFSO.CreateTextFile(Server.MapPath(filename),True) 
    objCountFile.Write FiletempData  
    objCountFile.Close 
    Set objCountFile=Nothing 
    Set objFSO = Nothing 
End Function

2.使用FSO读取文件内容的函数
以下是引用片段：

PHP:

function FSOFileRead(filename) 
    Dim objFSO,objCountFile,FiletempData 
    Set objFSO = Server.CreateObject("Scripting.FileSystemObject") 
    Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True) 
    FSOFileRead = objCountFile.ReadAll 
    objCountFile.Close 
    Set objCountFile=Nothing 
    Set objFSO = Nothing 
End Function 

3.使用FSO读取文件某一行的函数
以下是引用片段：

PHP:

function FSOlinedit(filename,lineNum) 
    if linenum < 1 then exit function 
    dim fso,f,temparray,tempcnt 
    set fso = server.CreateObject("scripting.filesystemobject") 
    if not fso.fileExists(server.mappath(filename)) then exit function 
    set f = fso.opentextfile(server.mappath(filename),1) 
    if not f.AtEndofStream then 
    tempcnt = f.readall 
    f.close 
    set f = nothing 
    temparray = split(tempcnt,chr(13)&chr(10)) 
    if lineNum>ubound(temparray)+1 then 
    exit function 
    else 
    FSOlinedit = temparray(lineNum-1) 
    end if 
    end if 
end function 

4.使用FSO写文件某一行的函数
以下是引用片段：

PHP:

function FSOlinewrite(filename,lineNum,Linecontent) 
    if linenum < 1 then exit function 
    dim fso,f,temparray,tempCnt 
    set fso = server.CreateObject("scripting.filesystemobject") 
    if not fso.fileExists(server.mappath(filename)) then exit function 
    set f = fso.opentextfile(server.mappath(filename),1) 
    if not f.AtEndofStream then 
    tempcnt = f.readall 
    f.close 
    temparray = split(tempcnt,chr(13)&chr(10)) 
    if lineNum>ubound(temparray)+1 then 
    exit function 
    else 
    temparray(lineNum-1) = lineContent 
    end if 
    tempcnt = join(temparray,chr(13)&chr(10)) 
    set f = fso.createtextfile(server.mappath(filename),true) 
    f.write tempcnt 
    end if 
    f.close 
    set f = nothing 
end function 

5.使用FSO添加文件新行的函数
以下是引用片段：

PHP:

function FSOappline(filename,Linecontent) 
    dim fso,f 
    set fso = server.CreateObject("scripting.filesystemobject") 
    if not fso.fileExists(server.mappath(filename)) then exit function 
    set f = fso.opentextfile(server.mappath(filename),8,1) 
    f.write chr(13)&chr(10)&Linecontent 
    f.close 
    set f = nothing 
end function 

 

Array() ：

　　FUNCTION: 返回一个数组
　　SYNTAX: Array(list)
　　ARGUMENTS: 字符，数字均可
　　EXAMPLE:
<%
　　Dim myArray()
　　For i = 1 to 7
　　Redim Preserve myArray(i)
　　myArray(i) = WeekdayName(i)
　　Next
　　%>
　　RESULT: 建立了一个包含7个元素的数组myArray
　　myArray("Sunday","Monday", ... ... "Saturday")

CInt() ：

　　FUNCTION: 将一个表达式转化为数字类型
　　SYNTAX: CInt(expression)
　　ARGUMENTS: 任何有效的字符均可
　　EXAMPLE:
<%
　　f = "234"
　　response.write cINT(f) + 2
　　%>
　　RESULT: 236
　　转化字符"234"为数字"234"，如果字符串为空，则返回0值

以CreateObject()：

　　FUNCTION: 建立和返回一个已注册的ACTIVEX组件的实例。
　　SYNTAX: CreateObject(objName)
　　ARGUMENTS: objName 是任何一个有效、已注册的ACTIVEX组件的名字.
　　EXAMPLE:
<%
　　Set con = Server.CreateObject("ADODB.Connection")
　　%>
　　RESULT:

CStr()：

　　FUNCTION: 转化一个表达式为字符串.
　　SYNTAX: CStr(expression)
　　ARGUMENTS: expression 是任何有效的表达式。
　　EXAMPLE:
<%
　　s = 3 + 2
　　response.write "The result is: " & cStr(s)
　　%>
　　RESULT: 转化数字“5”为字符“5”。

Date()：

　　FUNCTION: 返回当前系统日期.
　　SYNTAX: Date()
　　ARGUMENTS: None.
　　EXAMPLE: <%=Date%>
　　RESULT: 8/4/99

DateAdd() ：

　　FUNCTION: 返回一个被改变了的日期。
　　SYNTAX: DateAdd(timeinterval,number,date)
　　ARGUMENTS: timeinterval is the time interval to add; number is amount of time intervals to add; and date is the starting date.
　　EXAMPLE:
<%
　　currentDate = #8/4/99#
　　newDate = DateAdd("m",3,currentDate)
　　response.write newDate
　　%>

　　<%
　　currentDate = #12:34:45 PM#
　　newDate = DateAdd("h",3,currentDate)
　　response.write newDate
　　%>
　　RESULT: 11/4/99
　　3:34:45 PM

　　"m" = "month";
　　"d" = "day";

　　If currentDate is in time format then,
　　"h" = "hour";
　　"s" = "second";

DateDiff()：

　　FUNCTION: 返回两个日期之间的差值 。
　　SYNTAX: DateDiff(timeinterval,date1,date2 [, firstdayofweek [, firstweekofyear>>)
　　ARGUMENTS: timeinterval 表示相隔时间的类型，如“M“表示“月”。
　　EXAMPLE:
<%
　　fromDate = #8/4/99#
　　toDate = #1/1/2000#
　　response.write "There are " & _
　　DateDiff("d",fromDate,toDate) & _
　　" days to millenium from 8/4/99."
　　%>
　　RESULT: 从8/4/99 到2000年还有 150 天.

Day()：

　　FUNCTION: 返回一个月的第几日 .
　　SYNTAX: Day(date)
　　ARGUMENTS: date 是任何有效的日期。
　　EXAMPLE: <%=Day(#8/4/99#)%>
　　RESULT: 4

FormatCurrency() ：

　　FUNCTION: 返回表达式，此表达式已被格式化为货币值
　　SYNTAX: FormatCurrency(Expression [, Digit [, LeadingDigit [, Paren [, GroupDigit>>>>)
　　ARGUMENTS: Digit 指示小数点右侧显示位数的数值。默认值为 -1，指示使用的是计算机的区域设置; 　　LeadingDigit 三态常数，指示是否显示小数值小数点前面的零。
　　EXAMPLE: <%=FormatCurrency(34.3456)%>
　　RESULT: $34.35

FormatDateTime()：

　　FUNCTION: 返回表达式，此表达式已被格式化为日期或时间
　　SYNTAX: FormatDateTime(Date, [, NamedFormat>)
　　ARGUMENTS: NamedFormat 指示所使用的日期/时间格式的数值，如果省略，则使用 vbGeneralDate.
　　EXAMPLE: <%=FormatDateTime("08/4/99", vbLongDate)%>
　　RESULT: Wednesday, August 04, 1999

FormatNumber()：

　　FUNCTION: 返回表达式，此表达式已被格式化为数值.
　　SYNTAX: FormatNumber(Expression [, Digit [, LeadingDigit [, Paren [, GroupDigit>>>>)
　　ARGUMENTS: Digit 指示小数点右侧显示位数的数值。默认值为 -1，指示使用的是计算机的区域设置。; LeadingDigit i指示小数点右侧显示位数的数值。默认值为 -1，指示使用的是计算机的区域设置。; Paren 指示小数点右侧显示位数的数值。默认值为 -1，指示使用的是计算机的区域设置。; GroupDigit i指示小数点右侧显示位数的数值。默认值为 -1，指示使用的是计算机的区域设置。.
　　EXAMPLE: <%=FormatNumber(45.324567, 3)%>
　　RESULT: 45.325

FormatPercent()：

　　FUNCTION: 返回表达式，此表达式已被格式化为尾随有 % 符号的百分比（乘以 100 ）。 (%)
　　SYNTAX: FormatPercent(Expression [, Digit [, LeadingDigit [, Paren [, GroupDigit>>>>)
　　ARGUMENTS: 同上.
　　EXAMPLE: <%=FormatPercent(0.45267, 3)%>
　　RESULT: 45.267%

Hour()：

　　FUNCTION: 以24时返回小时数.
　　SYNTAX: Hour(time)
　　ARGUMENTS:
　　EXAMPLE: <%=Hour(#4:45:34 PM#)%>
　　RESULT: 16
　　(Hour has been converted to 24-hour system)

Instr()：

　　FUNCTION: 返回字符或字符串在另一个字符串中第一次出现的位置.
　　SYNTAX: Instr([start, > strToBeSearched, strSearchFor [, compare>)
　　ARGUMENTS: Start为搜索的起始值，strToBeSearched接受搜索的字符串 strSearchFor要搜索的字符compare 比较方式（详细见ASP常数）
　　EXAMPLE:
<%
　　strText = "This is a test!!"
　　pos = Instr(strText, "a")
　　response.write pos
　　%>
　　RESULT: 9

InstrRev()：

　　FUNCTION: 同上，只是从字符串的最后一个搜索起
　　SYNTAX: InstrRev([start, > strToBeSearched, strSearchFor [, compare>)
　　ARGUMENTS: 同上.
　　EXAMPLE:
<%
　　strText = "This is a test!!"
　　pos = InstrRev(strText, "s")
　　response.write pos
　　%>
　　RESULT: 13

Int()：

　　FUNCTION: 返回数值类型,不四舍五入。
　　SYNTAX: Int(number)
　　ARGUMENTS:
　　EXAMPLE: <%=INT(32.89)%>
　　RESULT: 32

IsArray()：

　　FUNCTION: 判断一对象是否为数组，返回布尔值 .
　　SYNTAX: IsArray(name)
　　ARGUMENTS:
　　EXAMPLE:
<%
　　strTest = "Test!"
　　response.write IsArray(strTest)
　　%>
　　RESULT: False

IsDate()：

　　FUNCTION: 判断一对象是否为日期，返回布尔值
　　SYNTAX: IsDate(expression)
　　ARGUMENTS: expression is any valid expression.
　　EXAMPLE:
<%
　　strTest = "8/4/99"
　　response.write IsDate(strTest)
　　%>
　　RESULT: True

IsEmpty()：

　　FUNCTION: 判断一对象是否初始化，返回布尔值.
　　SYNTAX: IsEmpty(expression)
　　ARGUMENTS:
　　EXAMPLE:
<%
　　Dim i
　　response.write IsEmpty(i)
　　%>
　　RESULT: True

IsNull()：

　　FUNCTION: 判断一对象是否为空，返回布尔值.
　　SYNTAX: IsNull(expression)
　　ARGUMENTS:
　　EXAMPLE:
<%
　　Dim i
　　response.write IsNull(i)
　　%>
　　RESULT: False
　　
IsNumeric()：

　　FUNCTION: 判断一对象是否为数字，返回布尔值.
　　SYNTAX: IsNumeric(expression)
　　ARGUMENTS:
　　EXAMPLE:
<%
　　i = "345"
　　response.write IsNumeric(i)
　　%>
　　RESULT: True
　　就算数字加了引号，ASP还是认为它是数字。

IsObject()：

　　FUNCTION: 判断一对象是否为对象，返回布尔值.
　　SYNTAX: IsObject(expression)
　　ARGUMENTS:
　　EXAMPLE:
<%
　　Set con = Server.CreateObject("ADODB.Connection")
　　response.write IsObject(con)
　　%>
　　RESULT: True

LBound() ：

　　FUNCTION: 返回指定数组维的最小可用下标.
　　SYNTAX: Lbound(arrayname [, dimension>)
　　ARGUMENTS: dimension 指明要返回哪一维下界的整数。使用 1 表示第一维，2 表示第二维，以此类　　推。如果省略 dimension 参数，默认值为 1.
　　EXAMPLE:
<%
　　i = Array("Monday","Tuesday","Wednesday")
　　response.write LBound(i)
　　%>
　　RESULT: 0

LCase()：

　　FUNCTION: 返回字符串的小写形式
　　SYNTAX: Lcase(string)
　　ARGUMENTS: string is any valid string expression.
　　EXAMPLE:
<%
　　strTest = "This is a test!"
　　response.write LCase(strTest)
　　%>
　　RESULT: this is a test!

 

PHP:

返回带参数的Url，多关键字排序时使用：

' RemoveList 参数：需要从Url中去除的参数，可以是多个，中间请用逗号隔开 
Function KeepUrlStr(RemoveList) 
ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))&"?"'取得当前地址,并加入“?”符号 
M_ItemUrl = "" 
For Each M_item In Request.QueryString 
If InStr(RemoveList,M_Item)=0 Then 
M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&" 
End If 
Next 
KeepUrlStr = ScriptAddress & M_ItemUrl 
End Function

 

PHP:

用正则表达式突出显示字符串中查询到的关键词的函数：

Function BoldWord(strContent,word) 
If word="" Then 
BoldWord = strContent 
Exit Function 
End IF 
dim objRegExp 
Set objRegExp=new RegExp 
objRegExp.IgnoreCase =true 
objRegExp.Global=True 

objRegExp.Pattern="(" & word & ")" 
strContent=objRegExp.Replace(strContent,"<font color=""#FF0000""><b>$1</b></font>" ) 

Set objRegExp=Nothing 
BoldWord=strContent 
End Function 

 

PHP:

取得带端口的URL: 推荐使用：

Function Get_ScriptNameUrl() 
If request.servervariables("SERVER_PORT")="80" Then 
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&lcase(request.servervariables("script_name")) 
Else 
Get_ScriptNameUrl="http://" & request.servervariables("server_name")&":"&request.servervariables("SERVER_PORT")&lcase(request.servervariables("script_name")) 
End If 
End Function