一些常用的ASP自定义函数全集

最新推荐文章于 2019-08-14 13:53:52 发布
最新推荐文章于 2019-08-14 13:53:52 发布
阅读量1.3k 收藏 1
点赞数
分类专栏： ASP常用函数 文章标签： asp function sql server hex string 
 
<%

'========================================================
'函数导航
'FormatDate(DT,tp) ------------------------------------------日期格式化
'IsInteger(para)   ---------------------------检测传递的参数是否为数字型
'ChkrequestDate(Para) -----------------------检测传递的参数是否为日期型
'ChkPost() ------------------------------------不允许外部提交数据的选择
'IsValidEmail(email)------------------------------------------Email检测
'MakedownName()--------------------------------构造上传图片文件名随机数
'getIP() ----------------------------------------------------获取IP地址
'LeftTrue(str,n)---------------------------------------字符个数统一显示
'CheckSql()-为了系统的安全，直接在有数据库连接的地方都加上SQL注入的免疫
'Runtime()---------------------------------------------程序执行时间检测
'--------------------FSO文件|文件夹操作--------------------------------
'Checkfolder(folderpath)-------------------------------------创建文件夹
'Deletefolder(folderpath) -----------------------------------删除文件夹
'Filehaveno(FileName) ---------------------------------判断文件是否存在
'readfilerecord(Filename) -----------将指定的文件内容读出|只能是txt文本
'WriteString(String,FileName)------------把指定的字符串写到指定新文件中
'--------------------进制转化|加密|------------------------------------
'Encrypt(theNumber)| Decrypt(theNumber)   一套加解密ID的函数,最多8位
'UTF2GB(UTFStr) -------------------------将UTF8编码文字转换为GB编码文字
'toUTF8(szInput)-------------------------将GB编码文字转换为UTF8编码文字 
'c10to2(x)-----------------------------------十进制代码转换为二进制代码 
'c16to2(x)---------------------------------十六进制代码转换为二进制代码
'c2to16(x)---------------------------------二进制代码转换为十六进制代码 
'c2to10(x)-----------------------------------二进制代码转换为十进制代码  
'=========================================================
%>
<%
StartTime=timer()
'日期格式化
Function FormatDate(DT,tp)
dim Y,M,D
Y=Year(DT)
M=month(DT)
D=Day(DT)
if M<10 then M="0"&M
if D<10 then D="0"&D
select case tp
case 1 FormatDate=Y&"年"&M&"月"&D&"日"
case 2 FormatDate=Y&"/"&M&"/"&D
case 3 FormatDate=M&"/"&D
     case 4 FormatDate=Y&"\"&M&"\"&D
case 5 FormatDate=Y&"-"&M&"-"&D
end select
End Function
'--------------------------------
' ---判断数据是否整型 Being-----------------------------
Function IsInteger(para)
dim str
dim l,i
if isNUll(para) then 
isInteger=false
exit function
end if
str=cstr(para)
if trim(str)="" then
isInteger=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
isInteger=false 
exit function
end if
next
isInteger=true
if err.number<>0 then err.clear
End Function 
'--------------------------------
'检测传递的参数是否为日期型
Function ChkrequestDate(Para)
ChkrequestDate=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsDate(Para)) Then
    ChkrequestDate=True
End If
End Function
'--------------------------------


''Email检测
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
    IsValidEmail = false
    exit function
end if
for each name in names
    if Len(name) <= 0 then
      IsValidEmail = false
      exit function
    end if
    for i = 1 to Len(name)
      c = Lcase(Mid(name, i, 1))
      if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
        IsValidEmail = false
        exit function
      end if
    next
    if Left(name, 1) = "." or Right(name, 1) = "." then
       IsValidEmail = false
       exit function
    end if
next
if InStr(names(1), ".") <= 0 then
    IsValidEmail = false
    exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
    IsValidEmail = false
    exit function
end if
if InStr(email, "..") > 0 then
    IsValidEmail = false
end if
end function
'--------------------------------
'不允许外部提交数据的选择
Function ChkPost()
     dim HTTP_REFERER,SERVER_NAME
dim server_v1,server_v2
chkpost=false
     SERVER_NAME=CheckStr(Request.ServerVariables("SERVER_NAME"))
