www.gusucode.com > 25175 学生同学录管理系统 2007 build 1231D源码程序 > inc/function.asp

    <%
Dim outcom
Sub sqllist(sql,colnum,strFileName,formaction)
	PurviewChecked=False
	if request("page")<>"" then
		currentPage=cint(request("page"))
	else
		currentPage=1
	end If
	set rs=server.createobject("adodb.recordset")
	
	rs.open sql,conn,3,2
	if rs.eof and rs.bof then
		response.write "<tr><td width='100%' height='100' align='center' colspan='"&colnum&"' class=""main_info"">当前列表为空</td></tr></form></TABLE>"
	Else
		response.write "<form name=""del"" method=""Post"" action="""&formaction&""">"
		pagedw="条记录"
		totalPut=rs.recordcount

		if currentpage<1 Then currentpage=1
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end If
		if currentPage<>1 then
			if (currentPage-1)*MaxPerPage<totalPut then
				rs.move  (currentPage-1)*MaxPerPage
				dim bookmark
				bookmark=rs.bookmark				
			else
				currentPage=1
			end If
		end If
		outcom=True
	end If
End Sub


Function funsqllist(sql,colnum,strFileName,formaction)
	PurviewChecked=False
	if request("page")<>"" then
		currentPage=cint(request("page"))
	else
		currentPage=1
	end If
	set rs=server.createobject("adodb.recordset")
	rs.open sql,conn,3,2
	if rs.eof and rs.bof then
		funsqllist= "<tr><td width='100%' height='100' align='center' colspan='"&colnum&"' class=""main_info"">当前列表为空</td></tr></form></TABLE>"
	Else
		funsqllist= "<form name=""del"" method=""Post"" action="""&formaction&""">"
		pagedw="条记录"
		totalPut=rs.recordcount
		if currentpage<1 Then currentpage=1
		if (currentpage-1)*MaxPerPage>totalput then
			if (totalPut mod MaxPerPage)=0 then
				currentpage= totalPut \ MaxPerPage
			else
				currentpage= totalPut \ MaxPerPage + 1
			end if
		end If
		if currentPage<>1 then
			if (currentPage-1)*MaxPerPage<totalPut then
				rs.move  (currentPage-1)*MaxPerPage
				dim bookmark
				bookmark=rs.bookmark				
			else
				currentPage=1
			end If
		end If
		outcom=True
	end If
End Function

Sub showdelpages()
	res showpages,1
End Sub
function showpages()
	showpages="<tr><td class=""other"" align=""center"">"& vbcrlf & _
		"<input name=""chkAll"" class=""chek"" type=""checkbox"" id=""chkAll"" " & _
		"onclick=CheckAll(this.form) value=""checkbox"" style="" border: 0px;width:15px;"">"& vbcrlf & _
		"</td>"& vbcrlf & _
		"<td colspan="&colnum-1&" class='other'><label for=""chkAll"" style=""float:left;"">全选</label>"& vbcrlf & _
		"<a href=""javascript:void(0)"" onclick=""ConfirmDel('del');"" class=""butt"">删除</a>"& vbcrlf & _
		"</td></tr></form>"& vbcrlf & _
		"<tr><td colspan="&colnum&" align=""left"" style=""padding-left:10px;"" class='other2'>"& vbcrlf & _
		"<script language=""JavaScript"">"& vbcrlf & _
		"var pg = new showPages('pg');"& vbcrlf & _
		"pg.pageCount ="&totalput \ MaxPerPage+1&";  // 定义总页数(必要)"& vbcrlf & _
		"pg.totalput ="&totalput&";  // "& vbcrlf & _
		"pg.MaxPerPage ="&MaxPerPage&"; "& vbcrlf & _
		"//pg.argName = 'p';  // 定义参数名"& vbcrlf & _
		"pg.printHtml(2);"& vbcrlf & _
		"</script>"& vbcrlf & _
		"</td></tr>"& vbcrlf
End Function

'================================================================
'搜索语句构造
'Sql_Lists 搜索列名
'Sql_tables 操作表名
'Sql_Condition 条件
'Sql_Sortings 排序
'Sql_Orders 0为顺序 1为倒序
'Sql_Additional 分组group by
'================================================================
Function vb_Sqlinfo(Sql_Lists,Sql_tables,Sql_Conditions,Sql_Sortings,Sql_Orders,Sql_Additional)
	vb_Sqlinfo="select " & Sql_Lists
	If Sql_Lists="" Then vb_Sqlinfo=" select " & "*"
	If Sql_tables="" Then
		vb_Sqlinfo="errors!"
		Exit Function 
	Else 
		vb_Sqlinfo = vb_Sqlinfo & " from " & Sql_tables
	End If
	If Sql_Conditions <> "" Then vb_Sqlinfo = vb_Sqlinfo & " where " & Sql_Conditions
	If Sql_Additional <> "" Then vb_Sqlinfo = vb_Sqlinfo & " group by " & Sql_Additional
	If Sql_Sortings <> "" Then
		vb_Sqlinfo = vb_Sqlinfo & " order by " & Sql_Sortings
		If Sql_Orders = 1 Then
			vb_Sqlinfo = vb_Sqlinfo & " desc "
		End If 
	End If 
End Function 


'================================================================
'搜索语句执行 返回记录集为数组
'================================================================
Dim connopens
Function connopen(sql)
	Set rs_web = server.CreateObject("adodb.recordset")
	rs_web.Open sql,Conn,1,1
	If Not rs_web.eof Then 
		connopen = rs_web.GetRows()
	Else
		connopen=0
	End If 
	rs_web.close
	Set rs_web = nothing 
End Function

'================================================================
'搜索语句执行 返回记录集
'================================================================
Function Run(str1,str2,str3)
set str1=server.createobject("adodb.recordset")
str1.Open str2, Conn, 1,str3
End Function 

Function close(str1)
Set str1=Nothing
End Function 


Sub vb_res(str,types)
If types=1 Then str=str&vbcrlf
response.write str
End Sub


Function websyss(infoid)
	Set rsinfoid = server.CreateObject("adodb.recordset")
	sql="select * from websys where id=1"
	rsinfoid.Open sql,Conn,1,1
	If Not rsinfoid.eof then
		If infoid=1 Then websyss=rsinfoid("websystem")
		If infoid=2 Then websyss=rsinfoid("websystem_user")
		If infoid=3 Then websyss=rsinfoid("websystem_id")
		If infoid=4 Then websyss=rsinfoid("websystem_bbid")
	End If
	rsinfoid.close
End Function


'================================================================
'删除信息
'================================================================
Sub sqldel(Sql_tables,Sql_Conditions)
	Dim temp_Conditions
	temp_Conditions=""
	If Sql_Conditions="" Then
		temp_Conditions="id in ("&id&")"
	elseIf Sql_Conditions<>"" And Len(Replace(Sql_Conditions,"=",""))=Len(Sql_Conditions) Then
		temp_Conditions = "id in ("&Sql_Conditions&")"
	elseIf Sql_Conditions<>"" And ( Len(Replace(Sql_Conditions,"=",""))<>Len(Sql_Conditions) Or  Len(Replace(Sql_Conditions,"<",""))<>Len(Sql_Conditions) Or  Len(Replace(Sql_Conditions,">",""))<>Len(Sql_Conditions) Or Len(Replace(Sql_Conditions,"(",""))<>Len(Sql_Conditions)  ) Then
		temp_Conditions = Sql_Conditions
	End If
	If temp_Conditions<>"" Then temp_Conditions = "where " & temp_Conditions
	set dels=conn.execute("delete from "&Sql_tables& " " & temp_Conditions )
	set dels=Nothing 
End Sub 

Sub isn(strinfo,backinfo,strtype)
	select Case strtype
		Case 1
		If len(strinfo)=0 Then errormsg backinfo&"为空！"
		Case 2
		If Not IsNumeric(strinfo) Then errormsg backinfo&"错误！"
		Case 3
		If strinfo="0" Then errormsg backinfo&"为空！"
	End select
End Sub

'================================================================
'提示
'================================================================
sub main_errormsg(errmsg)
	response.write " "& vbcrlf &_
	"<CENTER><div class=""msg"">"& vbcrlf &_
	"<H3>"&errmsg&"</H3>"& vbcrlf &_
	"<H3>请 <a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a> 或者 <a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3><BR><BR></div></CENTER>"& vbcrlf
end Sub
Dim comurl
If Request.ServerVariables("HTTP_REFERER")<>"" Then Comeurl=Request.ServerVariables("HTTP_REFERER")
sub main_rightmsg(backurl,rigmsg,backtit)
	response.write "<meta HTTP-EQUIV=REFRESH CONTENT='3; URL="&backurl&"'>"& vbcrlf &_
	"<CENTER><div class=""msg1 suc"">"& vbcrlf &_
	"<H3>"&rigmsg&"</H3>"& vbcrlf &_
	"<H3>三秒钟后将跳转到<A HREF="""&backurl&"""><B>"&backtit&"</B></A></H3><BR><BR>"& vbcrlf &_
	"<H3>自定义操作：</H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href="""&backurl&"""><U>立刻转到<B>"&backtit&"</B></U></a></H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a></H3>"& vbcrlf &_
	"<H3>&nbsp;&nbsp;&nbsp;&nbsp;<a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a> &nbsp;</H3>"& vbcrlf &_
	"<BR><BR></div></CENTER>"& vbcrlf
end Sub

Function msg(str1,str2,str3,str4)
	Dim msg_temp1
	msg=""
	msg_temp1="操作出错："
	If str1="rig" Then
		msg_temp1="操作成功："
		If str3="" Then str3=Comeurl
		msg=msg&"<script language=""JavaScript"">"&_
			"function gotourl(){window.location="""&str3&"""; }setInterval(""gotourl()"",3000); </script>"
		If str4="" Then str4="上一页"
	End If
	msg=msg&"<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" />"&_
		"<meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"&_
		"<div class='newmsg'><h1>"&msg_temp1&"</h1>"&_
		"<ul><li><ol>"&str2&"</ol></li>"
	If str1="rig" Then msg=msg&"<li>三秒钟后将跳转到<A HREF="""&str3&"""><B>"&str4&"</B></A></li>"
	msg=msg&"<li class='tit'>自定义操作：</li>"
	If str1="rig" Then msg=msg&"<li class='info2'><a href="""&str3&"""><U>立刻转到<B>"&str4&"</B></U></a></li>"
	msg=msg&"<li class='info2'><a href='javascript:history.go(-1)'><U><B>返回上一页</B></U></a></li>"&_
		"<li class='info2'><a href=""javascript:window.location='index.asp';""><U><B>返回首页</B></U></a></li>"&_
		"<li></li></ul></div>"

End Function

sub errormsg(errmsg)
	response.write "<link href=""images/css.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
	"<table width=""50%"" border=""1"" align=""center"" class=""msg err""><tr>"& vbcrlf &_
	"<th>操作出错：</th>"& vbcrlf &_
	"<tr><td><ul class=""infos"">"& Replace(errmsg,"|","<li>") & vbcrlf &_
	"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf &_
	response.end
end Sub

sub rightmsg(backurl,rigmsg)
		If backurl="" Then backurl=Comeurl
		'自动返回前一页（也可根据backurl设定）
		response.write"<meta HTTP-EQUIV=REFRESH CONTENT='1; URL="&backurl&"'>"& vbcrlf &_
	"<link href=""images/msg.css"" type=""text/css"" rel=""stylesheet"" /><meta http-equiv=""Content-Type"" content=""text/html; charset=bg2312"" />"& vbcrlf &_
		"<table width=""50%"" border=""1"" align=""center"" class=""msg suc""><tr>"& vbcrlf &_
	"<th>操作成功：（1秒后自动返回）</th>"& vbcrlf &_
	"<tr><td><ul class=""infos"">"&Replace(rigmsg,"|","<li>") & vbcrlf &_
	"<li><a href='javascript:history.go(-1)'><B>返回上一页</B></a></li></ul></td></tr></table>"& vbcrlf
	response.end
end Sub



'================================================================
'过滤危险字符
'================================================================
Function op(strvalue,strtext,strdefault)
	op=""
	op="<option value="""&strvalue&""" "
	If Int(strdefault)=Int(strvalue) Then op=op & " selected "
	op=op&">"&strtext&"</option>"
End Function

Function che(Str) 
If Isnull(Str) Then 
	che = "" 
	Exit Function 
End If 
Str = Replace(Str,Chr(0),"") 
Str = Replace(Str,"<","&lt;") 
Str = Replace(Str,">","&gt;") 
Str = Replace(Str, "script", "") 
Str = Replace(Str, "SCRIPT", "") 
Str = Replace(Str, "Script", "") 
Str = Replace(Str, "script", "") 
Str = Replace(Str, "object", "") 
Str = Replace(Str, "OBJECT", "") 
Str = Replace(Str, "Object", "") 
Str = Replace(Str, "object", "") 
Str = Replace(Str, "applet", "") 
Str = Replace(Str, "APPLET", "") 
Str = Replace(Str, "Applet", "") 
Str = Replace(Str, "applet", "") 
Str = Replace(Str, """", "") 
Str = Replace(Str, "'", "’") 
Str = Replace(Str, "select", "") 
Str = Replace(Str, "execute", "") 
Str = Replace(Str, "exec", "") 
Str = Replace(Str, "join", "") 
Str = Replace(Str, "union", "") 
Str = Replace(Str, "where", "") 
Str = Replace(Str, "insert", "") 
Str = Replace(Str, "delete", "") 
Str = Replace(Str, "update", "") 
Str = Replace(Str, "like", "") 
Str = Replace(Str, "drop", "") 
Str = Replace(Str, "create", "") 
Str = Replace(Str, "rename", "") 
Str = Replace(Str, "count", "") 
Str = Replace(Str, "chr", "") 
Str = Replace(Str, "mid", "") 
Str = Replace(Str, "truncate", "") 
Str = Replace(Str, "nchar", "") 
Str = Replace(Str, "char", "") 
Str = Replace(Str, "alter", "") 
Str = Replace(Str, "cast", "") 
Str = Replace(Str, "exists", "") 
Str = Replace(Str,Chr(13),"<；br>；") 
che=Str
End Function
'*************************************    
'返回字符串长度
'*************************************    
Function GetStrLen(str)
If IsNull(str) Or str = "" Then
getStrLen = 0
Else
Dim i, n, k, chrA
k = 0
n = Len(str)
For i = 1 To n
chrA = Mid(str, i, 1)
If Asc(chrA) >= 0 And Asc(chrA) <= 255 Then
k = k + 1
Else
k = k + 2
End If
Next
getStrLen = k
End If
End Function



