📄 cls_public.asp
字号:
city=""
sql="select top 1 country,city from dv_address where ip1 <="& num &" and ip2 >="& num
Set irs=aConn.execute(sql)
If Not(irs.EOF And irs.bof) Then
country=irs(0)
city=irs(1)
End If
Set irs=Nothing
Set aConn = Nothing
End If
IpAddress=country&city
End If
End Function
'*********************************
'根据指定名称生成目录
'*********************************
Public Function MakeDir(FolderName)
FolderPath=Server.MapPath(FolderName)
Dim Fso1
Dim F
Set Fso1 = CreateObject(ServerObject_005)
Set F = Fso1.CreateFolder(FolderPath)
If Err.Number = 0 Then
MakeDir=FolderPath
Else
Err.Clear
MakeDir=False
End If
Set Fso1 = Nothing
End Function
'***********************************
'检查某一目录是否存在
'***********************************
Public Function CheckDir(Byref FolderPath)
Dim fso1
dim folderpath1
folderpath1=Server.MapPath(FolderPath)
Set fso1 = CreateObject(ServerObject_005)
If fso1.FolderExists(folderpath1) Then
CheckDir=True
Else
CheckDir=False
End If
Set fso1 = Nothing
End Function
'***********************************
'删除文件
'***********************************
Public Function DeleteFile(Byref oPath)
Dim oFSO,FilePath,IsDeleted
FilePath=Server.MapPath(oPath)
IsDeleted=False
Set oFSO= CreateObject(ServerObject_005)
If oFSO.FileExists(FilePath) Then
oFSO.DeleteFile(FilePath)
IsDeleted=True
End If
Set oFSO = Nothing
DeleteFile=IsDeleted
End Function
'删除指定文件夹下的所有文件
Function DeleteUpDateFile(FilePath)
'on error Resume Next
If Right(FilePath, 1) <> "/" Then FilePath = FilePath & "/"
DeleteUpDateFile = False
Dim Fso, F, F1, Fc, S
Set Fso = CreateObject(ServerObject_005)
If Err Then Err.Clear : Exit Function
Set F = Fso.GetFolder(Server.MapPath(FilePath))
Set Fc = F.Files
For Each F1 In Fc
Fso.DeleteFile(Server.MapPath(FilePath & F1.Name))
Next
Set Fc = Nothing
Set Fso = Nothing
DeleteUpDateFile = True
End Function
'************************************
'截取文字长度函数
'输入参数：
' 1、文字内容
' 2、文字最大长度
'************************************
Public Function Cut_Title(Title,TLen)
Dim k,i,d,c
Dim iStr
k=0
d=StrLen(Title)
iStr=""
For i=1 To Len(Title)
c=Abs(Asc(Mid(Title,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
iStr=iStr&Mid(Title,i,1)
If CLng(k)>CLng(TLen) Then
iStr=iStr&".."
Exit For
End If
Next
Cut_Title=iStr
End Function
'*******************************
'检测文字长度函数
'输入参数：
' 1、文字内容
'*******************************
Public Function StrLen(strText)
Dim k,i,c
k=0
For i=1 To Len(strText)
c=Abs(Asc(Mid(strText,i,1)))
If c>255 Then
k=k+2
Else
k=k+1
End If
Next
StrLen=k
End Function
'*****************************************
'简单HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Base_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr,Chr(13)&Chr(10),vbcrlf)
End If
Base_HTMLFilter=sInputStr
End Function
'*****************************************
'全HTML代码过滤函数
'输入参数：
' 1、待过滤字符串
'*****************************************
Public Function Full_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr=Replace(sInputStr, ">", ">")
sInputStr=Replace(sInputStr, "<", "<")
sInputStr=Replace(sInputStr, """", """)
sInputStr=Replace(sInputStr, CHR(32), " ")
sInputStr=Replace(sInputStr, CHR(9), " ")
sInputStr=Replace(sInputStr, CHR(34), """)
sInputStr=Replace(sInputStr, CHR(39), "'")
sInputStr=Replace(sInputStr, CHR(13), "")
sInputStr=Replace(sInputStr, CHR(10) & CHR(10), "</P><P> ")
sInputStr=Replace(sInputStr, CHR(10), "<BR>")
End If
Full_HTMLFilter = sInputStr
End Function
'***************************************
'HTML过滤逆转换函数
'输入参数：
' 1、待转换字符串
'***************************************
Public Function Un_Base_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr = Replace(sInputStr, "</P><P> ", " ")
sInputStr = Replace(sInputStr, "<BR>", " ")
End If
Un_Base_HTMLFilter = sInputStr
End Function
'***************************************
'HTML过滤逆转换函数
'输入参数：
' 1、待转换字符串
'***************************************
Public Function Un_Full_HTMLFilter(sInputStr)
If Len(sInputStr)>0 Then
sInputStr = Replace(sInputStr, "</P><P> ", CHR(10) & CHR(10))
sInputStr = Replace(sInputStr, "<BR>", CHR(10))
End If
Un_Full_HTMLFilter = sInputStr
End Function
'****************************************
'屏蔽字符过滤函数
'输入参数：
' 1、待过滤内容
'****************************************
Public Function BadWords_Filter(strText)
Dim str_FilterContent
Dim BadWord_Array
Dim Tmp,i,TempArray
TempArray=EA_DBO.Get_System_Info()
If IsArray(TempArray) Then str_FilterContent=TempArray(7,0)
If Not(IsNull(str_FilterContent) Or Not IsNull(strText)) Then
BadWord_Array = Split(str_FilterContent, ";")
For i = 0 To Ubound(BadWord_Array)
Tmp=Split(BadWord_Array(i),"==")
strText = Replace(strText, Tmp(0), Tmp(1))
Next
End If
BadWords_Filter = strText
End Function
Public function DealJsText(Str)
if not isnull(Str) then
Dim re,po,ii
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10) & CHR(13), "</P><P> ")
Str = Replace(Str, CHR(10), "")
Str = Replace(Str, "‘", "'")
Str = Replace(Str, "’", "'")
'网友冷情圣郎提供
Str = Replace(Str, "\", "\\")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(34), "\""")
Str = Replace(Str, CHR(39), "'")
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
po=0
ii=0
re.Pattern="(javascript)"
Str=re.Replace(Str,"<I>javascript</I>")
re.Pattern="(jscript:)"
Str=re.Replace(Str,"<I>jscript:</I>")
re.Pattern="(js:)"
Str=re.Replace(Str,"<I>js:</I>")
re.Pattern="(</SCRIPT>)"
Str=re.Replace(Str,"</script>")
re.Pattern="(<SCRIPT)"
Str=re.Replace(Str,"<script")
DealJsText = Str
End if
end Function
'****************************************************
'检测数据提交间隔时间函数
'输入参数：
' 1、间隔时间
' 2、间隔符
' 3、对照时间
'****************************************************
Public Function Chk_PostTime(iSpace,sSplit,sSourTime)
Dim Flag
Flag=False
If Not IsDate(sSourTime) Then
Flag=False
Else
If DateDiff(sSplit,sSourTime,Now())<iSpace Then
Flag=True
Else
Flag=False
End If
End If
Chk_PostTime=Flag
End Function
'*************************************************************************************
'全功能安全过滤函数
'输入参数：
' 1、请求方式
' 2、请求名
' 3、值类型
' 4、默认值
' 5、过滤类型
'*************************************************************************************
Public Function SafeRequest(Requester,RequestName,RequestType,DefaultValue,FilterType)
Dim TempValue
Select Case Requester
Case 0
TempValue=Trim(RequestName)
Case 1
TempValue=Trim(Request(RequestName))
Case 2
TempValue=Trim(Request.Form(RequestName))
Case 3
TempValue=Trim(Request.QueryString(RequestName))
Case 4
TempValue=Trim(Request.Cookies(RequestName))
End Select
Select Case RequestType
Case 0
If Not IsNumeric(TempValue) Or Len(TempValue)<=0 Then
TempValue=CLng(DefaultValue)
Else
TempValue=CLng(TempValue)
End If
Case 1
Select Case FilterType
Case 0
TempValue=Replace(TempValue,"'","'")
If DbType>0 Then TempValue=Replace(TempValue,";","；")
TempValue=Replace(TempValue,"select","Ｓelect",1,-1,1)
Case 1
TempValue=Replace(TempValue,"'","'")
Call Base_HTMLFilter(TempValue)
Case 2
TempValue=Replace(TempValue,"'","'")
Call Full_HTMLFilter(TempValue)
End Select
Case 2
If Not IsDate(TempValue) Or Len(TempValue)<=0 Then
TempValue=CDate(DefaultValue)
Else
TempValue=CDate(TempValue)
End If
End Select
SafeRequest=TempValue
End function
'函数:通用信息提示框
'参数:
' 提示内容
' 返回地址,详细值类型如下:
' "#" 只提示，其它不做任何操作
' "BACK" 提示后返回前一页
' "CLOSE" 提示后关闭窗口
' "网址" 提示后返回指定页面
' 是否父窗口
Public Function Alert(backUrl,TopWindow)
If SysMsg <> "" Then
Response.Write "<script>alert(""" & SySMsg & """);"
End If
Dim WinName
If TopWindow = 1 Then
WinName = "top"
Else
WinName = "self"
End If
Select Case backUrl
Case "#"
Case "Back"
Response.Write WinName & ".history.back();"
Case "Close"
Response.Write "window.close();"
Case Else
If backUrl <> "" Then
Response.Write WinName & ".location.href = """ & backUrl & """;"
End If
End Select
Response.Write "</script>"
Response.End
End Function
'//时间格式化
'//参数：时间，格式模板
'//返回：格式化后的字符串
'//备注：格式化关键词详解：
' "[Y]" : 4位年
' "[y]" : 2位年
' "[M]" : 不补位的月
' "[m]" : 补位的月,如03,01
' "[D]" : 不补位的日
' "[d]" : 补位的日
' "[H]" : 不补位的小时
' "[h]" : 补位的小时
' "[MI]": 不补位的分钟
' "[mi]": 补位的分钟
' "[S]" : 不补位的秒
' "[s]" : 补位的秒
Public Function FormatMyDate(myDate,Template)
If Not IsDate(myDate) Or Template = "" Then
FormatMyDate = Template
Exit Function
End If
Template = Replace(Template,"[Y]",Year(myDate))
Template = Replace(Template,"[y]",Right(Year(myDate),2))
Template = Replace(Template,"[M]",Month(myDate))
Template = Replace(Template,"[m]",Right("00" & Month(myDate),2))
Template = Replace(Template,"[D]",Day(myDate))
Template = Replace(Template,"[d]",Right("00" & Day(myDate),2))
Template = Replace(Template,"[H]",Hour(myDate))
Template = Replace(Template,"[h]",Right("00" & Hour(myDate),2))
Template = Replace(Template,"[MI]",Minute(myDate))
Template = Replace(Template,"[mi]",Right("00" & Minute(myDate),2))
Template = Replace(Template,"[S]",Second(myDate))
Template = Replace(Template,"[s]",Right("00" & Second(myDate),2))
FormatMyDate = Template
End Function
'函数:写Cookie
Public Sub SetCookie(Key,Val,ExpTime)
Response.Cookies(CacheName&"_" & Key) = Val
Response.Cookies(CacheName&"_" & Key).Expires = ExpTime
End Sub
'函数:读Cookie
Public Function GetCookie(Key)
GetCookie = Request.Cookies(CacheName&"_"&Key)
End Function
'获取当前页的URL
Public Function GetURL
Dim sQUERY_STRING
sQUERY_STRING=Request.ServerVariables("QUERY_STRING")
If sQUERY_STRING<>"" Then
sQUERY_STRING="?"&sQUERY_STRING
End if
GetURL=Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")&sQUERY_STRING
End Function
'***************************
'获取来访用户IP函数
'***************************
Public Function Get_UserIp()
Dim Ip,Tmp
Dim i,IsErr
IsErr=False
Ip=Request.ServerVariables("REMOTE_ADDR")
If Len(Ip)<=0 Then Ip=Request.ServerVariables("HTTP_X_ForWARDED_For")
If Len(Ip)>15 Then
IsErr=True
Else
Tmp=Split(Ip,".")
If Ubound(Tmp)=3 Then
For i=0 To Ubound(Tmp)
If Len(Tmp(i))>3 Then IsErr=True
Next
Else
IsErr=True
End If
End If
If IsErr Then
Get_UserIp="1.1.1.1"
Else
Get_UserIp=Ip
End If
End Function
Public Function GetCurrentUrl()
Url = "Http://" & Request.ServerVariables("Server_Name") & Left(Request.ServerVariables("Script_Name"),Len(Request.ServerVariables("Script_Name")) - Len(Split(Request.ServerVariables("Script_Name"),"/")(UBound(Split(Request.ServerVariables("Script_Name"),"/")))))
GetCurrentUrl=Url
End Function
'*******************************
'格式化ip字符串函数
'输入参数：
' 1、ip字符串
'*******************************
Public Function FormatIp(IpStr)
Dim Tmp,i
Tmp=Split(IpStr,".")
For i=0 To Ubound(Tmp)
If Len(Tmp(i))<3 Then Tmp(i)=Right("000"&Tmp(i),3)
Next
IpStr=Join(Tmp,",")
FormatIp=Replace(IpStr,",","")
End Function
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If Err = 0 Then IsObjInstalled = True
If Err = -2147352567 Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
End Class
%>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -