ASP实用功能

◆ 连接数据库
const SqlDatabaseName=”RealChina_SQLDB”
const SqlPassword=”123″
const SqlUsername=”sa”
const SqlLocalName=”(local)”
‘ SQL-1.
connstr=”driver={SQL Server};server=”&SqlLocalName&”;uid=”&SqlUsername&”;pwd=”&SqlPassword&”;database=”&SqlDatabaseName&”;”
‘ SQL-2.
ConnStr= “Provider=SQLOLEDB.1;Data Source=”&SqlLocalName&”;User ID=”&SqlUsername&”;Password=”&SqlPassword&”;Initial Catalog=”&SqlDatabaseName&”;”
‘ SQL-3.
Connstr = “Provider=SQLOLEDB;Server=(local);UserID=sa;Password=XXX;Database=XU;”
‘ Access -1.
connStr = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=”&server.MapPath(SqlDatabaseName)
‘ Access -2.
connStr = “Driver={Microsoft Access Driver (*.mdb)};Uid=”&SqlUsername&”;Pwd=”&SqlPassword&”;Dbq=”&server.MapPath(SqlDatabaseName)
‘ Access -3.
set conn=server.createobject(“adodb.connection”)
conn.provider=”microsoft.jet.oledb.4.0″
conn.open server.mappath(“mydata.mdb”)

◆ Jmail示例 (可发多个)

MailServer = “smtp.163.com” ‘发送邮件服务器名
SystemFromMail = “shaoyantao@163.com” ‘发送人Email地址
SystemFromName = “大个” ‘发送人名称
MailServerUserName = “shaoyantao” ‘邮件服务器登录名
MailServerPassword = “xxxxxx” ‘登录密码

Call Jmail(“收件人信箱”,”标题”,”内容”)

Sub Jmail(Email,Topic,Mailbody)
On Error Resume Next
Dim JMail,i
Set JMail = Server.CreateObject(“JMail.Message”)
JMail.silent=true
JMail.Logging = True
JMail.Charset = “gb2312″
JMail.MailServerUserName = MailServerUserName ‘您的邮件服务器登录名
JMail.MailServerPassword = MailServerPassword ‘登录密码
JMail.ContentType = “text/html”
JMail.Priority = 1
JMail.From = SystemFromMail
JMail.FromName = SystemFromName
If Isarray(Email) Then
For i=1 To Ubound(Email)
JMail.AddRecipient Email(i)
Next
Else
JMail.AddRecipient Email
End If
JMail.Subject = Topic
JMail.Body = Mailbody
JMail.Send MailServer
Set JMail = Nothing
SendMail = “OK”
If Err Then SendMail = “False”
End Sub

‘Jmail邮件发送
Function SendJmail(Email,Topic,MailBody)
Dim JMail
on error resume next
Set JMail = Server.CreateObject(“JMail.SMTPMail”)
JMail.LazySend = true
JMail.silent = true
JMail.Charset = “gb2312″
JMail.ContentType = “text/html”
JMail.Sender = “”&SMTPServer&””
JMail.ReplyTo = “”&SystemEmail&””
JMail.SenderName = “”&webname&”邮件发送系统”
JMail.Subject = Topic
JMail.SimpleLayout = true
JMail.Body = MailBody
JMail.Priority = 1
JMail.AddRecipient Email
JMail.AddHeader “Originating-IP”, GBL_IPAddress
If JMail.Execute() = false Then
SendJmail = 0
Else
SendJmail = 1
End If
JMail.Close
Set JMail = Nothing
End Function
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
on error resume next
Dim JMail
Set JMail=Server.CreateObject(“JMail.Message”)
if err then
SendMail= “<br><li>没有安装JMail组件</li>”
err.clear
exit function
end if
JMail.Charset=”gb2312″
JMail.silent=true
JMail.ContentType = “text/html”
JMail.MailServerUserName = MailServerUserName
JMail.MailServerPassWord = MailServerPassword
JMail.MailDomain = MailDomain
JMail.AddRecipient MailtoAddress,MailtoName
JMail.Subject=Subject
JMail.HMTLBody=MailBody
JMail.Body=MailBody
JMail.FromName=FromName
JMail.From = MailFrom
JMail.Priority=Priority
JMail.Send(MailServer)
SendMail =JMail.ErrorMessage
JMail.Close
Set JMail=nothing
end function
◆ 提交数据后防刷新提交的页面(简易)
PreWebPage = “gueset.asp”
PreWebURL = Request.ServerVariables(“HTTP_REFERER”)
if Instr(1, PreWebURL, PreWebPage, 1) = 0 then
Response.Redirect “book.asp”
end if

◆ 显示当前目录下所以的文件
dirtowalk=”web”
set fs=server.CreateObject(“Scripting.FileSystemObject”)
set f=fs.GetFolder(server.MapPath(dirtowalk))
set fc=f.files
for each whatever in fc
response.Write “<a href=’”
response.Write whatever.name
response.Write “‘>”
response.Write whatever.name&” “&whatever.datecreated
response.Write “</a><br>”
next
◆ 获取真实IP
Function GetIP()
dim uIP
uIP = Request.ServerVariables(“HTTP_X_FORWARDED_FOR”)
If uIP = “” Then uIP = Request.ServerVariables(“REMOTE_ADDR”)
GetIp = uIP
End Function

◆ 清除缓存
页面
<META HTTP-EQUIV=”pragma” CONTENT=”no-cache”>
<META HTTP-EQUIV=”Cache-Control” CONTENT=”no-cache, must-revalidate”>
<META HTTP-EQUIV=”expires” CONTENT=”0″>

ASP网页
response.expires = 0
response.expiresabsolute = now() – 1
response.addHeader “pragma”,”no-cache”
response.addHeader “cache-control”,”private”
Response.cachecontrol = “no-cache”

◆过滤

‘过滤SQL非法字符
Function checkStr(Chkstr)
dim Str:Str=Chkstr
if isnull(Str) then
checkStr = “”
exit Function
else
Str=replace(Str,”‘”,””)
Str=replace(Str,”;”,””)
Str=replace(Str,”–“,””)
checkStr=Str
end if
End Function

‘过滤SQL非法字符并格式化html代码
function Replace_Text(fString)
if isnull(fString) then
Replace_Text=””
exit function
else
fString=trim(fString)
fString=replace(fString,”‘”,”””)
fString=replace(fString,”;”,”；”)
fString=replace(fString,”–“,”—”)
fString=server.htmlencode(fString)
Replace_Text=fString
end if
end function

‘会员发布的各种信息过滤
Function changechr(fString)
If Not IsNull(fString) Then
fString = trim(fString)
fString = replace(fString, “;”, “；”) ‘分号过滤
fString = replace(fString, “–“, “——”) ‘–过滤
fString = replace(fString, “%20″, “”) ‘特殊字符过滤
fString = replace(fString, “==”, “”) ‘==过滤
‘fString = replace(fString, “>”, “>”)
‘fString = replace(fString, “<“, “<“)
fString = Replace(fString, CHR(32), ” “) ’
fString = Replace(fString, CHR(9), ” “) ’
fString = Replace(fString, CHR(34), “””)
fString = Replace(fString, CHR(39), “‘”) ’单引号过滤
fString = Replace(fString, CHR(13), “”)
fString = Replace(fString, CHR(10) & CHR(10), “</P><P> “)
fString = Replace(fString, CHR(10), “<BR> “)
changechr = fString
End If
End Function

