<%
'--------------------------------------
'Power By 580Web @2010-2014 f02
'URL:http://www.580Web.Cn/
'EMail:wsok85@qq.com
'QQ:253819801
'版权所有 未经允许不得去除本版权信息
'--------------------------------------
'<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

Class Cls_Fun
	Private Fso,F,objAdoStream,ObjFloders,ObjFloder,ObjFiles,ObjFile
	Private FsoTemp,FsoTempArr

	'==============================
	'函 数 名：HTMLEncode
	'作    用：字符转换函数
	'==============================
	Public Function HTMLEncode(fString)
		If Not IsNull(fString) Then
			fString=Replace(fString,">","&gt;")
			fString=Replace(fString,"<","&lt;")
			fString=Replace(fString,Chr(32)," ")		
			fString=Replace(fString,Chr(34),"&quot;")
			fString=Replace(fString,Chr(39),"&#39;")
			fString=Replace(fString,Chr(9),"&nbsp;")
			fString=Replace(fString,Chr(13),"")
			fString=Replace(fString,Chr(10)&Chr(10),"<p></p>")
			fString=Replace(fString,Chr(10),"<br />")
			HTMLEncode=fString
		End If
	End Function
	
	'==============================
	'函 数 名：HTMLDncode
	'作    用：字符转回函数
	'==============================
	Public Function HTMLDncode(fString)
		If Not IsNull(fString) Then
			fString=Replace(fString,"&gt;",">" )
			fString=Replace(fString,"&lt;","<")
			fString=Replace(fString," ",Chr(32))
			fString=Replace(fString,"&nbsp;",Chr(9))
			fString=Replace(fString,"&quot;",Chr(34))
			fString=Replace(fString,"&#39;",Chr(39))
			fString=Replace(fString,"",Chr(13))
			fString=Replace(fString,"<p></p>",Chr(10)&Chr(10) )
			fString=Replace(fString,"<br />",Chr(10))
			HTMLDncode=fString
		End If
	End Function

	'==============================
	'函 数 名：EditorImgTry
	'作    用：图片高宽auto去除
	'==============================
	Public Function EditorImgTry(fString)
		If Not IsNull(fString) Then
			fString=replace(fString," width=""auto""","")
			fString=replace(fString," height=""auto""","")
			EditorImgTry=fString
		End If
	End Function
	
	'==============================
	'函 数 名：AlertInfo
	'作    用：错误显示函数
	'==============================
	Public Function AlertInfo(InfoStr,GoUrl)
		If GoUrl="1" Then
			Response.Write "<Script>alert('"&InfoStr&"');location.href='javascript:history.go(-1)';</Script>"
		Else
			Response.Write "<Script>alert('"&InfoStr&"');location.href='"&GoUrl&"';</Script>"
		End If
		Call PageEnd()
	End Function
	
	'==============================
	'函 数 名：AlertNum
	'作    用：判断是否是数字（验证字符，不为数字时的提示）
	'==============================
	Public Function AlertNum(CheckStr,ErrStr)
		If Not IsNumeric(CheckStr) or CheckStr="" Then
			Call AlertInfo(ErrStr,"1")
		End If
	End Function

	'==============================
	'函 数 名：AlertString
	'作    用：判断字符串长度
	'参    数：需进行判断的文本CheckStr
	'		  限定最短ShortLen
	'		  限定最长LongLen
	'		  验证类型CheckType（0两头限制，1限制最短，2限制最长）
	'		  过短提示LongStr
	'		  过长提示LongStr，
	'==============================
	Public Function AlertString(CheckStr,ShortLen,LongLen,CheckType,ShortErr,LongErr)
		If (CheckType=0 Or CheckType=1) And StringLength(CheckStr)<ShortLen Then
			Call AlertInfo(ShortErr,"1")
		End If
		If (CheckType=0 Or CheckType=2) And StringLength(CheckStr)>LongLen Then
			Call AlertInfo(LongErr,"1")
		End If
	End Function
	
	'==============================
	'函 数 名：ShowNum
	'作    用：判断是否是数字（验证字符，不为数字时的提示）
	'==============================
	Public Function ShowNum(CheckStr,ErrStr)
		If Not IsNumeric(CheckStr) or CheckStr="" Then
			Response.Write(ErrStr)
			Call PageEnd()
		End If
	End Function

	'==============================
	'函 数 名：ShowString
	'作    用：判断字符串长度
	'参    数：需进行判断的文本CheckStr
	'		  限定最短ShortLen
	'		  限定最长LongLen
	'		  验证类型CheckType（0两头限制，1限制最短，2限制最长）
	'		  过短提示LongStr
	'		  过长提示LongStr，
	'==============================
	Public Function ShowString(CheckStr,ShortLen,LongLen,CheckType,ShortErr,LongErr)
		If (CheckType=0 Or CheckType=1) And StringLength(CheckStr)<ShortLen Then
			Response.Write(ShortErr)
			Call PageEnd()
		End If
		If (CheckType=0 Or CheckType=2) And StringLength(CheckStr)>LongLen Then
			Response.Write(LongErr)
			Call PageEnd()
		End If
	End Function
	
	'==============================
	'函 数 名：JsonNum
	'作    用：判断是否是数字（验证字符，不为数字时的提示）
	'==============================
	Public Function JsonNum(CheckStr,ErrStr)
		If Not IsNumeric(CheckStr) or CheckStr="" Then
			Call JsonError(ErrStr)
		End If
	End Function

	'==============================
	'函 数 名：JsonString
	'作    用：判断字符串长度
	'参    数：需进行判断的文本CheckStr
	'		  限定最短ShortLen
	'		  限定最长LongLen
	'		  验证类型CheckType（0两头限制，1限制最短，2限制最长）
	'		  过短提示LongStr
	'		  过长提示LongStr，
	'==============================
	Public Function JsonString(CheckStr,ShortLen,LongLen,CheckType,ShortErr,LongErr)
		If (CheckType=0 Or CheckType=1) And StringLength(CheckStr)<ShortLen Then
			Call JsonError(ShortErr)
		End If
		If (CheckType=0 Or CheckType=2) And StringLength(CheckStr)>LongLen Then
			Call JsonError(LongErr)
		End If
	End Function
	
	'==============================
	'函 数 名：JsonSuccess
	'作    用：json成功提示
	'==============================
	Public Function JsonSuccess()
		Response.Write("{""statusCode"":""200""}")
	End Function
	
	'==============================
	'函 数 名：JsonError
	'作    用：json错误提示
	'==============================
	Public Function JsonError(ErrStr)
		Response.Write("{""statusCode"":""201"",""errorStr"":"""&ErrStr&"""}")
		Call PageEnd()
	End Function
		
	'==============================
	'函 数 名：PageEnd
	'作    用：页面结束
	'==============================
	Public Function PageEnd()
		Set Rs=Nothing
		If IsObject(Conn) Then Conn.Close
		Set Conn=Nothing
		Session.CodePage=936
		Response.End()
	End Function

	'==============================
	'函 数 名：StringLength
	'作    用：判断字符串长度
	'==============================
	Public Function StringLength(Txt)
		Dim x,y,ii
		Txt=Trim(Txt)
		x=Len(Txt)
		y=0
		For ii=1 To x
			If Asc(Mid(Txt,ii,1))<=2 or Asc(Mid(Txt,ii,1))>255 Then
				y=y + 2
			Else
				y=y + 1
			End If
		Next
		StringLength=y
	End Function
	
	'==============================
	'函 数 名：BeSelect
	'作    用：判断select选项选中
	'==============================
	Public Function BeSelect(Select1,Select2)
		If IsNumeric(Select1) Then
			Select1=CDbl(Select1)
		End If
		If IsNumeric(Select2) Then
			Select2=CDbl(Select2)
		End If
		If Select1=Select2 Then
			BeSelect=" selected='selected'"
		End If
	End Function
	
	'==============================
	'函 数 名：BeCheck
	'作    用：判断Check选项选中
	'==============================
	Public Function BeCheck(Check1,Check2)
		If IsNumeric(Check1) Then
			Check1=CDbl(Check1)
		End If
		If IsNumeric(Check2) Then
			Check2=CDbl(Check2)
		End If
		If Check1=Check2 Then
			BeCheck=" checked='checked'"
		End If
	End Function
		
	'==============================
	'函 数 名：GetStr
	'作    用：截取字符串
	'==============================
	Public Function GetStr(Str,LenNum)
		If Len(Str)>LenNum Then
			GetStr=Left(Str,LenNum)&"..."
		Else
			GetStr=Str
		End If
	End Function
	
	'==============================
	'函 数 名：IsObjInstalled
	'作    用：判断组件是否安装了
	'==============================
	Public Function IsObjInstalled(strClassString)
		On Error Resume Next
		IsObjInstalled=False 
		Err.Clear
		Dim xTestObj
		Set xTestObj=Server.CreateObject(strClassString)
		If 0=Err Then IsObjInstalled=True 
		Set xTestObj=Nothing
		Err.Clear
	End Function
	
	'==============================
	'函 数 名：ReplaceExt
	'作    用：清理允许上传域名
	'==============================
	Function ReplaceExt(ReStr)
		ReStr=LCase(ReStr)
		While(Instr(ReStr,"aspx")>0)
			ReStr=Replace(ReStr,"aspx","")
		Wend
		While(Instr(ReStr,"asp")>0)
			ReStr=Replace(ReStr,"asp","")
		Wend
		While(Instr(ReStr,"jsp")>0)
			ReStr=Replace(ReStr,"jsp","")
		Wend
		While(Instr(ReStr,"cer")>0)
			ReStr=Replace(ReStr,"cer","")
		Wend
		While(Instr(ReStr,"asa")>0)
			ReStr=Replace(ReStr,"asa","")
		Wend
		While(Instr(ReStr,"cgi")>0)
			ReStr=Replace(ReStr,"cgi","")
		Wend
		While(Instr(ReStr,"php")>0)
			ReStr=Replace(ReStr,"php","")
		Wend
		ReplaceExt=ReStr
	End Function
	
	'==============================
	'函 数 名：ReplaceExt
	'作    用：清理允许上传域名
	'==============================
	Function CheckAllowExt(cExt)
		Dim TempExt,TempExtArr
		CheckAllowExt=""
		TempExtArr=Split(cExt,",")
		For Each TempExt In TempExtArr
			If TempExt<>"" Then
				If Instr(AllowExt,","&TempExt&",")=0 Then
					If CheckAllowExt="" Then
						CheckAllowExt=TempExt
					Else
						CheckAllowExt=CheckAllowExt&","&TempExt
					End If
				End If
			End If
		Next
	End Function

	'==============================
	'函 数 名：ShowPageCode
	'作    用：显示页码
	'参    数：链接p_Url
	'		  当前页p_Now
	'		  记录数p_RecordCount
	'		  每页数量p_Size
	'		  总页数p_PageCount
	'==============================
	Public Function ShowPageCode(p_Url,p_Now,p_RecordCount,p_Size,p_PageCount)
		Dim PageDiv
		If p_RecordCount=0 Then
			p_RecordCount=0
			p_PageCount=0
		End If
		If Instr(p_Url,"|ss--ss|")>0 Then
			PageDiv=Split(p_Url,"|ss--ss|")(0)
			p_Url=Split(p_Url,"|ss--ss|")(1)
		Else
			PageDiv="mainRight"
		End If
		If p_Now>1 Then
			Response.Write("<a href=""javascript:void(0);"" onclick=""ajax_get('"&PageDiv&"','"&p_Url&"1');"">第一页</a>")
			Response.Write("&nbsp;")
			Response.Write("<a href=""javascript:void(0);"" onclick=""ajax_get('"&PageDiv&"','"&p_Url&(p_Now-1)&"');"">上一页</a>")
		Else
			Response.Write("第一页")
			Response.Write("&nbsp;")
			Response.Write("上一页")
		End If
		Response.Write("&nbsp;")
		If p_PageCount>p_Now Then
			Response.Write("<a href=""javascript:void(0);"" onclick=""ajax_get('"&PageDiv&"','"&p_Url&(p_Now+1)&"');"">下一页</a>")
			Response.Write("&nbsp;")
			Response.Write("<a href=""javascript:void(0);"" onclick=""ajax_get('"&PageDiv&"','"&p_Url&p_PageCount&"');"">尾页</a>")
		Else
			Response.Write("下一页")
			Response.Write("&nbsp;")
			Response.Write("尾页")
		End If
		Response.Write("&nbsp;"&p_Size&"条/页&nbsp;共"&p_PageCount&"页/"&p_RecordCount&"条&nbsp;当前第"&p_Now&"页&nbsp;")
		If p_PageCount>1 Then
			Response.Write("<select name=""Change_Page"" id=""Change_Page"" onChange=""ajax_get('"&PageDiv&"','"&p_Url&"'+this.options[this.selectedIndex].value);"">")
			For i=1 To p_PageCount
				If i=p_Now Then
					Response.Write("<option value="""&i&""" selected=""selected"">第"&i&"页</option>")
				Else
					Response.Write("<option value="""&i&""">第"&i&"页</option>")
				End If
			Next
			Response.Write("</select>")
		End If
	End Function

	'==============================
	'函 数 名：GetField_Input
	'作    用：获取文本框HTML代码
	'==============================
	Public Function GetField_Input(fName,fLabel,fHelp,fDefault)
%>
        <tr>
            <td height="30" align="right"><%=fName%>：</td>
            <td>&nbsp;<input name="Fk_Field_<%=fLabel%>" type="text" class="input" id="Fk_Field_<%=fLabel%>" size="30" value="<%=fDefault%>" /><span class="help" title="<p><%=fHelp%></p>"></span></td>
        </tr>
<%
	End Function

	'==============================
	'函 数 名：GetField_Select
	'作    用：获取下拉框HTML代码
	'==============================
	Public Function GetField_Select(fName,fLabel,fHelp,fOption,fDefault)
		Dim OptionArr,OptionTemp
		OptionArr=Split(fOption,"|-|")
%>
        <tr>
            <td height="30" align="right"><%=fName%>：</td>
            <td>&nbsp;<select class="input" name="Fk_Field_<%=fLabel%>" id="Fk_Field_<%=fLabel%>">
<%
		For Each OptionTemp In OptionArr
%>
					<option value="<%=Split(OptionTemp,"||")(0)%>"<%=FKFun.BeSelect(fDefault,Split(OptionTemp,"||")(0))%>><%=Split(OptionTemp,"||")(1)%></option>
<%
		Next
%>
				</select><span class="help" title="<p><%=fHelp%></p>"></span>
			</td>
        </tr>
<%
	End Function

	'==============================
	'函 数 名：GetField_Upload
	'作    用：获取上传框HTML代码
	'==============================
	Public Function GetField_Upload(fName,fLabel,fHelp,fDefault)
%>
        <tr>
            <td height="30" align="right"><%=fName%>：</td>
            <td>&nbsp;<input name="Fk_Field_<%=fLabel%>" type="text" class="input" id="Fk_Field_<%=fLabel%>" size="30" value="<%=fDefault%>" /> <input type="button" class="picList_btn btnUpload" name="btn<%=fLabel%>" id="btn<%=fLabel%>" value="上传文件" callback="2" inputId="Fk_Field_<%=fLabel%>" fileAction="Upload.asp?immediate=3" /><span class="help" title="<p><%=fHelp%></p>"></span></td>
        </tr>
<%
	End Function

	'==============================
	'函 数 名：GetField_Editor
	'作    用：获取编辑器框HTML代码
	'==============================
	Public Function GetField_Editor(fName,fLabel,fHelp,fDefault)
%>
        <tr>
            <td height="30" align="right"><%=fName%>：</td>
            <td>
<%
	If Fk_Site_Editor=0 Then
%>
				<textarea name="Fk_Field_<%=fLabel%>" id="Fk_Field_<%=fLabel%>" class="xheditor" rows="20" style="width:100%;"><%=fDefault%></textarea>
<%
	ElseIf Fk_Site_Editor=1 Then
%>
				<textarea name="Fk_Field_<%=fLabel%>" id="Fk_Field_<%=fLabel%>" class="ueditor" style="width:740px;height:300px;"><%=fDefault%></textarea>
				<script type="text/javascript">  
					UE.getEditor('Fk_Field_<%=fLabel%>');
				</script>
<%
	End If
%>
			</td>
        </tr>
<%
	End Function

	'==============================
	'函 数 名：GetAdminTypeName
	'作    用：获取管理员类型
	'==============================
	Public Function GetAdminTypeName(sType)
		Select Case sType
			Case 0
				GetAdminTypeName="超级管理员"
			Case 1
				GetAdminTypeName="普通管理员"
		End Select
	End Function

	'==============================
	'函 数 名：GetFriendsShowTypeName
	'作    用：获取友情链接显示类型
	'==============================
	Public Function GetFriendsShowTypeName(sType)
		Select Case sType
			Case 1
				GetFriendsShowTypeName="LOGO"
			Case 2
				GetFriendsShowTypeName="文字"
		End Select
	End Function

	'==============================
	'函 数 名：GetModelTypeName
	'作    用：获取模型类型
	'==============================
	Public Function GetModelTypeName(sType)
		Select Case sType
			Case 1
				GetModelTypeName="列表"
			Case 2
				GetModelTypeName="信息"
			Case 3
				GetModelTypeName="留言"
		End Select
	End Function

	'==============================
	'函 数 名：GetStateName
	'作    用：获取是否可用
	'==============================
	Public Function GetStateName(sType)
		Select Case sType
			Case 0
				GetStateName="不可用"
			Case 1
				GetStateName="可用"
		End Select
	End Function

	'==============================
	'函 数 名：GetShowName
	'作    用：获取是否显示
	'==============================
	Public Function GetShowName(sType)
		Select Case sType
			Case 0
				GetShowName="不显示"
			Case 1
				GetShowName="显示"
		End Select
	End Function

	'==============================
	'函 数 名：GetFieldUseName
	'作    用：获取自定义字段用途
	'==============================
	Public Function GetFieldUseName(sType)
		Select Case sType
			Case 1
				GetFieldUseName="站点设置"
			Case 2
				GetFieldUseName="菜单项"
		End Select
	End Function

	'==============================
	'函 数 名：GetModuleTypeName
	'作    用：获取菜单项类型名称
	'==============================
	Public Function GetModuleTypeName(sType)
		Select Case sType
			Case 0
				GetModuleTypeName="静态模块"
			Case 1
				GetModuleTypeName="内容模块"
			Case 2
				GetModuleTypeName="信息模块"
			Case 3
				GetModuleTypeName="留言模块"
			Case 4
				GetModuleTypeName="转向链接"
			Case 5
				GetModuleTypeName="中转模块"
		End Select
	End Function

	'==============================
	'函 数 名：GetFieldTypeName
	'作    用：获取模型字段类型名称
	'==============================
	Public Function GetFieldTypeName(sType)
		Select Case sType
			Case 0
				GetFieldTypeName="文本框"
			Case 1
				GetFieldTypeName="编辑器框"
			Case 2
				GetFieldTypeName="上传框"
			Case 3
				GetFieldTypeName="下拉框"
		End Select
	End Function

	'==============================
	'函 数 名：GetHtmlSuffix
	'作    用：获取后缀
	'==============================
	Public Function GetHtmlSuffix(sType)
		Select Case sType
			Case 0
				GetHtmlSuffix=".html"
			Case 1
				GetHtmlSuffix=".htm"
			Case 2
				GetHtmlSuffix=".shtml"
			Case 3
				GetHtmlSuffix=".xml"
		End Select
	End Function

	'==============================
	'函 数 名：GetSub
	'作    用：截取字符串
	'==============================
	Public Function GetSub(gStr,gStart,gEnd,gDefault)
		If Instr(gStr,gStart)>0 Then
			GetSub=Split(gStr,gStart)(1)
			GetSub=Split(GetSub,gEnd)(0)
			If GetSub="" Then
				GetSub=gDefault
			End If
		Else
			GetSub=gDefault
		End If
	End Function

	'==============================
	'函 数 名：DealPageUrl
	'作    用：去掉最后一截
	'==============================
	Public Function DealPageUrl(pUrl)
		Dim pArr
		pArr=Split(pUrl,"/")
		pUrl=Replace(pUrl,pArr(UBound(pArr)),"")
		DealPageUrl=pUrl
	End Function

	'==============================
	'函 数 名：GetNowUrl
	'作    用：返回当前网址
	'==============================
	Public Function GetNowUrl()
		GetNowUrl=Request.ServerVariables("Script_Name")&"?"&Request.ServerVariables("QUERY_STRING")
	End Function

	'==============================
	'函 数 名：ReplaceTest
	'作    用：正则表达式，替换字符串
	'参    数：规则patrn，要替换的字符串Str，替换为字符串replStr
	'==============================
	Public Function ReplaceTest(patrn,replStr,Str)
		Dim regEx
		Set regEx=New RegExp
		regEx.Pattern=patrn
		regEx.IgnoreCase=True
		regEx.Global=True 
		ReplaceTest=regEx.Replace(Str,replStr)
	End Function 

	'==============================
	'函 数 名：RegExpTest
	'作    用：正则表达式，获取字符串
	'参    数：源字符串patrn，规则strng
	'==============================
	Public Function RegExpTest(patrn,strng)
		Dim regEx,Matchs,Matches,RetStr
		Set regEx=New RegExp 
		regEx.Pattern=patrn 
		regEx.IgnoreCase=True
		regEx.Global=True
		Set Matches=regEx.Execute(strng) 
		For Each Matchs in Matches
			RetStr=RetStr&Matchs.Value&"|-_-|"
		Next 
		RegExpTest=RetStr 
	End Function 
		
	'==============================
	'函 数 名：ChangeTime
	'作    用：处理时间
	'==============================
	Public Function FormatTime(str,sTime)
		str=Replace(str,"yyyy",Year(sTime))
		str=Replace(str,"yy",Right(Year(sTime),2))
		str=Replace(str,"mm",Month(sTime))
		str=Replace(str,"dd",Day(sTime))
		str=Replace(str,"hh",Hour(sTime))
		str=Replace(str,"nn",Minute(sTime))
		str=Replace(str,"ss",Second(sTime))
		FormatTime=str
	End Function
	
	'==============================
	'函 数 名：ShowErr
	'作    用：错误提示函数
	'参    数：错误说明ErrStr
	'         错误类型ErrType(0前台，1后台)
	'==============================
	Public Function ShowErr(ErrStr,ErrType)
		If ErrType=0 Then
			Temp="<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"">"
			Temp=Temp&"<html xmlns=""http://www.w3.org/1999/xhtml"">"
			Temp=Temp&"<head>"
			Temp=Temp&"<meta http-equiv=""Content-Type"" content=""text/html; charset=utf-8"" />"
			Temp=Temp&"<title>系统提示</title>"
			Temp=Temp&"<style type=""text/css"">"
			Temp=Temp&"body,td,th {font-size: 12px;}"
			Temp=Temp&"body {margin-left:0px;margin-top:50px;margin-right: 0px;margin-bottom: 0px;}"
			Temp=Temp&"#errBox {width:500px;margin:0 auto;border:1px solid #CCC;}"
			Temp=Temp&"#errTitle {border-bottom:1px solid #CCC;line-height:25px;text-align:center;}"
			Temp=Temp&"#errStr {padding:10px;line-height:22px;text-indent:24px;}"
			Temp=Temp&"</style>"
			Temp=Temp&"</head>"
			Temp=Temp&"<body>"
			Temp=Temp&"<div id=""errBox"">"
			Temp=Temp&"	<div id=""errTitle"">系统提示</div>"
			Temp=Temp&"    <div id=""errStr"">"&ErrStr&"</div>"
			Temp=Temp&"</div>"
			Temp=Temp&"</body>"
			Temp=Temp&"</html>"
		ElseIf ErrType=1 Then
			Temp="<div id=""errBox"">"
			Temp=Temp&"	<div id=""errTitle"">系统提示</div>"
			Temp=Temp&"    <div id=""errStr"">"&ErrStr&"</div>"
			Temp=Temp&"</div>"
			Temp=Temp&"</body>"
		End If
		If ErrType=2 Then
			Temp=ErrStr
		End If
		Response.Write(Temp)
		Call PageEnd()
	End Function
		
'========================FSO部分================================================================================================
	
	'==============================
	'函 数 名：GetDir
	'作    用：获取安装路径
	'==============================
	Public Function GetDir()
		Dim DirTemp
		GetDir=Trim(Request.ServerVariables("SCRIPT_NAME"))
		DirTemp=Split(GetDir,"/")(UBound(Split(GetDir,"/"))-1)&"/"
		GetDir=left(GetDir,Instr(LCase(GetDir),"/"&LCase(DirTemp)))
		If Instr(UCase(GetDir),"/W3SVC")<>0 Then
		   GetDir=Left(GetDir,Instr(GetDir,"/W3SVC"))
		End If
	End Function

	'==============================
	'函 数 名：GetDomain
	'作    用：获取系统网址
	'==============================
	Public Function GetDomain()
		If Request.ServerVariables("SERVER_PORT")="80" Then
			GetDomain=Request.ServerVariables("SERVER_NAME")
		Else
			GetDomain=Request.ServerVariables("SERVER_NAME")&":"&Request.ServerVariables("SERVER_PORT")
		End If
		 If Instr(UCase(GetDomain),"/W3SVC")<>0 Then
			   GetDomain=Left(GetDomain,Instr(GetDomain,"/W3SVC"))
		 End If
		 GetDomain="http://"&GetDomain&"/"
	End Function

	'==============================
	'函 数 名：GetAdminDir
	'作    用：获取管理目录
	'==============================
	Public Function GetAdminDir()
		If Request.ServerVariables("SERVER_PORT")<>"80" Then
			GetAdminDir="http://"&Request.ServerVariables("SERVER_NAME")&":"&Request.ServerVariables("SERVER_PORT")&Request.ServerVariables("URL")
		Else
			GetAdminDir="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
		End If
		GetAdminDir=Left(GetAdminDir,InstrRev(GetAdminDir,"/")-1)
		GetAdminDir=LCase(Mid(GetAdminDir,InstrRev(GetAdminDir,"/")+1))
	End Function
	
	'==============================
	'函 数 名：FsoLineWrite
	'作    用：按行写入文件
	'==============================
	Public Function FsoLineWrite(FilePath,LineNum,LineContent)
		If LineNum<1 Then Exit Function
		Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
		If Not Fso.FileExists(Server.MapPath(FilePath)) Then Exit Function
		FsoTemp=FsoFileRead(FilePath)
		FsoTempArr=Split(FsoTemp,Chr(13)&Chr(10))
		FsoTempArr(LineNum-1)=LineContent
		FsoTemp=Join(FsoTempArr,Chr(13)&Chr(10))
		Call CreateFile(FilePath,FsoTemp)
		Set Fso=Nothing
	End Function
	
	'==============================
	'函 数 名：FsoFileRead
	'作    用：读取文件
	'==============================
	Public Function FsoFileRead(FilePath)
		Set objAdoStream=Server.CreateObject("A"&"dod"&"b.St"&"r"&"eam")
		objAdoStream.Type=2
		objAdoStream.mode=3  
		objAdoStream.charset="utf-8"
		objAdoStream.open 
		objAdoStream.LoadFromFile Server.MapPath(FilePath) 
		FsoFileRead=objAdoStream.ReadText 
		objAdoStream.Close
		Set objAdoStream=Nothing
	End Function
	
	'==============================
	'函 数 名：CopyFiles
	'作    用：复制文件
	'==============================
	Public Function CopyFiles(SourcePath,CopyToPath)
		Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
		Fso.CopyFile Server.MapPath(SourcePath),Server.MapPath(CopyToPath)
		Set Fso=Nothing
	End Function
	
	'==============================
	'函 数 名：ReNameFolder
	'作    用：重命名文件夹
	'==============================
	Public Function ReNameFolder(FolderName,NewFolderName)
		Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
		Fso.MoveFolder Server.MapPath(FolderName),Server.MapPath(NewFolderName)
		Set Fso=Nothing
	End Function 
	
	'==============================
	'函 数 名：CreateFolder
	'作    用：创建文件夹
	'==============================
	Public Function CreateFolder(FolderPath)
		If FolderPath<>"" Then
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			Set F=Fso.CreateFolder(Server.MapPath(FolderPath))
			CreateFolder=F.Path
			Set F=Nothing
			Set Fso=Nothing
		End If
	End Function
	
	'==============================
	'函 数 名：CreateHtml
	'作    用：创建文件
	'==============================
	Public Function CreateHtml(FilePath,FileContent)
		Dim f_Temp,f_TempArr,f_i
		f_Temp=""
		f_TempArr=Split(FilePath,"/")
		For f_i=0 to UBound(f_TempArr)-1
			If f_TempArr(f_i)<>"" And f_TempArr(f_i)<>".." Then
				f_Temp=f_Temp&f_TempArr(f_i)&"/"
				If IsFolder(f_Temp)=False Then
					Call CreateFolder(f_Temp)
				End If
			Else
				f_Temp=f_Temp&f_TempArr(f_i)&"/"
			End If
		Next
		Call CreateFile(FilePath,FileContent)
	End Function
	
	'==============================
	'函 数 名：CreateFile
	'作    用：创建文件
	'==============================
	Public Function CreateFile(FilePath,FileContent)
		Set objAdoStream=Server.CreateObject("A"&"dod"&"b.St"&"r"&"eam")
		objAdoStream.Type=2
		objAdoStream.Charset="utf-8" 
		objAdoStream.Open
		objAdoStream.WriteText=FileContent
		objAdoStream.SaveToFile Server.MapPath(FilePath),2
		objAdoStream.Close()
		Set objAdoStream=Nothing
	End Function
	
	'==============================
	'函 数 名：CreateFileGB2312
	'作    用：创建GB2312文件
	'==============================
	Public Function CreateFileGB2312(FilePath,FileContent)
		Set objAdoStream=Server.CreateObject("A"&"dod"&"b.St"&"r"&"eam")
		objAdoStream.Type=2
		objAdoStream.Charset="gb2312"
		objAdoStream.Open
		objAdoStream.WriteText=FileContent
		objAdoStream.SaveToFile Server.MapPath(FilePath),2
		objAdoStream.Close
		Set objAdoStream=Nothing
	End Function
	
	'==============================
	'函 数 名：IsFolder
	'作    用：检测文件夹是否存在
	'==============================
	Public Function IsFolder(FolderPath)
		If FolderPath<>"" Then
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			If Fso.FolderExists(Server.MapPath(FolderPath)) Then  
				IsFolder=True
			Else
				IsFolder=False
			End If
			Set Fso=Nothing
		End If
	End Function
	
	'==============================
	'函 数 名：IsFile
	'作    用：检测文件是否存在
	'==============================
	Public Function IsFile(FilePath)
		Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
		If (Fso.FileExists(Server.MapPath(FilePath))) Then
			IsFile=True
		Else
			IsFile=False
		End If
		Set Fso=Nothing
	End Function
	
	'==============================
	'函 数 名：DelFolder
	'作    用：删除文件夹
	'==============================
	Public Function DelFolder(FolderPath)
		If IsFolder(FolderPath)=True Then
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			Fso.DeleteFolder(Server.MapPath(FolderPath))
			Set Fso=Nothing
		End If 
	End Function 
	
	'==============================
	'函 数 名：DelFile
	'作    用：删除文件
	'==============================
	Public Function DelFile(FilePath)
		If IsFile(FilePath)=True Then 
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			Fso.DeleteFile(Server.MapPath(FilePath))
			Set Fso=Nothing
		End If
	End Function 
	
	'==============================
	'函 数 名：GetFloderList
	'作    用：获取目录列表
	'==============================
	Public Function GetFloderList(FolderPath)
		If IsFolder(FolderPath)=True Then
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			Set F=Fso.GetFolder(Server.MapPath(FolderPath))
			Set ObjFloders=F.Subfolders
			GetFloderList=""
			For Each ObjFloder In ObjFloders
				If GetFloderList="" Then
					GetFloderList=ObjFloder.Name
				Else
					GetFloderList=GetFloderList&"||"&ObjFloder.Name
				End If
			Next
			Set ObjFloders=Nothing
			Set F=Nothing
			Set Fso=Nothing
		End If
	End Function 
	
	'==============================
	'函 数 名：GetFileList
	'作    用：获取目录文件列表
	'==============================
	Public Function GetFileList(FolderPath)
		If IsFolder(FolderPath)=True Then
			Set Fso=Server.CreateObject("Scri"&"pting.File"&"Sys"&"temObject")
			Set F=Fso.GetFolder(Server.MapPath(FolderPath))
			Set ObjFiles=F.Files
			GetFileList=""
			For Each ObjFile In ObjFiles
				If GetFileList="" Then
					GetFileList=ObjFile.Name
				Else
					GetFileList=GetFileList&"||"&ObjFile.Name
				End If
			Next
			Set ObjFiles=Nothing
			Set F=Nothing
			Set Fso=Nothing
		End If
	End Function 
	
	'==========================================
	'函 数 名：CompactAccess()
	'作    用：压缩数据库
	'==========================================
	Public Function CompactAccess(BDir,BData)
		On Error Resume Next
		Dim Engine
		Set Fso=CreateObject("Scri"&"pting.FileS"&"ystemO"&"bject")
		Set Engine=CreateObject("JRO.JetEngine")
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(BData),"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(BDir)&"\Temp.mdb"
		If Err Then
			Err.Clear
			Set Fso=nothing
			Set Engine=nothing
			Call FKFun.ShowErr("数据库被打开了，无法进行压缩！",2)
			Call Response.End()
		End If
		Fso.CopyFile Server.MapPath(BDir)&"\Temp.mdb",Server.MapPath(BData)
		Fso.DeleteFile(Server.MapPath(BDir)&"\Temp.mdb")
		Set Fso=nothing
		Set Engine=nothing
	End Function
	
'========================水印缩略部分================================================================================================

	'==============================
	'函 数 名：PicWaterMark
	'作    用：图片水印
	'==============================
	Public Function PicWaterMark(DisposePic,wType,wText,wFont,wFontSize,wFontColor,wFontWeight,wPic,wPicTransparent,wPicGrounding,wPointStart,wPoint_x,wPoint_y)
		Dim JpegObj,JpegObjTemp
		Dim w_Width,w_Height,p_Width,p_Height,WaterMark_X,WaterMark_Y
		If wFontColor="" Then
			wFontColor="#000000"
		End If
		
		'判断需要打水印图片是否存在
		If Not IsFile(DisposePic) Then
			Exit Function
		End If
		Set JpegObj=Server.CreateObject("Persits.Jpeg")
		'读取需要打水印图片高宽
		JpegObj.Open Server.MapPath(DisposePic)
		p_Width=Clng(JpegObj.OriginalWidth)
		p_Height=Clng(JpegObj.OriginalHeight)
		'判断文字水印/图片水印
		If wType=1 Then
			'读取水印文字高宽
			w_Width=(wFontSize+1)*FKFun.StringLength(wText)/2
			w_Height=wFontSize+1
			'判断水印是否越界
			If p_Width>=(w_Width+wPoint_x) And p_Height>=(w_Height+wPoint_y) Then
				'获取水印坐标
				WaterMark_X=GetPosition_X(p_Width,w_Width,wPointStart,wPoint_x)
				WaterMark_Y=GetPosition_Y(p_Height,w_Height,wPointStart,wPoint_y)
				'水印处理
				JpegObj.Canvas.Font.COLOR="&H"&Replace(Right(wFontColor,6),"#","")
				JpegObj.Canvas.Font.Family=wFont
				JpegObj.Canvas.Font.size=wFontSize
				JpegObj.Canvas.Font.Bold=wFontWeight
				JpegObj.Canvas.Font.Quality=4
				JpegObj.Canvas.PrintText WaterMark_X,WaterMark_Y,wText
				JpegObj.Quality=90
				JpegObj.Save Server.MapPath(DisposePic)
			End If
		ElseIf wType=2 Then
			'判断水印图片是否存在
			If Not IsFile(wPic) Then
				Exit Function
			End If
			'读取水印图片高宽
			Set JpegObjTemp=Server.CreateObject("Persits.Jpeg")
			JpegObjTemp.Open Server.MapPath(wPic)
			w_Width=Clng(JpegObjTemp.OriginalWidth)
			w_Height=Clng(JpegObjTemp.OriginalHeight)
			If p_Width>=(w_Width+wPoint_x) And p_Height>=(w_Height+wPoint_y) Then
				'获取水印坐标
				WaterMark_X=GetPosition_X(p_Width,w_Width,wPointStart,wPoint_x)
				WaterMark_Y=GetPosition_Y(p_Height,w_Height,wPointStart,wPoint_y)
				'水印处理
				If wPicGrounding<>"" Then
					JpegObj.DrawImage WaterMark_X,WaterMark_Y,JpegObjTemp,wPicTransparent,"&H"&Replace(Right(wPicGrounding,6),"#",""),90
				Else
					JpegObj.DrawImage WaterMark_X,WaterMark_Y,JpegObjTemp,wPicTransparent
				End If
				JpegObj.Quality=90
				JpegObj.save Server.MapPath(DisposePic)
				JpegObjTemp.Close
				Set JpegObjTemp=Nothing
			End If
		End If
		JpegObj.Close
		Set JpegObj=Nothing
	End Function
	
	'==============================
	'函 数 名：GetPosition_X
	'作    用：获取X轴开始坐标
	'==============================
	Private Function GetPosition_X(wPic,wWaterMark,wPointStart,wPoint_x)
		Select Case wPointStart
			Case 0 '左上
				GetPosition_X=wPoint_x
			Case 1 '左下
				GetPosition_X=wPoint_x
			Case 2 '居中
				GetPosition_X=(wPic-wWaterMark)/2
			Case 3 '右上
				GetPosition_X=wPic-wWaterMark-wPoint_x
			Case 4 '右下
				GetPosition_X=wPic-wWaterMark-wPoint_x
			Case Else
				GetPosition_X=0
		End Select
	End Function
	
	'==============================
	'函 数 名：GetPosition_Y
	'作    用：获取Y轴开始坐标
	'==============================
	Private Function GetPosition_Y(hPic,hWaterMark,wPointStart,wPoint_y)
		Select Case wPointStart
			Case 0 '左上
				GetPosition_Y=wPoint_y
			Case 1 '左下
				GetPosition_Y=hPic-hWaterMark-wPoint_y
			Case 2 '居中
				GetPosition_Y=(hPic-hWaterMark)/2
			Case 3 '右上
				GetPosition_Y=wPoint_y
			Case 4 '右下
				GetPosition_Y=hPic-hWaterMark-wPoint_y
			Case Else
				GetPosition_Y=0
		End Select
	End Function
	
	'==============================
	'函 数 名：PicThumb
	'作    用：图片缩略
	'==============================
	Public Function PicThumb(DisposePic,SavePic,pWidth,pHeight)
		Dim JpegObj
		Dim p_Width,p_Height
		'判断需要缩略图片是否存在
		If Not IsFile(DisposePic) Then
			PicThumb=DisposePic
			Exit Function
		End If
		pWidth=Clng(pWidth)
		pHeight=Clng(pHeight)
		Set JpegObj=Server.CreateObject("Persits.Jpeg")
		'读取需要缩略图片高宽
		JpegObj.Open Server.MapPath(DisposePic)
		p_Width=Clng(JpegObj.OriginalWidth)
		p_Height=Clng(JpegObj.OriginalHeight)
		If p_Width<=pWidth And p_Height<=pHeight Then
			PicThumb=DisposePic
		Else
			'判宽判高并缩略
			If p_Width>pWidth Then
				p_Height=pWidth/p_Width*p_Height
				p_Width=pWidth
			End If
			If p_Height>pHeight Then
				p_Width=pHeight/p_Height*p_Width
				p_Height=pHeight
			End If
			JpegObj.Width=p_Width
			JpegObj.Height=p_Height
			JpegObj.Quality=95
			JpegObj.Save Server.MapPath(SavePic)
			PicThumb=SavePic
		End If
		JpegObj.Close
		Set JpegObj=Nothing
	End Function
	
'========================邮件发送部分================================================================================================
	
	'==============================
	'函 数 名：SendMail
	'作    用：邮件发送
	'==============================
	Public Function SendMail(MailTitle,MailBody,mAddress,mAccouns,mPwd,mSmtp,mTo)
		Temp=SendMail_JMail(mSmtp,mAddress,"mail",mAccouns,mPwd,mTo,MailTitle,MailBody)
		
		Select Case Temp
			Case 0
				SendMail="邮件发送成功！"
			Case 1
				SendMail="创建JMail组件失败！"
			Case 2
				SendMail="邮件发送失败！"
		End Select
	End Function 
	
	'==============================
	'函 数 名：SendMail_JMail
	'作    用：JMail邮件发送
	'==============================
	Function SendMail_JMail(s_SMTPServer,s_FromMail,s_FromName,s_MailServerUserName,s_MailServerPassword,s_ToEmail,s_Subject,s_Body)
		Dim JmailObj
		On Error Resume Next
		Set JmailObj=Server.CreateObject("JMAIL.Message")   '建立发送邮件的对象
		If Err.Number<>0 Then
			SendMail_JMail=1
			Exit Function
		End If
		JmailObj.Charset="GB2312"                            '邮件的文字编码为中文
		JmailObj.silent=True                                 '屏蔽例外错误，返回FALSE跟TRUE两值
		JmailObj.ContentType="text/html"                     '邮件的格式为HTML格式
		JmailObj.MailServerUserName=s_MailServerUserName     '登录邮件服务器所需的用户名
		JmailObj.MailServerPassword=s_MailServerPassword     '登录邮件服务器所需的密码
		JmailObj.AddRecipient s_ToEmail,""                   '邮件收件人的地址
		JmailObj.Subject=s_Subject                           '邮件的标题 
		JmailObj.Body=s_Body                                 '邮件的内容
		JmailObj.FromName=s_FromName                         '发件人姓名
		JmailObj.From=s_FromMail                             '发件人的E-MAIL地址
		JmailObj.logging=False                               '启用邮件日志
		JmailObj.ISOEncodeHeaders=False                      '防止邮件标题乱码
		JmailObj.Priority=3                                  '邮件的紧急程序，1 为最快，5 为最慢， 3 为默认值
		JmailObj.Send(s_SMTPServer)                          '执行邮件发送（通过邮件服务器地址）
		JmailObj.Close()                                     '关闭对象
		
		If JmailObj.ErrorCode <> 0 Then
			SendMail_JMail=2
		Else
			SendMail_JMail=0
		End If
	End Function
End Class
%>