HTTP_REFERER=CheckStr(Request.ServerVariables("HTTP_REFERER"))
server_v1=Cstr(HTTP_REFERER)
server_v2=Cstr(SERVER_NAME)
if mid(server_v1,8,len(server_v2))<>server_v2 then
   chkpost=false
else
   chkpost=true
end if
End Function
'--------------------------------
'构造上传图片文件名随机数
function MakedownName()
dim fname
randomize
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,"下午","")
fname = int(fname) + int(((9-1+1)*Rnd + 1)*100000)   '6位
MakedownName=fname
end function
'--------------------------------
'获取IP地址
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
'--------------------------------
 


'防止SQL注入,为了系统的安全，直接在有数据库连接的地方都加上SQL注入的免疫
Function CheckSql() 
     Dim sql_injdata  
     SQL_injdata = "'|and|exec|insert|select|delete|update|count|*|%|chr|mid|master|truncate|char|declare" 
     SQL_inj = split(SQL_Injdata,"|") 
     If Request.QueryString<>"" Then 
         For Each SQL_Get In Request.QueryString 
             For SQL_Data=0 To Ubound(SQL_inj) 
                 if instr(Request.QueryString(SQL_Get),Sql_Inj(Sql_DATA))>0 Then 
Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}</Script>" 
                     Response.end 
                 end if 
             next 
         Next 
     End If
     If Request.Form<>"" Then 
         For Each Sql_Post In Request.Form 
             For SQL_Data=0 To Ubound(SQL_inj) 
                 if instr(Request.Form(Sql_Post),Sql_Inj(Sql_DATA))>0 Then 
                     Response.Write "<Script Language='javascript'>{alert('请不要在参数中包含非法字符！');history.back(-1)}     </Script>" 
                     Response.end 
                 end if 
             next 
         next 
     end if
End Function
'--------------------------------
'程序执行时间检测
Function Runtime()
EndTime=Timer()
If EndTime<StartTime Then
     EndTime=EndTime+24*3600
End if
RunTime=(EndTime-StartTime)*1000   '单位毫秒
End Function
'--------------------------------



'判断文件夹是否存在
Function Checkfolder(folderpath)
   Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
     If objFSO.FolderExists(Server.MapPath(""&folderpath&"")) Then
   Else
    objFSO.CreateFolder(Server.MapPath(""&folderpath&""))'不存在就建一个目录
   End If
   Set objFSO = Nothing 
End Function
'--------------------------------
'删除文件夹
Function Deletefolder(folderpath)
   Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
       If objFSO.FolderExists(Server.MapPath(""&folderpath&"")) Then
    objFSO.deletefolder(server.MapPath(folderpath))
    end if
   Set objFSO = Nothing
End Function
'--------------------------------
'一套加解密字符串的函数,基本正确   ,最多8位
Function Encrypt(theNumber)
On Error Resume Next
Dim n, szEnc, t, HiN, LoN, i
n = CDbl((theNumber + 1570) ^ 2 - 7 * (theNumber + 1570) - 450)
If n < 0 Then szEnc = "R" Else szEnc = "J"
n = CStr(abs(n))
For i = 1 To Len(n) step 2
t = Mid(n, i, 2)
If Len(t) = 1 Then
szEnc = szEnc & t
Exit For
End If
HiN = (CInt(t) And 240) / 16
LoN = CInt(t) And 15
szEnc = szEnc & Chr(Asc("M") + HiN) & Chr(Asc("C") + LoN)
Next
Encrypt = szEnc
End Function 