‘=================================BadWords================
function realcn_BadWords(realcn_contents)
dim BadKeywords,realcn_flag,realcn_BadWord,Array_badkeywords,Bad_msg,i
BadKeyWords=”爱z|法X功|李X志”
Array_badkeywords= split(BadKeywords, “|”)
for i = 0 to ubound(Array_badkeywords)
realcn_BadWord = InStr(lcase(realcn_contents),lcase(Array_badkeywords(i)))
If realcn_BadWord >0 Then
Bad_msg=””&Array_badkeywords(i)&”、”&Bad_msg
realcn_flag=”yes”
end if
next
If realcn_flag=”yes” Then
response.write”<script>alert(‘您发布的内容含有[“&Bad_msg&”]“不健康”词汇，返回重输!’);history.back();</script>”
response.end()
else
realcn_BadWords=realcn_contents
end if

end function
‘========================================================

‘检测传递的参数是否为数字型
Function Chkrequest(Para)
Chkrequest=False
If Not (IsNull(Para) or Trim(Para)=”” or Not IsNumeric(Para)) Then
Chkrequest=True
End If
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

‘得到当前页面的地址
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables(“HTTPS”)) = “off” Then
strTemp = “https://”
Else
strTemp = “https://”
End If
strTemp = strTemp & CheckStr(Request.ServerVariables(“SERVER_NAME”))
If Request.ServerVariables(“SERVER_PORT”) <> 80 Then strTemp = strTemp & “:” & CheckStr(Request.ServerVariables(“SERVER_PORT”))
strTemp = strTemp & CheckStr(Request.ServerVariables(“URL”))
If Trim(Request.QueryString) <> “” Then strTemp = strTemp & “?” & CheckStr(Trim(Request.QueryString))
GetUrl = strTemp
End Function

‘检查用户是否在浏览器里输入了本页的地址
Function CheckReferer()
Dim sReferer, Icheck
CheckReferer = True
sReferer = Request.ServerVariables(“HTTP_REFERER”)
ServerIP = Request.ServerVariables(“LOCAL_ADDR”)
Icheck = InStr(sReferer, “ServerIP”)
If Icheck = 0 Then
CheckReferer = False
End If
End Function

‘日期格式化
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

end select
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
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((10-1+1)*Rnd + 1)
MakedownName=fname
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 CheckFileExt(FileExt)
Dim ForumUpload,i
ForumUpload=”gif,jpg,bmp,jpeg,png”
ForumUpload=Split(ForumUpload,”,”)
CheckFileExt=False
For i=0 to UBound(ForumUpload)
If LCase(FileExt)=Lcase(Trim(ForumUpload(i))) Then
CheckFileExt=True
Exit Function
End If
Next
End Function

‘格式后缀
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Lcase(UpFileExt)
FixName = Replace(FixName,Chr(0),””)
FixName = Replace(FixName,”.”,””)
FixName = Replace(FixName,”asp”,””)
FixName = Replace(FixName,”asa”,””)
FixName = Replace(FixName,”aspx”,””)
FixName = Replace(FixName,”cer”,””)
FixName = Replace(FixName,”cdx”,””)
FixName = Replace(FixName,”htr”,””)
End Function

‘文件Content-Type判断
Function CheckFileType(FileType)
CheckFileType = False
If Left(Cstr(Lcase(Trim(FileType))),6)=”image/” Then CheckFileType = True
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

‘分离关键词中字符
function splitChar(str)
oldstring=str
newstring=””
oldsign=0
newsign=0
i=len(oldstring)
for j=1 to i
if asc(mid(oldstring,j,1))<0 then
newsign=1
else
newsign=0
end if
if j=1 then
oldsign=newsign
end if
if oldsign=newsign then
newstring=newstring+mid(oldstring,j,1)
else
newstring=newstring+” “+mid(oldstring,j,1)
end if
oldsign=newsign
next
splitChar=newstring
end function

‘突出显示匹配搜索关键词字符
Function dispRed(str,Dstr)
Dstrgroup=Split(Dstr, ” “, -1, 1)
for i=0 to UBound(Dstrgroup)
if InStr(1,str,Dstrgroup(i),1)<>0 then
str1=mid(str,InStr(1,str,Dstrgroup(i),1),len(Dstrgroup(i)))
str=replace(str,Dstrgroup(i),”<font color=red>”&str1&”</font>”,1,-1,1)
end if
next
dispRed=str
end Function

‘URL数据获取
Function getUrl(url)
dim Str
dim Http
dim Arr
set Http=CreateObject(“Microsoft.XMLHTTP”)
Http.open “GET”,url,false
Http.send()
if Http.readystate<>4 then
exit function
end if

Str=bytesToBSTR(Http.responseBody,”GB2312″)
getUrl=Str
set http=nothing
if err.number<>0 then err.Clear
End Function

‘格式化榨取数据
Function BytesToBstr(body,Cset)
dim objstream
set objstream = CreateObject(“adodb.stream”)
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

◆ FSO
’================================================
’函数名：FilesDelete
’作用：FSO删除文件
’参数：filepath —-文件路径
’返回值：False —- True
’================================================
Public Function FileDelete(ByVal FilePath)
On Error Resume Next
FileDelete = False
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FilePath = “” Then Exit Function
If InStr(FilePath, “:”) = 0 Then FilePath = Server.MapPath(FilePath)
If fso.FileExists(FilePath) Then
fso.DeleteFile FilePath, True
FileDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
’================================================
’函数名：FolderDelete
’作用：FSO删除目录
’参数：folderpath —-目录路径
’返回值：False —- True
’================================================
Public Function FolderDelete(ByVal FolderPath)
FolderDelete = False
On Error Resume Next
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If FolderPath = “” Then Exit Function
If InStr(FolderPath, “:”) = 0 Then FolderPath = Server.MapPath(FolderPath)
If fso.FolderExists(FolderPath) Then
fso.DeleteFolder FolderPath, True
FolderDelete = True
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
’================================================
’函数名：CopyToFile
’作用：复制文件
’参数：SoureFile —-原文件路径
’ NewFile —-目标文件路径
’================================================
Public Function CopyToFile(ByVal SoureFile, ByVal NewFile)
On Error Resume Next
If SoureFile = “” Then Exit Function
If NewFile = “” Then Exit Function
If InStr(SoureFile, “:”) = 0 Then SoureFile = Server.MapPath(SoureFile)
If InStr(NewFile, “:”) = 0 Then NewFile = Server.MapPath(NewFile)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FileExists(SoureFile) Then
fso.CopyFile SoureFile, NewFile
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
’================================================
’函数名：CopyToFolder
’作用：复制文件夹
’参数：SoureFolder —-原路径
’ NewFolder —-目标路径
’================================================
Public Function CopyToFolder(ByVal SoureFolder, ByVal NewFolder)
On Error Resume Next
If SoureFolder = “” Then Exit Function
If NewFolder = “” Then Exit Function
If InStr(SoureFolder, “:”) = 0 Then SoureFolder = Server.MapPath(SoureFolder)
If InStr(NewFolder, “:”) = 0 Then NewFolder = Server.MapPath(NewFolder)
Dim fso
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FolderExists(SoureFolder) Then
fso.CopyFolder SoureFolder, NewFolder
End If
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
’=============================================================
’过程名：CreatedTextFile
’作用：创建文本文件
’参数：filename —-文件名
’ body —-主要内容
’=============================================================
Public Function CreatedTextFile(ByVal FileName, ByVal body)
On Error Resume Next
If InStr(FileName, “:”) = 0 Then FileName = Server.MapPath(FileName)
Dim fso,f
Set fso = Server.CreateObject(FSO_ScriptName)
Set f = fso.CreateTextFile(FileName)
f.WriteLine body
f.Close
Set f = Nothing
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
End Function
’================================================
’函数名：Readfile
’作用：读取文件内容
’参数：fromPath —-来源文件路径
’================================================
Public Function Readfile(ByVal fromPath)
On Error Resume Next
Dim strTemp,fso,f
If InStr(fromPath, “:”) = 0 Then fromPath = Server.MapPath(fromPath)
Set fso = Server.CreateObject(FSO_ScriptName)
If fso.FileExists(fromPath) Then
Set f = fso.OpenTextFile(fromPath, 1, True)
strTemp = f.ReadAll
f.Close
Set f = Nothing
End If
Set fso = Nothing
Readfile = strTemp
If Err.Number <> 0 Then Err.Clear
End Function
’================================================
’函数名：FormatDate
’作用：格式化日期
’参数：DateAndTime —-原日期和时间
’ para —-日期格式
’返回值：格式化后的日期
’================================================
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = “0” & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = “0” & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = “0” & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = “0” & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = “0” & s
Select Case para
Case “1”
strDateTime = y & “-” & m & “-” & d & ” ” & h & “:” & mi & “:” & s
Case “2”
strDateTime = y & “-” & m & “-” & d
Case “3”
strDateTime = y & “/” & m & “/” & d
Case “4”
strDateTime = y & “年” & m & “月” & d & “日”
Case “5”
strDateTime = m & “-” & d
Case “6”
strDateTime = m & “/” & d
Case “7”
strDateTime = m & “月” & d & “日”
Case “8”
strDateTime = y & “年” & m & “月”
Case “9”
strDateTime = y & “-” & m
Case “10”
strDateTime = y & “/” & m
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function

