比较常用到的一些ASP函数

Function MIP() ip=Request.ServerVariables("HTTP_X_FORWARDED_FOR") If ip = "" Then ip = Request.ServerVariables("REMOTE_ADDR") end if MIP=ip End Function Function Setting() '网站基本设置 set rsset=server.CreateObject("adodb.recordset") rsset.open "select * from Setting",cn,1,3 for i=0 to rsset.fields.count-1 if i=0 then Setting=rsset(i).value else Setting=Setting&"§"&rsset(i).value end if next End Function Function Msave() Msave="true" '防范未知IP访问及软件攻击 if MIP="127.0.0.1" then Exit Function if (MIP="unknown" or MIP="") then Msave="false" Response.write "系统拒绝了你的来访IP不明访问请求，如有问题请与客服中心联系" Response.end end if 'SQL注入式攻击防范get及ID（not）代码 squery=lcase(Request.ServerVariables("QUERY_STRING")) sURL=lcase(Request.ServerVariables("HTTP_HOST")) allquery=squery+sURL if InStr(allquery,"%27")<>0 or InStr(allquery,"'")<>0 or InStr(allquery,"%a1a1")<>0 or InStr(allquery,"　")<>0 or InStr(allquery,"%24")<>0 or InStr(allquery,"$")<>0 or InStr(allquery,"%3b")<>0 or InStr(allquery,";")<>0 or InStr(allquery,":")<>0 or InStr(allquery,"%%")<>0 or InStr(allquery,"%3c")<>0 or InStr(allquery,"<")<>0 or InStr(allquery,">")<>0 or InStr(allquery,"--")<>0 or InStr(allquery,"sp_")<>0 or InStr(allquery,"xp_")<>0 or InStr(allquery,"exec")<>0 or InStr(allquery,"/")<>0 or InStr(allquery,"dir")<>0 or InStr(allquery,"exe")<>0 or InStr(allquery,"select")<>0 or InStr(allquery,"delete")<>0 or InStr(allquery,"update")<>0 or InStr(allquery,"insert")<>0 or InStr(allquery,"cmd")<>0 or InStr(allquery,"*")<>0 or InStr(allquery,"^")<>0 or InStr(allquery,"(")<>0 or InStr(allquery,")")<>0 or InStr(allquery,"+")<>0 or InStr(allquery,"copy")<>0 or InStr(allquery,"format")<>0 or not(isnumeric(request("id"))) or not(isnumeric(request("classid"))) or not(isnumeric(request("page"))) then Msave="false" win=Request.ServerVariables("HTTP_USER_AGENT") Tlocal=Split(Getlocation,"§")(2) '攻击的页面 set rsip=server.CreateObject("adodb.recordset") rsip.open "select count(id) as M_num from AttackLog where Attack_ip='"&MIP&"'",cn,1,3 if rsip("M_num")>0 then '当同一IP非法访问多于2次时 cn.execute "Insert into AttackLog(Attack_local,Attack_ip,Attack_atime,whois) values('"&Tlocal&"','"&MIP&"','"&Gettime&"','"&whois&"')" '反击开绐(调用了一个死循环) Response.write "<mce:script language='JavaScript'><!-- " Response.write "while (true)" Response.write "alert('你的不法访问已达 "&rsip("M_num")+1&" 次，你的真实IP地址："&MIP&"，所用游览器："&win&"。你的IP及其它信息已被记录，系统已启动入侵自卫反击，由此造成的一切后果自负！！！') // --></mce:script>" Response.end '反击结束 else cn.execute "Insert into AttackLog(Attack_local,Attack_ip,Attack_atime,whois) values('"&Tlocal&"','"&MIP&"','"&Gettime&"','"&whois&"')" Response.Write("<mce:script type="text/javascript"><!-- alert('错误提示：系统拒绝了你的不法访问，请确认你的访问的网址是否正确，如有问题请与网站客服中心联系！你的真实IP地址："&MIP&"，所用游览器："&win&"。如果你的不法访问达到二次系统将自动进入入侵自卫反击状态。由此造成的一切后果自负！');history.go(-1); // --></mce:script>") Response.End end if rs.close end if End Function Function Getlocation() '获取浏览器地址数组=来自哪一页§§不包含传值地址§§包含传值地址 FromURL=request.serverVariables("Http_REFERER")'来自哪一页 ScriptAddress=CStr(Request.ServerVariables("SCRIPT_NAME")) '当前文件地址,不包含传值 If (Request.QueryString <> "") Then ScriptAddress = ScriptAddress & "?" For Each M_item In Request.QueryString If InStr(page,M_Item)=0 Then M_ItemUrl = M_ItemUrl & M_Item &"="& Server.URLEncode(Request.QueryString(""&M_Item&"")) & "&" End If Next end if GetUrl = ScriptAddress&M_ItemUrl '当前文件地址,包含传值 if right(ScriptAddress,1)="?" then ScriptAddress=left(ScriptAddress,len(ScriptAddress)-1) if right(GetUrl,1)="&" then GetUrl=left(GetUrl,len(GetUrl)-1) Getlocation=replace(FromURL&"§"&ScriptAddress&"§"&GetUrl,"/","/") End Function Function G_Split(CounterValue,Counter_bits) For i=1 To Counter_bits G=Mid(CounterValue,i,1) If G="" Then G=0 ImgTag="<img src="images/"&G&".gif" mce_src="images/"&G&".gif" width='15' height='12' align='absmiddle'>"&ImgTag Else ImgTag=ImgTag&"<img src="images/"&G&".gif" mce_src="images/"&G&".gif" width='15' height='12' align='absmiddle'>" End If Next G_Split=ImgTag End Function Function Gettime()'时间格式化 y=year(date) tmonth=month(date) tday=day(date) thour=hour(time) tminute=minute(time) tsecond=second(time) if len(tmonth)=1 then tmonth="0"&tmonth end if if len(tday)=1 then tday="0"&tday end if if len(thour)=1 then thour="0"&thour end if if len(tminute)=1 then tminute="0"&tminute end if if len(tsecond)=1 then tsecond="0"&tsecond end if Gettime=y&"-"&tmonth&"-"&tday&" "&thour&":"&tminute&":"&tsecond End Function ' ============================================ ' 格式化时间(显示) ' 参数：n_Flag ' 1:"yyyy-mm-dd hh:mm:ss" ' 2:"yyyy-mm-dd" ' 3:"hh:mm:ss" ' 4:"yyyy年mm月dd日" ' 5:"yyyymmdd" ' ============================================ 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 End Select End Function Function RE_Tongpei(Ostr,Fstr,Mstr,Lstr,Nstr) '通配符替换(原字符串,首字符串,通配字符串,末字符串,替换成的字符串) if Mstr=0 then Mstr="/s*?" '当通配字符串为0时替换所有 set re=new regexp re.ignorecase=true re.global=true re.pattern=Fstr&"("&Mstr&")"&Lstr '关键是括号中的通配正则表达式 RE_Tongpei=re.replace(Ostr,Nstr) End Function '邮件发送函数 Function SendEmail(fromemail,fromemailemailpwd,fromemailsmtp,fromemailusername,emailSubject,emailcontent,toemail) Set msg = Server.CreateObject("JMail.Message") msg.silent = true msg.Logging = true msg.Charset = "gb2312" msg.ContentType = "text/html" '邮件头设置， 默认为 "text/plain" ,发送HTML信息,改为 "text/html" msg.MailServerUserName = fromemail '发信人地址 msg.MailServerPassword = fromemailemailpwd '发信人密码 msg.From = fromemail '发信人地址 msg.FromName = fromemailusername '发信人名称 msg.AddRecipient toemail '收信人地址 msg.Subject = emailSubject '信件主题 msg.Body = emailcontent msg.Send fromemailsmtp 'smtp SendEmail=err.number set msg=nothing End Function Function CreateFile(FileName) '新建文件,并返回结果 建立成功为OK,否则为NO dim FSO,F set FSO = server.CreateObject("scripting.filesystemobject") F = server.mappath(FileName) if FSO.FileExists(F) then CreateFile="NO" else FSO.CreateTextFile F,true CreateFile="OK" end if set F = nothing set FSO = nothing End Function Function DeleteFile(FileName) '删除文件,并返回结果 删除成功为OK,否则为NO dim FSO,F set FSO = server.CreateObject("scripting.filesystemobject") F=server.MapPath(FileName) if FSO.FileExists(F) then FSO.DeleteFile F,true DeleteFile="OK" else DeleteFile="NO" end if set F = nothing set FSO = nothing End Function Function CreateFolder(Foldername) '新建文件夹,并返回结果 建立成功为OK,否则为NO Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") F=server.MapPath(Foldername) if FSO.FolderExists(F) then CreateFolder="NO" else FSO.CreateFolder(F) CreateFolder="OK" end if set F = nothing set FSO = nothing End Function Function DeleteFolder(Foldername) '删除文件夹,并返回结果 删除成功为OK,否则为NO Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") F=server.MapPath(Foldername) if FSO.FolderExists(F) then FSO.DeleteFolder(F) DeleteFolder="OK" else DeleteFolder="NO" end if set F = nothing set FSO = nothing End Function Function WriteFile(FileName,Content) '后面加 dim FSO,F set FSO = server.CreateObject("scripting.filesystemobject") if FSO.FileExists(server.mappath(FileName)) then set F = FSO.opentextfile(server.mappath(FileName),8,1) F.write Content F.close WriteFile="OK" else WriteFile="NO" end if set F = nothing set FSO = nothing End Function Function WriteLine(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(10)) if lineNum>ubound(temparray)+1 then exit function else temparray(lineNum-1) = lineContent end if tempcnt = replace(join(temparray,chr(10)),chr(10)&chr(10),chr(10)) if right(tempcnt,1)=chr(10) then tempcnt=left(tempcnt,len(tempcnt)-1) set f = fso.createtextfile(server.mappath(filename),true) f.write tempcnt end if f.close set f = nothing End Function Function WriteLine1(filename,lineNum,Linecontent) '写某行 if linenum<1 then exit function set fso = server.CreateObject("scripting.filesystemobject") if not fso.fileExists(server.mappath(filename)) then exit function set textfile = fso.opentextfile(server.mappath(filename),1) i=1 NewFileCont="" while not textfile.atendofstream if i<>cint(linenum) then NewFileCont=NewFileCont&textfile.readline&chr(10) a=i end if i=i+1 wend if right(NewFileCont,1)=chr(10) then NewFileCont=left(NewFileCont,len(NewFileCont)-1) NewFileCont=NewFileCont&a set f = fso.createtextfile(server.mappath(filename),true) f.write NewFileCont set f = nothing End Function Function DB_Engine(oldDB,bakDB,newDB) '数据库压缩 F1=server.MapPath(oldFile) F2=server.MapPath(bakDB) F3=server.MapPath(newFile) Set FSO = Server.CreateObject("Scripting.FileSystemObject") FSO.CopyFile F1, F2 , true Set Engine = Server.CreateObject("JRO.JetEngine") prov = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" Engine.CompactDatabase prov & F1, prov & F3 set Engine = nothing set FSO = nothing End Function Function Copy_File(oldFile,newFile) '复制文件 F1=server.MapPath(oldFile) F2=server.MapPath(newFile) Set fs = Server.CreateObject("Scripting.FileSystemObject") fs.CopyFile F1, F2 End Function Function Move_File(oldFile,newFile) '移动文件 F1=server.MapPath(oldFile) F2=server.MapPath(newFile) Set FSO = Server.CreateObject("Scripting.FileSystemObject") FSO.MoveFile F1, F2 set FSO = nothing End Function Function GetFMSG(FName) '获取文件信息 成功=CreateDate(建立时间):LastModify(最后修改):FileSize(文件大小),否则=NO Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") F=server.MapPath(FName) if FSO.FileExists(F) then set MyFile=FSO.getfile(F) CreateDate=MyFile.DateCreated LastModify=MyFile.DateLastModified FileSize=MyFile.Size GetFMSG="CreateDate："&CreateDate&",LastModify："&LastModify&",FileSize："&FileSize set MyFile = nothing else GetFMSG="NO" end if set F = nothing set FSO = nothing End Function Function GetFolderFile(FolderName) '获取某文件夹中的所有文件,并返回文件名数组 Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") if right(left(FolderName,2),1)=":" then F=FolderName else F=server.MapPath(FolderName) end if if FSO.FolderExists(F) then Set GetFile = FSO.GetFolder(F) for each item in GetFile.Files FileName = FileName&"§§"&item.Name next set GetFile = nothing end if if left(FileName,2)="§§" then FileName=right(FileName,len(FileName)-2) if right(FileName,2)="§§" then FileName=left(FileName,len(FileName)-2) GetFolderFile = "GetFolderFile:"&FileName set F = nothing set FSO = nothing End Function Function GetFolderMSG(Folder_Name) '获取文件夹信息 成功=CreateDate(建立时间):LastModify(最后修改):FileSize(文件大小),否则=NO set FSO=server.createobject("Scripting.FileSystemObject") F=server.mappath(Folder_Name) set MyFolder=fso.getfolder(F) CreateDate=MyFolder.DateCreated LastModify=MyFolder.DateLastModified FolderSize=MyFolder.size GetFolderMSG="CreateDate："&CreateDate&",LastModify："&LastModify&",FileSize："&FolderSize set F = nothing set FSO = nothing End Function Function GetFolderFolder(FolderName) '获取某文件夹中的所有文件夹,并返回文件夹名称数组 Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") F=server.MapPath(FolderName) set SearchFolder=Filesystem.GetFolder(F).SubFolders for each FolderItem in SearchFolder FolderName=FolderName&"§§"&FolderItem.Name next set SearchFolder = nothing if left(FolderName,2)="§§" then FolderName=right(FolderName,len(FolderName)-2) if right(FolderName,2)="§§" then FolderName=left(FolderName,len(FolderName)-2) GetFolderFolder = "GetFolderFolder:"&FolderName set F = nothing set FSO = nothing End Function Function ReadTxt(filepath) '读取单行文件 set fsa=server.createobject("scripting.filesystemobject") set textfilea=fsa.opentextfile(server.mappath(filepath)) ReadTxt=textfilea.readline textfilea.close End Function Function ReadFile(filepath) '读取整个文件 set fs=server.createobject("scripting.filesystemobject") set textfile=fs.opentextfile(server.mappath(filepath)) while not textfile.atendofstream ReadFile=ReadFile&replace(textfile.readline," ","　　")&"<BR>" wend textfile.close End Function Function Tlen(str) '中英文长度 'mlen要显示多少个英文字符,一个中文占两个英文字符位置 p_len=len(trim(str)) strlen=0 for xx=1 to p_len if asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 '字符长度加2 else strlen=int(strlen) + 1 '字符长度加1 end if next Tlen=strlen End Function Function Slen(str,mlen) '中英文控制显示长度 'mlen要显示多少个英文字符,一个中文占两个英文字符位置 p_len=len(trim(str)) for xx=1 to p_len if asc(mid(str,xx,1))<0 then strlen=int(strlen) + 2 '字符长度加2 if strlen>mlen then '当字符串长度超长时则退出 L="true" '设置字符串超长标记 exit for else '否则字符串继续相加 nstr=nstr+mid(str,xx,1) end if else strlen=int(strlen) + 1 '字符长度加1 if strlen>mlen then '当字符串长度超长时则退出 L="true" '设置字符串超长标记 exit for else '否则字符串继续相加 nstr=nstr+mid(str,xx,1) end if end if next if L="true" then response.write nstr&".." else response.write nstr end if End Function Function GetStr(Nstr,Lstr,Sstr,Ostr) 'Nstr字符串 Lstr作为分隔的字符串 Sstr前通配字符串 Ostr后通配字符串 if Nstr="" or Lstr="" or Sstr="" or Ostr="" then exit Function d_count=ubound(split(lcase(Nstr),Lstr,-1,1)) '得通配数量 Olen=0 for i=0 to d_count-1 start=NewLen(1,Nstr,Sstr) over=NewLen(start,Nstr,Ostr) Purl=mid(Nstr,start+len(Sstr),over-start-len(Sstr)) if left(Purl,4)<>"http" then if left(Purl,2)<>".." then if left(Purl,1)="/" then Purl=".."&Purl else Purl="../"&Purl end if end if end if Nstr=right(Nstr,len(Nstr)-(over-1+len(Ostr))+Olen) GetStr=GetStr&"§"&Purl next if left(GetStr,1)="§" then GetStr=right(GetStr,len(GetStr)-1) End Function Function NewLen(start,wstr,strng) NewLen=Instr(start,lcase(wstr),lcase(strng)) if NewLen<=0 then NewLen=Len(wstr) End Function Function DelStr(Str) If IsNull(Str) Or IsEmpty(Str) Then Exit Function DelStr=Replace(Str,"'","") DelStr=Replace(DelStr,"&","") DelStr=Replace(DelStr,"%20","") DelStr=Replace(DelStr,"<","") DelStr=Replace(DelStr,">","") DelStr=Replace(DelStr,"%","") End Function '********HTMLEncode函数：除了server.htmlencode的所有功能以外，还有转化回车和空格的功能，处理'及"，可以将textarea中输入的文本按照原样在html中显示*********************** Function HEncode(str) If IsNull(Str) Or IsEmpty(Str) Then Exit Function str = replace(str,"&","&") str = replace(str,"<","<") str = replace(str,">",">") str = replace(str,"<%","＜%") str = replace(str,"%>","%＞") str = replace(str,chr(34),""") str = replace(str,chr(32)," ",1) str = replace(str,chr(3),"'") str = replace(str,"'","’") str = Replace(str,CHR(39),"'") str = Replace(str,"IMG","img") HEncode = str End Function '********HTMLDecode函数：就是HTMLEncode函数的反函数，将html中的字符按照原样在textarea中显示，在修改信息时很有用*********************** Function HDecode(str) If IsNull(Str) Or IsEmpty(Str) Then Exit Function str = replace(str,"&","&") str = replace(str,">",">") str = replace(str,"<","<") str = replace(str,""",chr(34)) str = replace(str," ",chr(32),1) str = replace(str,"'",chr(3)) str = Replace(str,"'",chr(39)) HDecode = str End Function Function RemoveHTML(str) '去掉字符串中所有html内容 If IsNull(Str) Or IsEmpty(Str) Then Exit Function Dim RegEx Set RegEx=New RegExp RegEx.Pattern="<[^>]*>" RegEx.Global=True RemoveHTML=RegEx.Replace(str,"") End Function 'post过滤sql注入代防范及HTML防护开始 Function NOsql(str) if isnull(str) then str = "" exit function end if str=trim(str) str=replace(str,"&","&") '& str=replace(str,";",";") '分号 str=replace(str,"'","'") '单引号 str=replace(str,"""",""") '双引号 str=replace(str,"chr(9)"," ") '空格 str=replace(str,"chr(10)","<br>") '回车 str=replace(str,"chr(13)","<br>") '回车 str=replace(str,"chr(32)"," ") '空格 str=replace(str,"chr(34)",""") '双引号 str=replace(str,"chr(39)","'") '单引号 str=Replace(str, "script", "script")'script str=replace(str,"<","<") '左< str=replace(str,">",">") '右> str=replace(str,"(","(") '左( str=replace(str,")",")") '右) str=replace(str,"*","*") '* str=replace(str,"--","--") 'SQL注释符 NOsql=str End Function 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 Function GetSysInfo() On Error Resume Next Dim WshShell,WshSysEnv Set WshShell = Server.CreateObject("WScript.Shell") Set WshSysEnv = WshShell.Environment("SYSTEM") okOS = Cstr(WshSysEnv("OS")) okCPUS = Cstr(WshSysEnv("NUMBER_OF_PROCESSORS")) okCPU = Cstr(WshSysEnv("PROCESSOR_IDENTIFIER")) If IsNull(okCPUS) Then okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS") ElseIf okCPUS="" Then okCPUS = Request.ServerVariables("NUMBER_OF_PROCESSORS") End If If Request.ServerVariables("OS")="" Then okOS=okOS & "(可能是 Windows Server 2003)" GetSysInfo=okCPUS&"§"&okOS End Function ' ============================================ ' 检测上页是否从本站提交 ' 返回: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 ' ============================================ ' 得到安全字符串,在查询中使用 ' ============================================ 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