高手推荐的有用的ASP函数集合(3)
网络整理 - 08-30
Function ShowRsArr(rsArr) '用表格显示记录集getrows生成的数组的表结构 showHtml="<table width=100% border=1 cellspacing=0 cellpadding=0>"
If Not IsEmpty(rsArr) Then
For y=0 To Ubound(rsArr,2)
showHtml=showHtml&"<tr>"
for x=0 to Ubound(rsArr,1)
showHtml=showHtml& "<td>"&rsArr(x,y)&"</td>"
next
showHtml=showHtml&"</tr>"
next
Else
RshowHtml=showHtml&"<tr>"
showHtml=showHtml&"<td>No Records</td>"
showHtml=showHtml&"</tr>"
End If
showHtml=showHtml&"</table>"
ShowRsArr=showHtml
End Function
'-----------------------------------------外接组件使用函数↓------------------------------------------
Function sendMail(to_Email,from_Email,from_Name,mail_Subject,mail_Body,mail_htmlBody) 'Jmail 发送邮件
Set vibo_mail = Server.CreateObject("JMAIL.Message") '建立发送邮件的对象
vibo_mail.silent = true '屏蔽例外错误，返回FALSE跟TRUE两值j
vibo_mail.logging = true '启用邮件日志
vibo_mail.Charset = "gb2312" '邮件的文字编码为国标
'vibo_mail.ContentType = "text/html" '邮件的格式为HTML格式
'vibo_mail.Prority = 1 '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
vibo_mail.AddRecipient to_Email '邮件收件人的地址
vibo_mail.From = from_Email '发件人的E-MAIL地址
vibo_mail.FromName = from_Name '发件人姓名
vibo_mail.MailServerUserName = "system@aaa.com" '登录邮件服务器所需的用户名
vibo_mail.MailServerPassword = "asdasd" '登录邮件服务器所需的密码
vibo_mail.Subject = mail_Subject '邮件的标题
vibo_mail.Body = mail_Body '正文
vibo_mail.HTMLBody = mail_htmlBody 'HTML正文
vibo_mail.ReturnReceipt = True
vibo_mail.Send("smtp.263xmail.com") '执行邮件发送（通过邮件服务器地址）
vibo_mail.Close()
set vibo_mail=nothing
End Function
'---------------------------------------程序执行时间检测↓----------------------------------------------
EndTime=Timer()
If EndTime<StartTime Then
EndTime=EndTime+24*3600
End if
runTime=(EndTime-StartTime)*1000
Response.Write("------------程序执行时间检测------------"&"<br>")
Response.Write("程序执行时间"&runTime&"毫秒")
'-----------------------------------------系统检测使用函数↓------------------------------------------
'---------------------检测网页是否有效-----------------------
Function IsValidUrl(url)
Set xl = Server.CreateObject("Microsoft.XMLHTTP")
xl.Open "HEAD",url,False
xl.Send
IsValidUrl = (xl.status=200)
End Function
'If IsValidUrl(""&fileurl&"") Then
' response.redirect fileurl
'Else
' Response.Write "由于下载用户过多,程序检测到文件暂时无法下载,请更换其他下载地址!感谢您对本软件网站的支持哦^_^"
'End If
'------------------检查某一目录是否存在-------------------
Function getHTMLPage(filename) '获取文件内容
Dim fso,file
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set File=fso.OpenTextFile(server.mappath(filename))
showHtml=File.ReadAll
File.close
Set File=nothing
Set fso=nothing
getHTMLPage=showHtml '输出
End function
Function CheckDir(FolderPath)
dim fso
folderpath=Server.MapPath(".")&"\"&folderpath
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FolderPath) then
'存在
CheckDir = True
Else
'不存在
CheckDir = False
End if
Set fso = nothing
End Function
Function CheckFile(FilePath) '检查某一文件是否存在
Dim fso
Filepath=Server.MapPath(FilePath)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(FilePath) then
'存在
CheckFile = True
Else
'不存在
CheckFile = False
End if
Set fso = nothing
End Function
'-------------根据指定名称生成目录---------
Function MakeNewsDir(foldername)
dim fso,f
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(foldername)
MakeNewsDir = True
Set fso = nothing
End Function
Function CreateHTMLPage(filename,FileData,C_mode) '生成文件
if C_mode=0 then '使用FSO生成
Dim fso,txt
Set fso = CreateObject("Scripting.FileSystemObject")
Filepath=Server.MapPath(filename)
if CheckFile(filename) then fso.DeleteFile Filepath,True '防止续写
Set txt=fso.OpenTextFile(Filepath,8,True)
txt.Write FileData
txt.Close
Set fso = nothing
elseif C_mode=1 then '使用Stream生成
Dim viboStream
On Error Resume Next
Set viboStream = Server.createObject("ADODB.Stream")
If Err.Number=-2147221005 Then
Response.Write "<divfont-size:12px;font-family:Tahoma;"">非常遗憾,您的主机不支持ADODB.Stream,不能使用本程序</div>"
Err.Clear
Response.End
End If
With viboStream
.Type = 2
.Open
.CharSet = "GB2312"
.Position = objStream.Size
.WriteText = FileData
.SaveToFile Server.MapPath(filename),2
.Close
End With
Set viboStream = Nothing
end if
Response.Write "<divfont-size:12px;font-family:Tahoma;"">恭喜!文件 <a href="""&filename&""" target=""_blank""font-weight: bold;color: #FF0000;"">"&filename&"</a> 已经生成完毕!...</div>"
Response.Flush()
End Function
Function CheckBadWord(byVal ChkStr)'过滤脏字
Dim Str:Str = ChkStr
Str = Trim(Str)
If IsNull(Str) Then
CheckBadWord = ""
Exit Function
End If
DIC = getHTMLPage("include/badWord.txt")'载入脏字词典
DICArr = split(DIC,CHR(10))
For i =0 To Ubound(DICArr )
WordDIC = split(DICArr(i),"=")
Str = Replace(Str,WordDIC(0),WordDIC(1))
next
CheckBadWord = Str
End function
%>
读取文件内容：
'-------------------------------------------------
'函数名称:ReadTextFile
'作用:利用AdoDb.Stream对象来读取UTF-8格式的文本文件
'----------------------------------------------------
Function ReadFromTextFile (FileUrl,CharSet)
dim str
set stm=server.CreateObject("adodb.stream")
stm.Type=2 '以本模式读取
stm.mode=3
stm.charset=CharSet
stm.open
stm.loadfromfile server.MapPath(FileUrl)
str=stm.readtext
stm.Close
set stm=nothing
ReadFromTextFile=str
End Function
写文件内容：
'-------------------------------------------------
'函数名称:WriteToTextFile
'作用:利用AdoDb.Stream对象来写入UTF-8格式的文本文件
'----------------------------------------------------
Sub WriteToTextFile (FileUrl,byval Str,CharSet)
set stm=server.CreateObject("adodb.stream")
stm.Type=2 '以本模式读取
stm.mode=3
stm.charset=CharSet
stm.open
stm.WriteText str
stm.SaveToFile server.MapPath(FileUrl),2
stm.flush
stm.Close
set stm=nothing
End Sub