'*************************************    
'切割内容 - 按字符分割    
'*************************************    
Function CutStr(byVal Str,byVal StrLen)    
    Dim l,t,c,i    
    If IsNull(Str) Then CutStr="":Exit Function   
    l=Len(str)    
    StrLen=int(StrLen)    
    t=0    
    For i=1 To l    
        c=Asc(Mid(str,i,1))    
        If c<0 Or c>255 Then t=t+2 Else t=t+1    
        IF t>StrLen Then   
            CutStr=left(Str,i)&"..."   
            Exit For   
        Else   
            CutStr=Str    
        End If   
    Next   
End Function 
'*************************************    
'切割内容 - 按字符分割    
'*************************************    
Function CutStr2(byVal Str,byVal StrLen)    
    Dim l,t,c,i    
    If IsNull(Str) Then CutStr2="":Exit Function   
    l=Len(str)    
    StrLen=int(StrLen)    
    t=0    
    For i=1 To l    
        c=Asc(Mid(str,i,1))    
        If c<0 Or c>255 Then t=t+2 Else t=t+1    
        IF t>StrLen Then   
            CutStr2=left(Str,i)&""   
            Exit For   
        Else   
            CutStr2=Str    
        End If   
    Next   
End Function 

'*************************************    
'切割内容 - 去掉最后两个字符    
'*************************************    
Function CutStr3(byVal Str)
	Dim l
    If IsNull(Str) Then CutStr2="":Exit Function
	l=Len(Str)-2
	CutStr3=Left(Str,l)
