fso.asp

功能最强大的ASP网站

<%
'利用FSO直接读取模板
function fsow(filename)
set mfo=Server.CreateObject("Scripting.FileSystemObject")
set rtf=mfo.OpenTextFile(server.mappath(filename),1)
body=rtf.readall
fsow=body
end function
%>


<%
'生成文件夹
function CreateFolder(Folder)
	Dim Fso, F
	Set Fso = Server.CreateObject("Scripting.FileSystemObject")
	If Fso.FolderExists(Server.MapPath(Folder)) Then Exit function
	Set F = Fso.CreateFolder(Server.MapPath(Folder))
	Set F = Nothing
	Set Fso = Nothing
        CreateFolder=Folder
End function
%>

<%
'--------------以日期为文件名
function gettimefilename(d)
dim datetime,date1
datetime=cstr(d)
date1=datetime
gettimefilename=year(date1)&month(date1)&day(date1)
end function
%>
<%
'以时间日期为文件名
function getfilename(d)
dim datetime
datetime=cstr(d)
dim date1,time1
date1=split(d," ")(0)
time1=split(d," ")(1)
getfilename=year(date1)&month(date1)&day(date1)&hour(time1)&minute(time1)&second(time1)
end function
%>
<%
'********************************************
'函数名：IsValidEmail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'       False ----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
%>
<%
'***************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'       False ----没有安装
'***************************************************
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

'***************************************************
%>
<%
'***************************************************
'函数名：OkMsg
'作  用：显示成功信息
'参  数：message ----成功消息的内容
'	url ----成功后转入的URL地址
'返回值：无
'***************************************************
Sub OkMsg(message,url)
	Response.Write ("<script>alert('"&message&"');window.location.href='"&url&"';</script>")
	Response.End
End Sub
%>
<%
'***************************************************
'函数名：ErrorMsg
'作  用：显示出错信息
'参  数：message ----错误消息的内容
'返回值：无
'***************************************************
Sub ErrorMsg(message)
	Response.Write ("<script>alert('"&message&"');history.back();</script><script>window.close();</script>")
	Response.End
End Sub
%>
<%
'***************************************************
'函数名：HTMLEncode
'作  用：替换字符串
'参  数：fString ----要替换的字符串
'返回值：替换成功的安符串
'***************************************************
Function HTMLEncode(fString)
	fString=Trim(fString)
	fString=server.htmlencode(fString)
	fString=Replace(fString,"'","&#39;")
	fString=Replace(fString,"""","&#34;")
	fString=replace(fString,"\","&#92;")
	fString=replace(fString,"'","&#39;")
	fString=replace(fString,"--","&#45;&#45;")
	fString=replace(fString,vbCrlf,"<br>")
	fString=replace(fString,"	","")
	HTMLEncode=fString
End Function
%>
<%
'***************************************************
'函数名：OutWrite
'作  用：传入要打印在页面的数据
'参  数：str ----要打印在页面的数据
'返回值：无
'***************************************************
Function OutWrite(str)
	Response.Write str
End Function

'***************************************************
%>
<%
'***************************************************
'函数名：OutUrl
'作  用：转入一个新的页面
'参  数：Url ----要转入的页面
'返回值：无
'***************************************************
'''''''''''Response.Redirect字符串''''''''''''''''
Function OutUrl(Url)
	Response.Redirect(Url)
End Function

'***************************************************
%>
<%
function getfilename1(d)

getfilename1=year(d)&month(d)&day(d)&hour(d)&minute(d)&second(d)&cstr(int(rnd(1000)))
end function
%>