Function Decrypt(theNumber)
On Error Resume Next
Dim e, n, sign, t, HiN, LoN, NewN, i
e = theNumber
If Left(e, 1) = "R" Then sign = -1 Else sign = 1
e = Mid(e, 2)
NewN = ""
For i = 1 To Len(e) step 2
t = Mid(e, i, 2)
If Asc(t) >= Asc("0") And Asc(t) <= Asc("9") Then
NewN = NewN & t
Exit For
End If
HiN = Mid(t, 1, 1)
LoN = Mid(t, 2, 1)
HiN = (Asc(HiN) - Asc("M")) * 16
LoN = Asc(LoN) - Asc("C")
t = CStr(HiN Or LoN)
If Len(t) = 1 Then t = "0" & t
NewN = NewN & t
Next
e = CDbl(NewN) * sign
Decrypt = CLng((7 + sqr(49 - 4 * (-450 - e))) / 2 - 1570)
End Function
'--------------------------------
'函数功能:将指定的文件内容读出
'相关参数:FileName
'返回值:   文件全部内容 
Function readfilerecord(Filename)
if instr(filename,".")=0 then exit function
set ffso=server.createobject("scripting.filesystemobject")
if ffso.FileExists(server.mappath(filename))=false then exit function
set re_ffso=ffso.OpenTextFile(server.mappath(filename),1,0,0)
readfilerecord=re_ffso.readall
re_ffso.close
set ffso=nothing
end function
'---------------------------------


'函数功能:判断文件是否存在
'相关参数:FileName
'返回值: 如果存在返回True,否则返回False  
Function Filehaveno(FileName)
set ffso=server.createobject("scripting.filesystemobject")
Filehaveno=ffso.FileExists(server.mappath(filename))
set ffso=nothing
End Function  
'----------------------------------
'函数功能:把指定的字符串写到指定新文件中
'相关参数:String(字符串),FileName(文件名)
'返回值:无  
Function WriteString(String,FileName)
if string="" then exit function
if filename="" then exit function
if instr(filename,".")=0 then exit function
set ffso=server.createobject("scripting.filesystemobject")
set wfso=ffso.CreateTextFile(server.mappath(filename))
wfso.Writeline(string)
wfso.close
set ffso=nothing
End Function 
'---------------------------------------
'字符个数统一显示
'left函数,以英文说明为标准
Function LeftTrue(str,n)
If len(str)<=n/2 Then
LeftTrue=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
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+2
Else
t=t+1
End If
'If t>n Then exit for        '如果要显示字符
If t>n Then exit for        '如果要显示汉字
TStr=TStr&(mid(str,i,1))
next
LeftTrue = TStr
End If
End Function
'------------------------------------------
'UTF转GB---将UTF8编码文字转换为GB编码文字
function UTF2GB(UTFStr) 

for Dig=1 to len(UTFStr) 
   '如果UTF8编码文字以%开头则进行转换
   if mid(UTFStr,Dig,1)="%" then 
      'UTF8编码文字大于8则转换为汉字
     if len(UTFStr) >= Dig+8 then 
        GBStr=GBStr & ConvChinese(mid(UTFStr,Dig,9)) 
        Dig=Dig+8 
     else 
       GBStr=GBStr & mid(UTFStr,Dig,1) 
     end if 
   else 
      GBStr=GBStr & mid(UTFStr,Dig,1) 
   end if 
next 
UTF2GB=GBStr 
end function 


'UTF8编码文字将转换为汉字 
function ConvChinese(x) 
    A=split(mid(x,2),"%") 
    i=0 
    j=0 
   for i=0 to ubound(A) 
      A(i)=c16to2(A(i)) 
   next 
   for i=0 to ubound(A)-1 
     DigS=instr(A(i),"0") 
     Unicode="" 
     for j=1 to DigS-1 
       if j=1 then 
         A(i)=right(A(i),len(A(i))-DigS) 
         Unicode=Unicode & A(i) 
       else 
          i=i+1 
          A(i)=right(A(i),len(A(i))-2) 
          Unicode=Unicode & A(i) 
       end if 
     next 

     if len(c2to16(Unicode))=4 then 
        ConvChinese=ConvChinese & chrw(int("&H" & c2to16(Unicode))) 
     else 
        ConvChinese=ConvChinese & chr(int("&H" & c2to16(Unicode))) 
     end if 
   next 
end function 

'二进制代码转换为十六进制代码 
function c2to16(x)
    i=1 
    for i=1 to len(x) step 4 
       c2to16=c2to16 & hex(c2to10(mid(x,i,4))) 
    next 
end function 

'二进制代码转换为十进制代码 
function c2to10(x)
    c2to10=0 
    if x="0" then exit function 
      i=0 
    for i= 0 to len(x) -1 
       if mid(x,len(x)-i,1)="1" then c2to10=c2to10+2^(i) 
    next 