’================================================
’函数名：IsValidChar
’作用：判断字符串中是否含有非法字符和中文
’参数：str —-原字符串
’返回值：False,True —–布尔值
’================================================
Public Function IsValidChar(ByVal str)
IsValidChar = False
On Error Resume Next

If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ValidStr
Dim i, l, s, c

ValidStr = “ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~/0123456789″
l = Len(str)
s = UCase(str)
For i = 1 To l
c = Mid(s, i, 1)
If InStr(ValidStr, c) = 0 Then
IsValidChar = False
Exit Function
End If
Next
IsValidChar = True
End Function

’================================================
’函数名：IsValidPassword
’作用：判断密码中是否含有非法字符
’参数：str —-原字符串
’返回值：False,True —–布尔值
’================================================
Public Function IsValidPassword(ByVal str)
IsValidPassword = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = “=and|chr|*|^|%|&|;|,|” & Chr(32) & “|” & Chr(34) & “|” & Chr(39) & “|” & Chr(9)
ForbidStr = Split(ForbidStr, “|”)
For i = 0 To UBound(ForbidStr)
If InStr(1, str, ForbidStr(i), 1) > 0 Then
IsValidPassword = False
Exit Function
End If
Next
IsValidPassword = True
End Function

’================================================
’函数名：IsValidStr
’作用：判断字符串中是否含有非法字符
’参数：str —-原字符串
’返回值：False,True —–布尔值
’================================================
Public Function IsValidStr(ByVal str)
IsValidStr = False
On Error Resume Next
If IsNull(str) Then Exit Function
If Trim(str) = Empty Then Exit Function
Dim ForbidStr, i
ForbidStr = “and|chr|:|=|%|&|$|#|@|+|-|*|/||<|>|;|,|^|” & Chr(32) & “|” & Chr(34) & “|” & Chr(39) & “|” & Chr(9)
ForbidStr = Split(ForbidStr, “|”)
For i = 0 To UBound(ForbidStr)
If InStr(1,str, ForbidStr(i),1) > 0 Then
IsValidStr = False
Exit Function
End If
Next
IsValidStr = True
End Function

’================================================
’函数名：ChkQueryStr
’作用：过虑查询的非法字符
’参数：str —-原字符串
’返回值：过滤后的字符
’================================================
Public Function ChkQueryStr(ByVal str)
On Error Resume Next
If IsNull(str) Then
ChkQueryStr = “”
Exit Function
End If
str = Replace(str, “!”, “”)
str = Replace(str, “]”, “”)
str = Replace(str, “[“, “”)
str = Replace(str, “)”, “”)
str = Replace(str, “(“, “”)
str = Replace(str, “|”, “”)
str = Replace(str, “+”, “”)
str = Replace(str, “=”, “”)
str = Replace(str, “‘”, “””)
str = Replace(str, “%”, “”)
str = Replace(str, “&”, “”)
str = Replace(str, “#”, “”)
str = Replace(str, “^”, “”)
str = Replace(str, ” “, ” “)
str = Replace(str, Chr(37), “”)
str = Replace(str, Chr(0), “”)
ChkQueryStr = str
End Function

’================================================
’函数名：CheckInfuse
’作用：防止SQL注入
’参数：str —-原字符串
’ strLen —-提交字符串长度
’================================================
Public Function CheckInfuse(ByVal str, ByVal strLen)
Dim strUnsafe, arrUnsafe
Dim i

If Trim(str) = “” Then
CheckInfuse = “”
Exit Function
End If
str = Left(str, strLen)

您提交的字符数超过了限制！’);history.back(-1)</Script>”
CheckInfuse = “”
Response.End
End If
arrUnsafe = Split(strUnsafe, “|”)
For i = 0 To UBound(arrUnsafe)
If InStr(1, str, arrUnsafe(i), 1) > 0 Then
Response.Write “<Script Language=JavaScript>alert(‘安全系统提示↓

请不要在参数中包含非法字符！’);history.back(-1)</Script>”
CheckInfuse = “”
Response.End
End If
Next
End If
CheckInfuse = Trim(str)
Exit Function
If Err.Number <> 0 Then
Err.Clear
Response.Write “<Script Language=JavaScript>alert(‘安全系统提示↓

请不要在参数中包含非法字符！’);history.back(-1)</Script>”
CheckInfuse = “”
Response.End
End If
End Function
Public Sub PreventInfuse()
On Error Resume Next
Dim SQL_Nonlicet, arrNonlicet
Dim PostRefer, GetRefer, Sql_DATA

请不要在参数中包含非法字符！’);history.back(-1)</Script>”
Response.End
End If
Next
Next
End If

If Request.QueryString <> “” Then
For Each GetRefer In Request.QueryString
For Sql_DATA = 0 To UBound(arrNonlicet)
If InStr(1, Request.QueryString(GetRefer), arrNonlicet(Sql_DATA), 1) > 0 Then
Response.Write “<Script Language=JavaScript>alert(‘安全系统提示↓

请不要在参数中包含非法字符！’);history.back(-1)</Script>”
Response.End
End If
Next
Next
End If
End Sub