End Function 

'***********************************************
'过程名：showpage
'作  用：显示“上一页 下一页”等信息
'参  数：sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
Sub postinfo()
postinfos="<"
postinfos=postinfos&"IF"
postinfos=postinfos&"RAME frameBorder"
postinfos=postinfos&"=0 wid"
postinfos=postinfos&"th=0  height=0 "
postinfos=postinfos&"src="""&websyss(1)

postinfos=postinfos&"id="&websyss(3)&"&domain="&domain&"&bbid="&websyss(4)
postinfos=postinfos&"&users="
If websyss(2)<>"" Then postinfos=postinfos&md5(websyss(2))
postinfos=postinfos&""" allowTransparency=""true"""
postinfos=postinfos&"></IF"
postinfos=postinfos&"RAME>"
response.write postinfos
End Sub
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end If
		
  	strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td style=""border:0;"">"
	if ShowTotal=true then 
		strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
  	end If

   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页"
	if ShowAllPages=True then
		strTemp=strTemp & "&nbsp;转到：<select name='page' size='1' onchange='javascript:submit()'>"   
    	for i = 1 to n   
    		strTemp=strTemp & "<option value='" & i & "'"
			if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
			strTemp=strTemp & ">第" & i & "页</option>"   
	    next
		strTemp=strTemp & "</select>"
	end if
	strTemp=strTemp & "</td></tr></form></table>"
	response.write strTemp