end function 

'十六进制代码转换为二进制代码
function c16to2(x) 
     i=0 
     for i=1 to len(trim(x)) 
       tempstr= c10to2(cint(int("&h" & mid(x,i,1)))) 
       do while len(tempstr)<4 
          tempstr="0" & tempstr 
       loop 
       c16to2=c16to2 & tempstr 
    next 
end function 

'十进制代码转换为二进制代码 
function c10to2(x) 
    mysign=sgn(x) 
    x=abs(x) 
    DigS=1 
    do 
       if x<2^DigS then 
         exit do 
       else 
         DigS=DigS+1 
       end if 
    loop 
    tempnum=x 

    i=0 
    for i=DigS to 1 step-1 
       if tempnum>=2^(i-1) then 
          tempnum=tempnum-2^(i-1) 
          c10to2=c10to2 & "1" 
       else 
          c10to2=c10to2 & "0" 
       end if 
    next 
    if mysign=-1 then c10to2="-" & c10to2 
end function
'-------------------------------
'GB转UTF8--将GB编码文字转换为UTF8编码文字 
Function toUTF8(szInput)
     Dim wch, uch, szRet
     Dim x
     Dim nAsc, nAsc2, nAsc3
     '如果输入参数为空，则退出函数
     If szInput = "" Then
         toUTF8 = szInput
         Exit Function
     End If
     '开始转换
      For x = 1 To Len(szInput)
         '利用mid函数分拆GB编码文字
         wch = Mid(szInput, x, 1)
         '利用ascW函数返回每一个GB编码文字的Unicode字符代码
         '注：asc函数返回的是ANSI 字符代码，注意区别
         nAsc = AscW(wch)
         If nAsc < 0 Then nAsc = nAsc + 65536
    
         If (nAsc And &HFF80) = 0 Then
             szRet = szRet & wch
         Else
             If (nAsc And &HF000) = 0 Then
                 uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                 szRet = szRet & uch
             Else
                'GB编码文字的Unicode字符代码在0800 - FFFF之间采用三字节模版
                 uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                             Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                             Hex(nAsc And &H3F Or &H80)
                 szRet = szRet & uch
             End If
         End If
     Next
        
     toUTF8 = szRet
End Function

%>


 