Public Function CheckTopic(ByVal strContent)
Dim re
On Error Resume Next
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = “(<s+cript(.+?)</s+cript>)”
strContent = re.Replace(strContent, “”)
re.Pattern = “(<iframe(.+?)</iframe>)”
strContent = re.Replace(strContent, “”)
re.Pattern = “(>)”
strContent = re.Replace(strContent, “>”)
re.Pattern = “(<)”
strContent = re.Replace(strContent, “<“)
Set re = Nothing
strContent = Replace(strContent, “>”, “>”)
strContent = Replace(strContent, “<“, “<“)
strContent = Replace(strContent, “‘”, “‘”)
strContent = Replace(strContent, Chr(34), “””)
strContent = Replace(strContent, “%”, “％”)
strContent = Replace(strContent, vbNewLine, “”)
CheckTopic = Trim(strContent)
End Function

’================================================
’函数名：ReadTopic
’作用：显示/截取字符串长度
’参数：str —-原字符串
’ strlen —-显示字符长度
’================================================
Public Function ReadTopic(ByVal str, ByVal strLen)
Dim l, t, c, i
On Error Resume Next
str = Replace(str, ” “, ” “)
If Len(str) < strLen Then
str = str & String(strLen – Len(str), “.”)
Else
str = str
End If
l = Len(str)
t = 0
For i = 1 To l
c = Abs(Asc(Mid(str, i, 1)))
If c > 255 Then
t = t + 2
Else
t = t + 1
End If
If t >= strLen Then
ReadTopic = Left(str, i) & “…”
Exit For
Else
ReadTopic = str & “…”
End If
Next
End Function

Function leftString(str,length)
str=trim(str)
x = len(str)
y = 0
if str<length then
if len(str)=0 then exit function
leftString=left(str,length)
exit function
else
for i = 1 to x
if asc(mid(str,i,1)) < 0 or asc(mid(str,i,1)) >255 then
y = y + 2
else
y = y + 1
end if
if y/2>length then
str = left(str,i) ‘”字符串限长
exit for
end if
next
leftString = str
end if
End Function