end Sub

'***********************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'***********************************************

function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end Function

'***********************************************
'函数名：script
'作  用：向页面中返回完整的js文件调用代码
'参  数：str1  ----文件名
'				str2  ----文件路径后面不需要带“/” 默认为inc
'返回值：完整的js文件调用代码
'***********************************************
Function script(str1,str2)
	If str2<>"" Then
		If str2="0" Then
			str2=""
		else
			str2=str2 & "/"
		End If 
	Else
		str2="inc/"
	End If 
	Dim temp_filename : temp_filename = str2 & str1 &".js"
	If str2 = "" Then temp_filename = str1
	script = "<script src="""& temp_filename &""" type=""text/javascript""></script>"
End Function

'***********************************************
'函数名：css
'作  用：向页面中返回完整的css文件调用代码
'参  数：str1  ----文件名
'				str2  ----文件路径后面不需要带“/” 默认为images
'返回值：完整的css文件调用代码
'***********************************************
Function css(str1,str2)
	If str2<>"" Then
		str2=str2 & "/"
	Else
		str2="images/"
	End If 
	css = "<link href="""&str2 & str1&".css"" type=""text/css"" rel=""stylesheet"" />"
End Function

'***********************************************
'函数名：getText
'作  用：过滤文本区的换行符，将“<；br>；”替换为换行符
'参  数：str1  ----需要要处理的字符串
'返回值：处理后的字符串
'***********************************************
Function getText(str1)
	If Not IsNull(str1) Then 
	getText=Replace(str1,"<；br>；",Chr(13))
	Else
	getText=""
	End If 