若水印象
关注
专栏目录
ASP常用日期格式化函数 FormatDate()
01-02
核心代码 <% '功能:多功能日期格式化函数 '来源:http://jorkin.reallydo.com/article.asp?id=477 Function FormatDate(sDateTime, sReallyDo) Dim sJorkin sJorkin = GetLocale() If Not IsDate(sDateTime) Then sDateTime = Now() sDateTime = CDate(sDateTime) Select Case UCase(sReallyDo & ) Case 0, 1, 2, 3, 4 Fo
ASP的一些自定义函数整理第1/2页
10-30
书学asp，经常会用到一些函数，对于代码的重用性有所提高，执行速度也提高，希望大家多多欣赏学习
我常用的一些ASP自定义函数
yesjavame
07-15 120
　　以下这些函数是我这么多年来的一个总结，有些是在工作中不断总结出来的，有些是通过网络的一些例程收集回来的，希望这些能对大家有帮助，多谢！ '自定义MyFormatDateTime函数的FormatType参数项目Const fdDefaultDateTime=1 '格式为：yyyy-m-d h:m:sConst fdDefaultDate=2 '格式为：yyyy-m-dConst fdDefa...
常用ASP自定义函数集 (S.Sams)
S.Sams`s Blog
03-06 1171
文章来源: 视点设计 8see.net http://blog.8see.net/rem ---表单提示函数 Being-----------------------------CODE Copy ...  Function Check_submit(str,restr)  if str="" then  response.write ""  response.write "alert("&re
一些asp的自定义函数
bitman_76的专栏
04-18 533
  屏蔽HTML语法   Function HTMLEncode(fString)      if not isnull(fString)   then       fString = replace(fString,">",">")     
ASP自编常用函数.rar_asp 自定义 函数
最新发布
09-23
下面将详细介绍ASP自定义函数的一些核心知识点。 **一、创建自定义函数** 在ASP中，你可以通过`Function`关键字来定义一个函数。例如，假设我们想要创建一个计算两个数相加的函数： ```vbscript Function ...
C#常用自定义函数小结
12-30
本文实例总结了几个C#常用的自定义函数，非常实用。分享给大家供大家参考。具体如下： 1.将数组转成字符串 /// /// 将数组转成字符串 /// /// 分隔符 /// 要字符串数组 private string Implode(char glue,string...
asp(vbscript)中自定义函数的默认参数实现代码
12-16
现代语言的函数中都可以带有默认参数,在vbscript系统内建的函数可以带有可选值(如常用的 split()等等),然而我们自己定义的函数中无法具有此功能. 下面提供一个方法实现可选参数的功能. functin foo(dtype, dsize,...
ASP中实现的URLEncode、URLDecode自定义函数
10-25
为此，可以使用自定义函数来实现更符合需求的URL编码和解码操作。 自定义的URLEncode函数可以处理超出ASCII字符集范围的Unicode字符，将其转换为%HH格式的十六进制表示，其中HH是字符的十六进制ASCII码。自定义的...
ASP中Server.HTMLEncode用法(附自定义函数)
10-15
HTMLEncode 方法对一段指定的字符串应用 HTML 编码，主要是为了安全考虑，这里脚本之家小编就为大家介绍一下
Asp几个自定义函数
编程岁月
09-08 1519
GetRepeatTimes(TheChar,TheString) 得到一个字符串在另一个字符串当中出现几次的函数(新)如：response.write GetRepeatTimes("w","www.51windows.net")response.write GetRepeatTimes("ww","wwwww")在网上看到过一个CheckTheChar(TheChar,TheString)函数
ASP自定义函数集
网络Online
03-26 432
*********************************************************************函数导航FormatDate(DT,tp) ------------------------------------------日期格式化IsInteger(para)   ---------------------------检测传递的参数是否为数
ASP常用函数表（vbs）
江湖·郎中·路
08-11 2182
Array()函数返回一个数组表达式 Array(list)允许数据类型: 字符，数字均可实例： Dim myArray()For i = 1 to 7Redim Preserve myArray(i)myArray(i) = WeekdayName(i)Next%>返回结果: 建立了一个包含7个元素的数组myArraymyArray("Sunday","Monday", ... ... "Sat
ASP开发中有用的函数（function）集合
weixin_30848775的博客
06-19 161
<% '************************************* '防止外部提交 '************************************* function ChkPost() dim server_v1,server_v2 chkpost=false server_v1=Cstr(Request...
asp自定义函数，带案例使用方法
weixin_34384681的博客
08-26 195
1、截断标题的函数 <%Function CutTitle(Title,TLen) If len(Title)>TLen Then CutTitle=Left(Title,TLen)&".." Else CutTitle=Title End If End Function %> 使用方法 <%=CutTitle(rs("Title"),25)...
不错的ASP函数库
SmartJavaer的专栏
10-12 2237
不错的ASP函数库                   函数目录                    ----------------------------------------------- 函数ID：0001[截字符串]                        函数ID：0002[过滤html]             
ASP函数库(全部可以直接调用，非常方便) 4
weixin_30699235的博客
08-14 209
'**************************************************'函数名：ListObjInfo'作 用：列出组件安装信息'参 数： ---- '返回值：列出组件安装信息'示 例：ListObjInfo()'**************************************************Public Function ListObjInfo...
asp字符控制大全
weixin_34392906的博客
04-23 141
Len Len(string|varname) 返回字符串内字符的数目，或是存储一变量所需的字节数。 Trim Trim(string) 将字符串前后的空格去掉 Ltrim Ltrim(string) 将字符串前面的空格去掉 Rtrim Rtrim(string) 将字符串后面的空格去掉 Mid Mid(string,start,length) 从string字符串的...
ASP自定义函数集锦：提高代码效率与安全性
"ASP的一些自定义函数整理第1/2页，包括了建立数据库连接、防止SQL注入、日期格式化等多个实用功能，旨在提高代码效率和安全性。" 在ASP（Active Server Pages）编程中，自定义函数是提升代码复用性和性能的关键。...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值