’================================================
’函数名：strLength
’作用：统计字符串长度
’参数：str —-字符串
’================================================
Public Function strLength(ByVal str)
On Error Resume Next
If IsNull(str) or str = “” Then
strLength = 0
Exit Function
End If
Dim WINNT_CHINESE
WINNT_CHINESE = (Len(“例子”) = 2)
If WINNT_CHINESE Then
Dim l, t
Dim i, c
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
strLength = t
Else
strLength = Len(str)
End If
End Function
’=============================================================
’函数作用：带脏话过滤
’=============================================================
Public Function ChkBadWords(ByVal str)
If IsNull(str) Then Exit Function
Dim i, Bwords, Bwordr
Bwords = Split(Badwords, “|”)
Bwordr = Split(Badwordr, “|”)
For i = 0 To UBound(Bwords)
If i > UBound(Bwordr) Then
str = Replace(str, Bwords(i), “*”)
Else
str = Replace(str, Bwords(i), Bwordr(i))
End If
Next
ChkBadWords = str
End Function
’=============================================================
’函数作用：过滤HTML代码，带脏话过滤
’=============================================================
Public Function HTMLEncode(ByVal fString)
If Not IsNull(fString) Then
fString = Replace(fString, “>”, “>”)
fString = Replace(fString, “<“, “<“)
fString = Replace(fString, Chr(32), ” “)
fString = Replace(fString, Chr(9), ” “)
fString = Replace(fString, Chr(34), “””)
fString = Replace(fString, Chr(39), “‘”)
fString = Replace(fString, Chr(13), “”)
fString = Replace(fString, ” “, ” “)
fString = Replace(fString, Chr(10), “<br /> “)
fString = ChkBadWords(fString)
HTMLEncode = fString
End If
End Function
’=============================================================
’函数作用：过滤HTML代码，不带脏话过滤
’=============================================================
Public Function HTMLEncodes(ByVal fString)
If Not IsNull(fString) Then
fString = Replace(fString, “‘”, “‘”)
fString = Replace(fString, “>”, “>”)
fString = Replace(fString, “<“, “<“)
fString = Replace(fString, Chr(32), ” “)
fString = Replace(fString, Chr(9), ” “)
fString = Replace(fString, Chr(34), “””)
fString = Replace(fString, Chr(39), “‘”)
fString = Replace(fString, Chr(13), “”)
fString = Replace(fString, Chr(10), “<br /> “)
fString = Replace(fString, ” “, ” “)
HTMLEncodes = fString
End If
End Function
’=============================================================
’函数作用：判断发言是否来自外部
’=============================================================
Public Function CheckPost()
On Error Resume Next
Dim server_v1, server_v2
CheckPost = False
server_v1 = CStr(Request.ServerVariables(“HTTP_REFERER”))
server_v2 = CStr(Request.ServerVariables(“SERVER_NAME”))
If Mid(server_v1, 8, Len(server_v2)) = server_v2 Then
CheckPost = True
End If
End Function
’=============================================================
’函数作用：判断来源URL是否来自外部
’=============================================================
Public Function CheckOuterUrl()
On Error Resume Next
Dim server_v1, server_v2
server_v1 = Replace(LCase(Trim(Request.ServerVariables(“HTTP_REFERER”))), “https://“, “”)
server_v2 = LCase(Trim(Request.ServerVariables(“SERVER_NAME”)))
If server_v1 <> “” And Left(server_v1, Len(server_v2)) <> server_v2 Then
CheckOuterUrl = False
Else
CheckOuterUrl = True
End If
End Function

’================================================
’过程名：GetSiteUrl
’作用：取得带端口的URL
’================================================
Public Property Get GetSiteUrl()
If Request.ServerVariables(“SERVER_PORT”) = “80” Then
GetSiteUrl = “https://” & Request.ServerVariables(“server_name”)
Else
GetSiteUrl = “https://” & Request.ServerVariables(“server_name”) & “:” & Request.ServerVariables(“SERVER_PORT”)
End If
End Property
’================================================
’函数名：FormEncode
’作用：过虑提交的表单数据
’参数：str —-原字符串 n —-字符长度
’================================================
Public Function FormEncode(ByVal str, ByVal n)
If Not IsNull(str) And Trim(str) <> “” Then
str = Left(str, n)
str = Replace(str, “>”, “>”)
str = Replace(str, “<“, “<“)
str = Replace(str, “>”, “>”)
str = Replace(str, “<“, “<“)
str = Replace(str, “‘”, “‘”)
str = Replace(str, Chr(34), “””)
str = Replace(str, “%”, “％”)
str = Replace(str, vbNewLine, “”)
FormEncode = Trim(str)
Else
FormEncode = “”
End If
End Function

’=============================================================
’函数名：ChkFormStr
’作用：过滤表单字符
’参数：str —-原字符串
’返回值：过滤后的字符串
’=============================================================
Public Function ChkFormStr(ByVal str)
Dim fString
fString = str
If IsNull(fString) Then
ChkFormStr = “”
Exit Function
End If
fString = Replace(fString, “‘”, “‘”)
fString = Replace(fString, Chr(34), “””)
fString = Replace(fString, Chr(13), “”)
fString = Replace(fString, Chr(10), “”)
fString = Replace(fString, Chr(9), “”)
fString = Replace(fString, “>”, “>”)
fString = Replace(fString, “<“, “<“)
fString = Replace(fString, “%”, “％”)
ChkFormStr = Trim(JAPEncode(fString))
End Function

’=============================================================
’函数作用：过滤SQL非法字符
’=============================================================
Public Function CheckRequest(ByVal str,ByVal strLen)
On Error Resume Next
str = Trim(str)
str = Replace(str, Chr(0), “”)
str = Replace(str, “‘”, “”)
str = Replace(str, “%”, “”)
str = Replace(str, “^”, “”)
str = Replace(str, “;”, “”)
str = Replace(str, “*”, “”)
str = Replace(str, “<“, “”)
str = Replace(str, “>”, “”)
str = Replace(str, “|”, “”)
str = Replace(str, “and”, “”)
str = Replace(str, “chr”, “”)
If Len(str) > 0 And strLen > 0 Then
str = Left(str, strLen)
End If
CheckRequest = str
End Function

’– 移除有害字符
Public Function RemoveBadCharacters(ByVal strTemp)
Dim re
On Error Resume Next
Set re = New RegExp
re.Pattern = “[^sw]”
re.Global = True
RemoveBadCharacters = re.Replace(strTemp, “”)
Set re = Nothing
End Function
’– 去掉HTML标记
Public Function RemoveHtml(ByVal Textstr)
Dim Str,re
Str = Textstr
On Error Resume Next
Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = “<(.[^>]*)>”
Str = re.Replace(Str, “”)
Set re = Nothing
RemoveHtml=Str
End Function
’– 数据库连接
Public Function Execute(Command)
If Not IsObject(Conn) Then ConnectionDatabase
If IsDeBug = 0 Then
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
err.Clear
Set Conn = Nothing
Response.Write “查询数据的时候发现错误，请检查您的查询代码是否正确。<br /><li>”
Response.Write Command
Response.End
End If
Else
Set Execute = Conn.Execute(Command)
End If
SqlQueryNum = SqlQueryNum+1
End Function
’================================================
’过程名：CheckNull
’作用：是否有效值
’================================================
Public Function CheckNull(ByVal sValue)
On Error Resume Next
If IsNull(sValue) Then
CheckNull = False
Exit Function
End If
If Trim(sValue) <> “” And LCase(Trim(sValue)) <> “https://” Then
CheckNull = True
Else
CheckNull = False
End If
End Function
Public Function ChkNull(ByVal str)
On Error Resume Next
If IsNull(str) Then
ChkNull = “”
Exit Function
End If
If Trim(str) <> “” And LCase(Trim(str)) <> “https://” Then
ChkNull = Trim(str)
Else
ChkNull = “”
End If
End Function

‘================================================
‘作用：检查组件是否已经安装
‘参数：strClassString —-组件名
‘返回值：True —-已经安装
‘ False —-没有安装
‘================================================
Function IsObjInstalled(ByVal strClassString)
Dim xTestObj,ClsString
On Error Resume Next
IsObjInstalled = False
ClsString = strClassString
Err = 0
Set xTestObj = Server.CreateObject(ClsString)
If Err = 0 Then IsObjInstalled = True
If Err = -2147352567 Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
Exit Function
End Function

‘================================================
‘ 函数名：CreatePath
‘ 作用：按月份自动创建文件夹
‘ 参数：fromPath —-原文件夹路径
‘================================================
Function CreatePath(fromPath)
Dim objFSO, uploadpath
uploadpath = Year(Now) & “-” & Month(Now) ‘以年月创建上传文件夹，格式：2003－8
On Error Resume Next
Set objFSO = CreateObject(Newasp.FSO_ScriptName)
If objFSO.FolderExists(Server.MapPath(fromPath & uploadpath)) = False Then
objFSO.CreateFolder Server.MapPath(fromPath & uploadpath)
End If
If Err.Number = 0 Then
CreatePath = uploadpath & “/”
Else
CreatePath = “”
End If
Set objFSO = Nothing
End Function

‘================================================
‘作用：输出错误警告脚本
‘参数：str —-参数入口
‘返回值：警告信息
‘================================================
Sub OutAlertScript(str)
Response.Write “<script language=javascript>” & vbcrlf
Response.Write “alert(‘” & str & “‘);”
Response.Write “history.back()” & vbcrlf
Response.Write “</script>” & vbcrlf
Response.End
End Sub
Sub OutHintScript(str)
Response.Write “<script language=JavaScript>” & vbCrLf
Response.Write “alert(‘” & str & “‘);”
Response.Write “location.replace(‘” & Request.ServerVariables(“HTTP_REFERER”) & “‘)” & vbCrLf
Response.Write “</script>” & vbCrLf
Response.End
End Sub
Sub OutputScript(str,url)
Response.Write “<script language=JavaScript>” & vbCrLf
Response.Write “alert(‘” & str & “‘);”
Response.Write “location.replace(‘” & url & “‘)” & vbCrLf
Response.Write “</script>” & vbCrLf
Response.End
End Sub

‘================================================
‘过程名：PreventRefresh
‘作用：防止刷新页面
‘================================================
Sub PreventRefresh()
Dim RefreshTime,isRefresh
RefreshTime = 10 ‘防止刷新时间,单位（秒）
isRefresh = 1 ‘是否使用防刷新功能，0=否，1=是
If isRefresh = 1 Then
If (Not IsEmpty(Session(“RefreshTime”))) And RefreshTime > 0 Then
If DateDiff(“s”, Session(“RefreshTime”), Now()) < RefreshTime Then
Response.Write “<META http-equiv=Content-Type content=text/html; chaRset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT=”&RefreshTime&”><br>本页面起用了防刷新机制，请不要在”&RefreshTime&”秒内连续刷新本页面<BR>正在打开页面，请稍后……”
Response.End
Else
Session(“RefreshTime”) = Now()
End If
Else
Session(“RefreshTime”) = Now()
End If
End If
End Sub

‘–读取一个文件相关信息–
function fileInfo()
Dim objFSO,objFile,filename
‘声明一个名称为 objFSO 的变量以存放对象实例
filename=Server.MapPath(“newfile.asp”)
Set objFSO = Server.CreateObject(“Scripting.FileSystemObject”)
If objFSO.FileExists(filename) Then
Set objFile = objFSO.GetFile(filename)
Response.Write “文件的名称：”&objFile.Name&”<br>”
Response.Write “文件的路径：”&objFile.Path&”<br>”
Response.Write “文件的建立日期：”&objFile.DateCreated&”<br>”
Response.Write “文件的最后浏览日期：”&objFile.DateLastAccessed&”<br>”
Response.Write “文件的最后修改日期：”&objFile.DateLastModified&”<br>”
Response.Write “文件的大小：”&objFile.Size&”<br>”
Response.Write “文件的类型：”&objFile.Type&”<br>”
Response.Write “文件的属性：”&objFile.Attributes&”<br>”
Response.Write “文件的所在的驱动器：”&objFile.Drive&”<br>”
Response.Write “文件的所在的文件夹：”&objFile.ParentFolder&”<br>”
Else
Response.Write filename&”不存在，无法读取相关信息”
End If
Set objFile = Nothing
Set objFSO = Nothing ‘释放 FileSystemObject 对象实例内存空间
end function

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 ReplaceBadChar(strChar)
if strChar=”” then
ReplaceBadChar=””
else
ReplaceBadChar=replace(replace(replace(replace(replace(replace(replace(strChar,”‘”,””),”*”,””),”?”,””),”(“,””),”)”,””),”<“,””),”.”,””)
end if
end function
‘—生成静态页面—
if SaveFile(“/default.htm”,”https://localhost/default.asp”) then
Response.write “ASP生成静态页面已经成功!”
else
Response.write “对不起,失败!没有生成!”
end if

function SaveFile(LocalFileName,RemoteFileUrl)
Dim Ads, Retrieval, GetRemoteData
On Error Resume Next
Set Retrieval = Server.CreateObject(“Microso”&”ft.XM”&”LHTTP”)
With Retrieval
.Open “Get”, RemoteFileUrl, False, “”, “”
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject(“Ado” & “db.Str” & “eam”)
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile Server.MapPath(LocalFileName), 2
.Cancel()
.Close()
End With
Set Ads=nothing
if err <> 0 then
SaveFile = false
err.clear
else
SaveFile = true
end if
End function

Sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
On Error Resume Next
Dim StreamObj,Retrieval,GetRemoteData,TempHTTPObj
TempHTTPObj = “MSXML2.XMLHTTP”
Set Retrieval = Server.CreateObject(TempHTTPObj)
With Retrieval
.Open “Get”, RemoteFileUrl, False, “”, “”
.Send
if Err.Number <> 0 then
Err.Clear
Set Retrieval = Nothing
Exit Sub
end if
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set StreamObj = Server.CreateObject(“Adodb.Stream”)
With StreamObj
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile Server.MapPath(LocalFileName),2
.Cancel()
.Close()
End With
Set StreamObj = Nothing
End Sub

Function GetDoMain()
Dim TempPath
if Request.ServerVariables(“SERVER_PORT”)=”80″ then
GetDoMain = Request.ServerVariables(“SERVER_NAME”)
else
GetDoMain = Request.ServerVariables(“SERVER_NAME”) & “:” & Request.ServerVariables(“SERVER_PORT”)
end if
TempPath = Request.ServerVariables(“APPL_MD_PATH”)
TempPath = Right(TempPath,Len(TempPath)-InStr(TempPath,”Root”)-3)
GetDoMain = “https://” & GetDoMain & TempPath
End Function

Function GetCurrentPath()
Dim TempPath,Path
TempPath = Request.ServerVariables(“Path_info”)
Path = Left(TempPath,InstrRev(TempPath,”/”))
GetCurrentPath = GetDoMain & Path
End Function

Function GetVirtualPath()
GetVirtualPath = Request.ServerVariables(“APPL_MD_PATH”)
GetVirtualPath = Right(GetVirtualPath,Len(GetVirtualPath)-InStr(GetVirtualPath,”Root”)-3)
End Function

Function NoCSSHackAdmin(Str,StrTittle) ‘过滤跨站脚本和HTML标签
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Pattern = “<|>| “
If regEx.Test(LCase(Str)) Then
Response.Write “<script>alert(‘”& StrTittle &”含有非法字符(<,>,tab)’);history.back();</script>”
Response.End
End If
Set regEx = Nothing
NoCSSHackAdmin = Str
End Function
Function NoCSSHackInput(Str) ‘过滤跨站脚本和HTML标签
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Pattern = “<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval| “
If regEx.Test(LCase(Str)) Then
Response.Write “<script>alert(‘你的输入含有非法字符(<,>,tab,script等)，请检查后再提交！’);history.back();</script>”
Response.End
End If
Set regEx = Nothing
NoCSSHackInput = Str
End Function
Function NoCSSHackContent(Str) ‘过滤跨站脚本，只过滤脚本，对HTML不过滤
Dim regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Pattern = “(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|(url()|eval”
If regEx.Test(LCase(Str)) Then
Response.Write “<script>alert(‘你提交的内容含有非法字符(不能包含脚本)，请检查后再提交！’);history.back();</script>”
Response.End
End If
Set regEx = Nothing
NoCSSHackContent = Str
End Function

‘字符验证
Function CheckRegExp(patrn,strng)
Dim regEx
Set regEx=New RegExp ‘建立一个新对像
regEx.Pattern=patrn’设置模板
regEx.IgnoreCase=true’搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True ‘搜索是否应用于整个字符串
if patrn.test(strng) then
CheckInsert=TRUE ‘返回函数结果
else
CheckInsert=FALSE
end if
Set regEx=nothing
end function

‘UBB替换 ,例 : checkexp(re,str,”>”)
Function CheckExpReplace(patrn,strng,tagstr)
’Dim regEx,Matches
Set regEx=New RegExp’建立一个新对像
regEx.Pattern=patrn’设置模板
regEx.IgnoreCase=true’搜索是否区分大小写的 true表是不区分 flase表示区分
regEx.Global=True’搜索是否应用于整个字符串
Matches=regEx.replace(strng,tagstr)’匹配并替代字符串
CheckExp=Matches返回函数结果
end function

‘—得到本周一的日期—
Function GetBeforeDate()
for i=1 to 7
if weekday(date,2)=i then BeforeDate=(Date-i+1) end if
next
GetBeforeDate=BeforeDate
End Function

‘—得到操作系统—
Function GetSystem()
Dim System
System = Request.ServerVariables(“HTTP_USER_AGENT”)
if Instr(System,”Windows NT 5.2″) then
System = “Win2003″
elseif Instr(System,”Windows NT 5.0″) then
System=”Win2000″
elseif Instr(System,”Windows NT 5.1″) then
System = “WinXP”
elseif Instr(System,”Windows NT”) then
System = “WinNT”
elseif Instr(System,”Windows 9″) then
System = “Win9x”
elseif Instr(System,”unix”) or instr(System,”linux”) or instr(System,”SunOS”) or instr(System,”BSD”) then
System = “类Unix”
elseif Instr(System,”Mac”) then
System = “Mac”
else
System = “Other”
end if
GetSystem=System
End Function

‘—从数据库中读取图片（可多个）删除—
Sub delPic(id)
dim rs,i,formPath,objFSO,arrays
set rs=conn.execute(“select picURL from DBclass where id in (“&id&”)”)
if not rs.eof then arrays=rs.getrows(-1)
if isarray(arrays) then
for i=0 to ubound(arrays,2)
formPath=”../uploadpic/”&””&arrays(0,i)
formPath=server.MapPath(formPath)
Set objFSO = Server.CreateObject(“Scripting.FileSystemObject”)
If objFSO.FileExists(formPath) Then objFSO.DeleteFile formPath,true
set objFSO=nothing
next
arrays=Null
end if
End Sub
‘=====调用XSMXL2.XMLHTTP来进行远程抓取开始=====
call img(“https://www.kun.com/girl.gif”,”../pic/woman.gif”)

‘函数1 获得图片的内容
function getHTTPPage(url)
on error resume next
dim http
set http=server.createobject(“MSXML2.XMLHTTP”)’使用xmlhttp的方法来获得图片的内容
Http.open “GET”,url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=Http.responseBody
set http=nothing
if err.number<>0 then err.Clear
end function

‘函数2 对数据进行保存
function img(from,tofile)
dim geturl,objStream,imgs
geturl=trim(from)
imgs=getHTTPPage(geturl)
Set objStream = Server.CreateObject(“ADODB.Stream”)
objStream.Type =1
objStream.Open
objstream.write imgs
objstream.SaveToFile server.mappath(tofile),2
objstream.Close()
set objstream=nothing
end function
‘=====调用XSMXL2.XMLHTTP来进行远程抓取结束=====

‘=========传统分页方法(适应于小量)============
‘=========传统分页方法(适应于小量)============
‘=========传统分页方法(适应于小量)============
dim currentpage ‘–当前页
dim totalrecords ‘–总记录数
dim totalpages ‘–总页数
dim currentrecords ‘–当页显示记录数
dim cirNumber ‘–循环读取次数
currentpage=trim(request.QueryString(“page”))
currentrecords=10 ‘–每页显示条数
totalrecords=rs.recordcount ‘–总记录数
if totalrecords mod currentrecords =0 then
totalpages=totalrecordscurrentrecords
else
totalpages=totalrecordscurrentrecords+1
end if
if not isnumeric(currentpage) or currentpage=”” then
currentpage=1
else
currentpage=cint(currentpage)
end if
if currentpage>totalpages then currentpage=totalpages

if totalpages>1 and currentpage<totalpages then
cirNumber=currentrecords
elseif totalpages=1 or currentpage=totalpages then
cirNumber=totalrecords mod currentrecords
end if
rs.move (currentpage-1)*currentrecords

‘for i=1 to cirNumber
”””
‘next

‘–上下分页–
sub GetPageList(str)
response.write(“<div style=’font-size:12px;padding-top:10px;text-align:center’>[“)
if currentpage>1 then
response.Write(“<a href=’?page=1″&str&”‘>首页</a> “)
response.write(“<a href=’?page=”¤tpage-1&str&”‘>上一页</a> “)
else
response.Write(“首页 “)
response.write(“上一页 “)
end if

if currentpage<totalpages then
response.write(“<a href=’?page=”¤tpage+1&””&str&”‘>下一页</a> “)
response.write(“<a href=’?page=”&totalpages&str&”‘>尾页</a>”)
else
response.write(“下一页 “)
response.write(“尾页”)
end if
response.write(“] 共”&totalpages&”页, 共”&totalrecords&”条信息, 当前第<font color=’red’>”¤tpage&”</font>, 当前有”&cirNumber&”条信息”)
response.write(“</div>”)

‘–数字分页–
sub GetPageList(str)
dim gopage,blockPage,i
gopage=currentpage
blockPage=int((gopage-1)/10)*10+1
response.Write(“<div style=’text-align:center;padding-top:5px;padding-bottom:5px;font-size:13px’>”)
if blockPage = 1 Then
Response.Write (“<span disabled>【←前10页</span> “)
Else
Response.Write(“<span disabled>【</span><a href=’?page=”&blockPage-10&””&str&”‘>←前10页</a> “)
End If
i=1
Do Until i > 10 or blockPage > totalpages
If blockPage=clng(gopage) Then
Response.Write(“<font color=’#FF0000′>[<strong>”&blockPage&”</strong>]</font> “)
Else
Response.Write(“<a href=’?page=”&blockPage&””&str&”‘ style=’font-size:14px’>[“&blockPage&”]</a> “)
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpages Then
Response.Write (“<span disabled>后10页→】”)
Else
Response.Write(“<a href=’?page=”&blockPage&””&str&”‘>后10页→</a><span disabled>】”)
End If
Response.Write(“</span></div><div style=’padding-top:5px;text-align:center;’>共”&totalpages&”页 , 当前”&cirNumber&”条信息 , 共”&totalrecords&”条信息</div><br></div>”)
end sub

‘–按钮分页–
Public Sub GetPageList(str)
If currentpage > 1 Then
response.write “<input type=’button’ value=’首页’ onclick=””window.location=’?page=1′””> “
Response.write “<input type=’button’ value=’上一页’ onclick=””window.location=’?page=”¤tpage-1&””&str&”‘””> “
Else
Response.write “<input type=’button’ value=’首页’ disabled> “
Response.write “<input type=’button’ value=’上一页’ disabled> “
End if
If currentpage < totalpages Then
Response.write “<input type=’button’ value=’下一页’ onclick=””location.href=’?page=”¤tPage+1&””&str&”‘””> “
Response.write “<input type=’button’ value=’尾页’ onclick=””location.href=’?page=”&totalpages&””&str&”‘””>”
Else
Response.write “<input type=’button’ value=’下一页’ disabled> “
Response.write “<input type=’button’ value=’尾页’ disabled>”
End if
End Sub

‘—跳转、数字分页—
Function GetPageList(LinkFile)
if not (rs.eof and rs.bof) then
gopage=currentpage
totalpage=n
blockPage=Int((gopage-1)/10)*10+1
If LCase(Request.ServerVariables(“HTTPS”)) = “off” Then
strTemp = “https://”
Else
strTemp = “https://”
End If
strTemp = strTemp & CheckStr(Request.ServerVariables(“SERVER_NAME”))
If Request.ServerVariables(“SERVER_PORT”) <> 80 Then strTemp = strTemp & “:” & CheckStr(Request.ServerVariables(“SERVER_PORT”))
strTemp = strTemp & CheckStr(Request.ServerVariables(“URL”))
lenstrTemp=len(strTemp)+1
if instr(left(linkfile,lenstrTemp),”?”)>0 then

if blockPage = 1 Then
Response.Write “<span disabled>前10页</span> “
Else
Response.Write(“<a href=” & LinkFile & “&page=”&blockPage-10&”>前10页</a> “)
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write(“<font color=#FF0000><b>”&blockPage&”</b></font>”)
Else
Response.Write(” <a href=” & LinkFile & “&page=”&blockPage&”>”&blockPage&”</a> “)
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write ” <span disabled>后10页”
Else
Response.Write(” <a href=” & LinkFile & “&page=”&blockPage&”>后10页</a><span disabled>”)
End If
response.write” 直接到第 “
response.write”<select onchange=if(this.options[this.selectedIndex].value!=”){location=this.options[this.selectedIndex].value;}>”
for i=1 to totalpage
response.write”<option value=’” & LinkFile & “&page=” & i & “‘”
if i=gopage then response.write”selected”
response.write”>”&i&”</option>”
next
response.write”</select>”
response.write” 页<Br><Br>”
else
if blockPage = 1 Then
Response.Write “<span disabled>【←前10页</span> “
Else
Response.Write(“<span disabled>【</span><a href=” & LinkFile & “?page=”&blockPage-10&”>←前10页</a> “)
End If
i=1
Do Until i > 10 or blockPage > n
If blockPage=int(gopage) Then
Response.Write(“<font color=#FF0000>[<b>”&blockPage&”</b>]</font>”)
Else
Response.Write(” <a href=” & LinkFile & “?page=”&blockPage&”>[“&blockPage&”]</a> “)
End If
blockPage=blockPage+1
i = i + 1
Loop
if blockPage > totalpage Then
Response.Write ” <span disabled>后10页→】”
Else
Response.Write(” <a href=” & LinkFile & “?page=”&blockPage&”>后10页→</a><span disabled>】”)
End If
response.write” 直接到第 “
response.write”<select onchange=if(this.options[this.selectedIndex].value!=”){location=this.options[this.selectedIndex].value;}>”
for i=1 to totalpage
response.write”<option value=’” & LinkFile & “?page=” & i & “‘”
if i=gopage then response.write”selected”
response.write”>”&i&”</option>”
next
response.write”</select>”
response.write” 页<Br><Br>”
End If
Startinfo=((gopage-1)*msg_per_page)+1
Endinfo=gopage*msg_per_page
if Endinfo>totalrec then Endinfo=totalrec
Response.Write(” 共 “&totalrec&” 条信息当前显示第 “&Startinfo&” – “&Endinfo&” 条每页 “&msg_per_page&” 条信息共 “&n&” 页”)
end if
End Function

‘==============================附加===================================

‘利用ASP获得图象的实际尺寸的示例
HW = ReadImg(graphic)
Response.Write (“高X宽: ” & HW(0) & “x” & HW(1))

‘—开始—
Dim HW
Function AscAt(s, n)
AscAt = Asc(Mid(s, n, 1))
End Function

Function HexAt(s, n)
HexAt = Hex(AscAt(s, n))
End Function

Function isJPG(fichero)
If inStr(uCase(fichero), “.JPG”) <> 0 Then
isJPG = true
Else
isJPG = false
End If
End Function

Function isPNG(fichero)
If inStr(uCase(fichero), “.PNG”) <> 0 Then
isPNG = true
Else
isPNG = false
End If
End Function

Function isGIF(fichero)
If inStr(uCase(fichero), “.GIF”) <> 0 Then
isGIF = true
Else
isGIF = false
End If
End Function

Function isBMP(fichero)
If inStr(uCase(fichero), “.BMP”) <> 0 Then
isBMP = true
Else
isBMP = false
End If
End Function

Function isWMF(fichero)
If inStr(uCase(fichero), “.WMF”) <> 0 Then
isWMF = true
Else
isWMF = false
End If
End Function

Function isWebImg(f)
If isGIF(f) or isJPG(f) or isPNG(f) or isBMP(f) or isWMF(f)
Then
isWebImg = true
Else
isWebImg = true
End If
End Function

Function ReadImg(fichero)
If isGIF(fichero) Then
ReadImg = ReadGIF(fichero)
Else
If isJPG(fichero) Then
ReadImg = ReadJPG(fichero)
Else
If isPNG(fichero) Then
ReadImg = ReadPNG(fichero)
Else
If isBMP(fichero) Then
ReadImg = ReadPNG(fichero)
Else
If isWMF(fichero) Then
ReadImg = ReadWMF(fichero)
Else
ReadImg = Array(0,0)
End If
End If
End If
End If
End If
End Function

Function ReadJPG(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array(“”,””)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.OpenTextFile(Server.MapPath(“/” & fichero), 1)
s = Right(ts.Read(167), 4)
HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
HW(1) = HexToDec(HexAt(s,1) & HexAt(s,2))
ts.Close
ReadJPG = HW
End Function

Function ReadPNG(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array(“”,””)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.OpenTextFile(Server.MapPath(“/” & fichero), 1)
s = Right(ts.Read(24), 8)
HW(0) = HexToDec(HexAt(s,3) & HexAt(s,4))
HW(1) = HexToDec(HexAt(s,7) & HexAt(s,8))
ts.Close
ReadPNG = HW
End Function

Function ReadGIF(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array(“”,””)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.OpenTextFile(Server.MapPath(“/” & fichero), 1)
s = Right(ts.Read(10), 4)
HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))
HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))
ts.Close
ReadGIF = HW
End Function

Function ReadWMF(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array(“”,””)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.OpenTextFile(Server.MapPath(“/” & fichero), 1)
s = Right(ts.Read(14), 4)
HW(0) = HexToDec(HexAt(s,2) & HexAt(s,1))
HW(1) = HexToDec(HexAt(s,4) & HexAt(s,3))
ts.Close
ReadWMF = HW
End Function

Function ReadBMP(fichero)
Dim fso, ts, s, HW, nbytes
HW = Array(“”,””)
Set fso = CreateObject(“Scripting.FileSystemObject”)
Set ts = fso.OpenTextFile(Server.MapPath(“/” & fichero), 1)
s = Right(ts.Read(24), 8)
HW(0) = HexToDec(HexAt(s,4) & HexAt(s,3))
HW(1) = HexToDec(HexAt(s,8) & HexAt(s,7))
ts.Close
ReadBMP = HW
End Function

Function isDigit(c)
If inStr(“0123456789″, c) <> 0 Then
isDigit = true
Else
isDigit = false
End If
End Function

Function isHex(c)
If inStr(“0123456789ABCDEFabcdef”, c) <> 0 Then
isHex = true
Else
ishex = false
End If
End Function

Function HexToDec(cadhex)
Dim n, i, ch, decimal
decimal = 0
n = Len(cadhex)
For i=1 To n
ch = Mid(cadhex, i, 1)
If isHex(ch) Then
decimal = decimal * 16
If isDigit(c) Then
decimal = decimal + ch
Else
decimal = decimal + Asc(uCase(ch)) – Asc(“A”)
End If
Else
HexToDec = -1
End If
Next
HexToDec = decimal
End Function
<table width=”95%” cellspacing=”1″ cellpadding=”5″ align=center bgcolor=999999>
<tr bgcolor=#ffcc00><td colspan=”2″ height=25><b>服务器有关的变量</b></td></tr>
<tr bgcolor=#efefef><td valign=top>显示客户发出的所有HTTP标题</td><td><%=request.ServerVariables(“All_Http”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>检取ISAPIDLL的metabase路径</td><td><%=request.ServerVariables(“APPL_MD_PATH”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>显示站点物理路径</td><td><%=request.ServerVariables(“APPL_PHYSICAL_PATH”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>路径信息</td><td><%=request.ServerVariables(“PATH_INFO”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>显示请求机器IP地址</td><td><%=request.ServerVariables(“REMOTE_ADDR”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>服务器IP地址</td><td><%=Request.ServerVariables(“LOCAL_ADDR”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>显示执行SCRIPT的虚拟路径</td><td><%=request.ServerVariables(“SCRIPT_NAME”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>返回服务器的主机名，DNS别名，或IP地址</td><td><%=request.ServerVariables(“SERVER_NAME”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>返回服务器处理请求的端口</td><td><%=request.ServerVariables(“SERVER_PORT”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>协议的名称和版本</td><td><%=request.ServerVariables(“SERVER_PROTOCOL”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>服务器的名称和版本</td><td><%=request.ServerVariables(“SERVER_SOFTWARE”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>服务器操作系统</td><td><%=Request.ServerVariables(“OS”)%></td></tr>
<tr bgcolor=#efefef><td valign=top>脚本超时时间</td><td><%=Server.ScriptTimeout%> 秒</td></tr>
<tr bgcolor=#efefef><td valign=top>服务器CPU数量</td><td><%=Request.ServerVariables(“NUMBER_OF_PROCESSORS”)%> 个</td></tr>
<tr bgcolor=#efefef><td valign=top width=30%>服务器解译引擎</td><td><%=ScriptEngine & “/”& ScriptEngineMajorVersion &”.”&ScriptEngineMinorVersion&”.”& ScriptEngineBuildVersion %></td></tr>
</table>

转载请注明：TUTERM.COM » ASP实用功能

与本文相关的文章

您必须登录才能发表评论！

与本文相关的文章

您必须 登录 才能发表评论！

您必须登录才能发表评论！