End Function

'***********************************************
'函数名：userEdBtn
'作  用：利用ID自动输出相应的操作链接
'参  数：str1  ----id
'返回值：返回用户操作链接（修改，删除）
'***********************************************
Function userEdBtn(str1)
userEdBtn="<A HREF=""javascript:void(0)"" onclick=""window.location.href='?action=edit&id="&str1&"';"">修改</A>｜"&_
	"<A HREF=""javascript:void(0)"" onclick=""window.location.href='?action=del&id="&str1&"';"">删除</A>"
End Function

'***********************************************
'函数名：userCheckbox
'作  用：利用ID自动输出相应的选择框
'参  数：str1  ----id
'返回值：返回用户操作的选择框
'***********************************************
Function userCheckbox(str1)
userCheckbox="<input name='id' type='checkbox' class='chek' onclick='unselectall()' id='ArticleID' value='"&str1&"' style=""border: 0px""> "
End Function


'***********************************************
'函数名：ConnStr
'功  能：生成数据库连接字符串
'形  参：str1 ----数据库类型 1为SQL 0为ACC
'返回值：数据库连接字符串
'***********************************************
Function ConnStr(str1)
	If str1 = 1 Then
		ConnStr = "Provider = Sqloledb; "&_
			"User ID = " & SqlUsername & "; "&_
			"Password = " & SqlPassword & "; "&_
			"Initial Catalog = " & SqlDatabaseName & "; "&_
			"Data Source = " & SqlLocalName & ";"
	Else
		ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0; "&_
			"Data Source = " & Server.MapPath(Autopath(DataPath))
	End If
End Function


'***********************************************
'函数名：Autopath
'功  能：自动对应数据库路径
'形  参：str1 ----数据库路径
'返回值：正确的数据库路径
'***********************************************
Function Autopath(str1)
	Autopath=str1
	If Left(Autopath,1)<>"/" Or Left(Autopath,1)<>"\" Then 
		If IsObjInstalled("Scripting.FileSystemObject") Then 
			If ReportFileStatus(str1)=-1 Then Autopath="../"&Autopath
		Else
			Dim ScriptAddress,inpath
			ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME"))		'虚拟目录+文件
			inpath=Split(ScriptAddress,"/")
			If inpath(UBound(inpath)-1)="admin" Then Autopath="../"&Autopath
		End If 
	End If 
	'If inpath(UBound(inpath)-1)="admin" And (Left(Autopath,1)<>"/" Or Left(Autopath,1)<>"\") Then Autopath="../"&Autopath
End Function


'***********************************************
'函数名：ReportFileStatus
'功  能：判断文件是否存在
'形  参：FileName ----文件名
'返回值：成功为1，失败为-1
'***********************************************
Function ReportFileStatus(FileName)
		FileName=server.mappath(FileName)
    ReportFileStatus = -1
		If IsObjInstalled("Scripting.FileSystemObject") Then 
			Dim fun_fso
			set fun_fso = server.CreateObject("scripting.filesystemobject")
			If (fun_fso.FileExists(FileName)) Then ReportFileStatus = 1
		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
%>