<%
Function Angel_Request(ParaName)
     Dim ParaValue
     ParaValue = trim(ParaName)
	 If ParaValue="" Then Exit Function
        If Not isNumeric(ParaValue) Then
		    Response.Write "<li>  参数类型不合法"
			Response.end
	    Else
           Angel_Request = ParaValue
        End If
End Function


Function CheckStr(str)
	CheckStr=replace(replace(replace(replace(str,"<","&lt;"),">","&gt;"),chr(13),"")," ","")
	CheckStr=replace(replace(replace(replace(CheckStr,"'",""),"and",""),"insert",""),"set","")
	CheckStr=replace(replace(replace(replace(CheckStr,"select",""),"update",""),"delete",""),chr(34),"")
	CheckStr=replace(replace(replace(replace(CheckStr,"*",""),"=",""),"mid",""),"count","")
	CheckStr=replace(replace(replace(replace(CheckStr,"%",""),",",""),"union",""),"where","")
	CheckStr=replace(replace(replace(replace(replace(CheckStr,"(",""),")",""),Chr(0),""),"+",""),";","")
end Function


Function CheckStr(Strer,Num)
        Dim Shield,w
	    If Strer = "" Or IsNull(Strer) Then Exit Function
	    Select Case Num
		  Case 1
	        If IsNumeric(Strer) = 0 Then
	          Response.Write "操作错误"
		      Response.End
	        End If
			Strer = Int(Strer)
		End Select
	    CheckStr = Strer
   End Function

Function ReplaceConstChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceConstChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    tempChar = Replace(tempChar, "@@", "@")
    ReplaceConstChar = tempChar
End Function


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 = Checkstr(Trim(Mid(strIPAddr, 1, 30)))
	If getIP="" then getIP="127.0.0.1"
End Function

'禁止外部提交数据
Function checkpost(byval back)
	dim server_v1, server_v2
	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
		if not back then
			response.write "禁止外部提交" : response.end
		else
			checkpost = false
		end if
	else
		checkpost = true
	end if
end Function

'========================================================================
'******** 取到当前自动增长的ID号 **********************************************
'Z为ID字段,Table为表名
'如GetID("LeSeno_Id",Product_Class)
Function GetID(Z,Table)
		dim GetIdSql,GetIdRs
		GetIdSql="select max("&Z&") from "&Table&""
		Set GetIdRs = server.createobject("adodb.recordset")
		GetIdRs.open GetIdSql,conn,1,3
			If GetIdRs.eof And GetIdRs.bof Then
				GetID	= 1
			Else
				If GetIdRs(0)="" Or IsNull(GetIdRs(0)) Then
					GetID=1
				Else
					GetID=GetIdRs(0)+1
				End  If
			End If
End Function

'========================================================================


'用户名检测
Function ChkRegName(str)
	ChkRegName = True
	On Error Resume Next
	For i=0 To Ubound(Split(userWord,","))
		If Instr(Str,Split(userWord,",")(i)) > 0 Then
			ChkRegName = False
			Exit Function
		End If
	Next
End Function




'正则表达式过滤,html转为纯文本
'=================================================================
Function filtscript(strHTML) 
Dim objRegExp, strOutput 
Set objRegExp = New Regexp 
strOutput=strHTML 
objRegExp.IgnoreCase = True 
objRegExp.Global = True 
objRegExp.Pattern = "<[^>]*>" 
strOutput = objRegExp.Replace(strOutput, "") 
objRegExp.Pattern = "<\/[^>]*>" 
strOutput = objRegExp.Replace(strOutput, "") 
strOutput = replace(strOutput, "javascript:", "javascript :") 
filtscript = strOutput 
Set objRegExp = Nothing 
End Function
'===================================================================

'多行表单输出
'========================================================================
function htmlencode2(str)
if isNULL(str) then
	htmlencode2=""
exit function
end if
dim result
result=str
result=replace (result,"'","''")
result=replace(result,chr(13),"<br>")
result=replace(result,"    ",chr(9))
result=replace (result,chr(9),"　　")

htmlencode2=result
end function
'========================================================================


'删除服务器上的文件,DelfilePath为文件路径
'如：call deleteFile("/angelasp/news/temp.html")
function deleteFile(DelfilePath)
set fso=server.CreateObject("Scripting.FileSystemObject")
DelfilePath=server.MapPath(DelfilePath)
if fso.fileExists(DelfilePath) then
fso.deleteFile DelfilePath
end if
set fso=nothing
end function


function StrLen(Str)
  if Str="" or isnull(Str) then 
    StrLen=0
    exit function 
  else
    dim regex
    set regex=new regexp
    regEx.Pattern ="[^\x00-\xff]"
    regex.Global =true
    Str=regEx.replace(Str,"^^")
    set regex=nothing
    StrLen=len(Str)
  end if
end function

function StrLeft(Str,StrLen)
  dim L,T,I,C
  if Str="" then
    StrLeft=""
    exit function
  end if
  Str=Replace(Replace(Replace(Replace(Str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<")
  L=Len(Str)
  T=0
  for i=1 to L
    C=Abs(AscW(Mid(Str,i,1)))
    if C>255 then
      T=T+2
    else
      T=T+1
    end if
    if T>=StrLen then
      StrLeft=Left(Str,i) & "..."
      exit for
    else
      StrLeft=Str
    end if
  next
  StrLeft=Replace(Replace(Replace(replace(StrLeft," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;")
end function

function StrReplace(Str)'表单存入替换字符
  if Str="" or isnull(Str) then 
    StrReplace=""
    exit function 
  else
    StrReplace=replace(str," ","&nbsp;") '"&nbsp;"
    StrReplace=replace(StrReplace,chr(13),"&lt;br&gt;")'"<br>"
    StrReplace=replace(StrReplace,"<","&lt;")' "&lt;"
    StrReplace=replace(StrReplace,">","&gt;")' "&gt;"
  end if
end function

function ReStrReplace(Str)'写入表单替换字符
  if Str="" or isnull(Str) then 
    ReStrReplace=""
    exit function 
  else
    ReStrReplace=replace(Str,"&nbsp;"," ") '"&nbsp;"
    ReStrReplace=replace(ReStrReplace,"<br>",chr(13))'"<br>"
    ReStrReplace=replace(ReStrReplace,"&lt;br&gt;",chr(13))'"<br>"
    ReStrReplace=replace(ReStrReplace,"&lt;","<")' "&lt;"
    ReStrReplace=replace(ReStrReplace,"&gt;",">")' "&gt;"
  end if
end function

function HtmlStrReplace(Str)'写入Html网页替换字符
  if Str="" or isnull(Str) then 
    HtmlStrReplace=""
    exit function 
  else
    HtmlStrReplace=replace(Str,"&lt;br&gt;","<br>")'"<br>"
  end if
end function


Function GetUrl()
  GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
  If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
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 = Mid(name, i, 1)
      if InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-.", 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

Class ImgWHInfo '获取图片宽度和高度的类，支持JPG，GIF，PNG，BMP
    Dim ASO
    Private Sub Class_Initialize
        Set ASO=Server.CreateObject("ADODB.Stream")
        ASO.Mode=3
        ASO.Type=1
        ASO.Open
    End Sub
    Private Sub Class_Terminate
        Err.Clear
        Set ASO=Nothing
    End Sub 
 
    Private Function Bin2Str(Bin)
        Dim I, Str
        For I=1 To LenB(Bin)
            clow=MidB(Bin,I,1)
            If ASCB(clow)<128 Then
                Str = Str & Chr(ASCB(clow))
            Else
                I=I+1
                If I <= LenB(Bin) Then Str = Str & Chr(ASCW(MidB(Bin,I,1)&clow))
            End If
        Next
        Bin2Str = Str
    End Function
      
    Private Function Num2Str(Num,Base,Lens)
        Dim Ret
        Ret = ""
        While(Num>=Base)
            Ret = (Num Mod Base) & Ret
            Num = (Num - Num Mod Base)/Base
        Wend
        Num2Str = Right(String(Lens,"0") & Num & Ret,Lens)
    End Function
      
    Private Function Str2Num(Str,Base) 
        Dim Ret,I
        Ret = 0 
        For I=1 To Len(Str) 
            Ret = Ret *base + Cint(Mid(Str,I,1)) 
        Next 
        Str2Num=Ret 
    End Function 
      
    Private Function BinVal(Bin) 
        Dim Ret,I
        Ret = 0 
        For I = LenB(Bin) To 1 Step -1 
            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
        Next 
        BinVal=Ret 
    End Function 
      
    Private Function BinVal2(Bin) 
        Dim Ret,I
        Ret = 0 
        For I = 1 To LenB(Bin) 
            Ret = Ret *256 + AscB(MidB(Bin,I,1)) 
        Next 
        BinVal2=Ret 
    End Function 
      
    Private Function GetImageSize(filespec)
        Dim bFlag
        Dim Ret(3) 
        ASO.LoadFromFile(filespec) 
        bFlag=ASO.Read(3) 
        Select Case Hex(binVal(bFlag)) 
        Case "4E5089": 
            ASO.Read(15) 
            ret(0)="PNG" 
            ret(1)=BinVal2(ASO.Read(2)) 
            ASO.Read(2) 
            ret(2)=BinVal2(ASO.Read(2)) 
        Case "464947": 
            ASO.read(3) 
            ret(0)="gif" 
            ret(1)=BinVal(ASO.Read(2)) 
            ret(2)=BinVal(ASO.Read(2)) 
        Case "535746": 
            ASO.read(5) 
            binData=ASO.Read(1) 
            sConv=Num2Str(ascb(binData),2 ,8) 
            nBits=Str2Num(left(sConv,5),2) 
            sConv=mid(sConv,6) 
            While(len(sConv)<nBits*4) 
                binData=ASO.Read(1) 
                sConv=sConv&Num2Str(AscB(binData),2 ,8) 
            Wend 
            ret(0)="SWF" 
            ret(1)=Int(Abs(Str2Num(Mid(sConv,1*nBits+1,nBits),2)-Str2Num(Mid(sConv,0*nBits+1,nBits),2))/20) 
            ret(2)=Int(Abs(Str2Num(Mid(sConv,3*nBits+1,nBits),2)-Str2Num(Mid(sConv,2*nBits+1,nBits),2))/20) 
        Case "FFD8FF": 
            Do  
            Do: p1=binVal(ASO.Read(1)): Loop While p1=255 And Not ASO.EOS 
            If p1>191 And p1<196 Then Exit Do Else ASO.read(binval2(ASO.Read(2))-2) 
            Do:p1=binVal(ASO.Read(1)):Loop While p1<255 And Not ASO.EOS 
            Loop While True 
            ASO.Read(3) 
            ret(0)="JPG" 
            ret(2)=binval2(ASO.Read(2)) 
            ret(1)=binval2(ASO.Read(2)) 
        Case Else: 
            If left(Bin2Str(bFlag),2)="BM" Then 
                ASO.Read(15) 
                ret(0)="BMP" 
                ret(1)=binval(ASO.Read(4)) 
                ret(2)=binval(ASO.Read(4)) 
            Else 
                    ret(0)="" 
            End If 
        End Select 
        ret(3)="width=""" & ret(1) &""" height=""" & ret(2) &"""" 
        getimagesize=ret 
    End Function 
      
    Public Function imgW(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = Server.CreateObject("Scripting.FileSystemObject") 
        If (FSO.FileExists(IMGPath)) Then 
            Set IMGFile = FSO.GetFile(IMGPath) 
            FileExt=FSO.GetExtensionName(IMGPath) 
            Select Case FileExt 
                Case "gif","bmp","jpg","png": 
                Arr=GetImageSize(IMGFile.Path) 
                imgW = Arr(1) 
            End Select 
            Set IMGFile=Nothing 
        Else
            imgW = 0
        End If     
        Set FSO=Nothing 
    End Function 
     
    Public Function imgH(IMGPath)
        Dim FSO,IMGFile,FileExt,Arr
        Set FSO = server.CreateObject("Scripting.FileSystemObject") 
        If (FSO.FileExists(IMGPath)) Then 
            Set IMGFile = FSO.GetFile(IMGPath) 
            FileExt=FSO.GetExtensionName(IMGPath) 
            Select Case FileExt 
                Case "gif","bmp","jpg","png": 
                Arr=getImageSize(IMGFile.Path) 
                imgH = Arr(2) 
            End Select 
            Set IMGFile=Nothing 
        Else
            imgH = 0 
        End If     
        Set FSO=Nothing 
    End Function 
End Class

function GetIp()
dim realip,proxy
realip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
proxy = Request.ServerVariables("REMOTE_ADDR")
if realip = "" then
GetIp = proxy
else
GetIp = realip
end if
end function 

Function CreateFolder(ByVal angel0)
	Dim angel1,angel2,objFSO,i
	On Error Resume Next
	angel0=Server.MapPath(angel0)
	IF InStr(angel0,"\")<=0 Or InStr(angel0,":")<=0 Then:CreateFolder=False:Exit Function
	Set objFSO=CreateObject("Scripting.FileSystemObject") 
		IF objFSO.FolderExists(angel0) Then:CreateFolder=True:Exit Function  
		angel1=Split(angel0,"\"):angel2="" 
		For i=0 To UBound(angel1)  
			angel2=angel2&angel1(i)&"\"
			IF Not objFSO.FolderExists(angel2) Then objFSO.CreateFolder(angel2) 
		Next 
	Set objFSO=Nothing 
	IF Err=0 Then CreateFolder=True:Else CreateFolder=False
End Function

function createfile(byval content,byval filedir)
	on error resume next
	dim obj : set obj = server.createobject("adodb.Stream")
	obj.type = 2
	obj.open
	obj.charset = "GB2312"
	obj.position = obj.Size
	obj.writeText = content
	obj.savetofile server.mappath(filedir), 2
	obj.close
	if err then err.clear: createfile = false else createfile = true
	set obj = nothing
End function


Function Alert(message,gourl)
    message = replace(message,"'","\'")
    If gourl="-1" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
    ElseIf gourl="-2" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-2)</script>")
    ElseIf gourl="Close" then
		Response.Write ("<script language=javascript>alert('" & message & "');window.opener=null;window.close();</script>")
	Else
        Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>")
    End If
    Response.End()
End Function


Function LoseHtml(ContentStr)
 Dim ClsTempLoseStr,regEx
	ClsTempLoseStr = Cstr(ContentStr)
	Set regEx = New RegExp
	regEx.Pattern = "<(.[^>]*)>"
	regEx.IgnoreCase = True
	regEx.Global = True
	ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
	RegEx.Pattern = "(&.+?;)"
	ClsTempLoseStr = RegEx.Replace(ClsTempLoseStr, "")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbCrlf,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbCr,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,VbLf,"")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"  ","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"""","'")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"[code]","")
	ClsTempLoseStr = Replace(ClsTempLoseStr,"<!--","")
	ClsTempLoseStr = Trim(ClsTempLoseStr)
 LoseHtml = ClsTempLoseStr
End Function

'=======格式化时间
Function FormatDate(DateAndTime, Format)
  On Error Resume Next
  Dim yy,y, m, d, h, mi, s, strDateTime
  FormatDate = DateAndTime
  If Not IsNumeric(Format) Then Exit Function
  If Not IsDate(DateAndTime) Then Exit Function
  yy = CStr(Year(DateAndTime))
  y = Mid(CStr(Year(DateAndTime)),3)
  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 Format
  Case "1"
    strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
  Case "2"
    strDateTime = yy & m & d & h & mi & s
  Case "3"
    strDateTime = yy & m & d & h & mi
  Case "4"
    strDateTime = yy & "年" & 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 "11"
    strDateTime = y & "-" & m & "-" & d
  Case "12"
    strDateTime = y & "/" & m & "/" & d
  Case "13"
    strDateTime = yy & "." & m & "." & d
  Case "14"
    strDateTime = yy & "/" & m & "/" & d
  Case "15"
    strDateTime = yy & "-" & m & "-" & d
  Case Else
    strDateTime = DateAndTime
  End Select
  FormatDate = strDateTime
End Function


function AngelCMSHeadNavigation(Headid,Lid)
  dim rs,sql,rss,sqll,AngelString
  AngelString=""
  set rs = server.createobject("adodb.recordset")
  sql="select top 8 * from Angel_Navtions where ViewFlag and Angel_languageid="&Lid&" and Parentid=0 order by Sequence asc,id asc"
  rs.open sql,conn,1,1
  if rs.bof and rs.eof then
    response.write "暂无导航"
  else
  dim i
  i=1
	Do

set rss = server.createobject("adodb.recordset")
  sqll="select * from Angel_Navtions where ViewFlag and Parentid="&rs("id")&" and Angel_languageid="&Lid&" order by Sequence asc"
  rss.open sqll,conn,1,1
   if rss.bof and rss.eof then
    goon=1
  else
    goon=0
  end if
  rss.close

If ishtml = 1 Then

if goon=1 then
AngelString=AngelString&"<li class=""class1""><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
AngelString=AngelString&"<li class=""va_line"" style=""width:6px""></li>"&VbCrLf
Else
AngelString=AngelString&"<li class=""class1"" id=""nav_"&i&"""><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a>"
AngelString=AngelString&Childs(rs("id"),Lid)
AngelString=AngelString&"</li>"	
AngelString=AngelString&"<li class=""va_line"" style=""width:6px""></li>"&VbCrLf
end If



Else

if goon=1 Then
AngelString=AngelString&"<li class=""class1""><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
AngelString=AngelString&"<li class=""va_line"" style=""width:6px""></li>"&VbCrLf
Else
AngelString=AngelString&"<li class=""class1"" id=""nav_"&i&"""><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a>"
AngelString=AngelString&Childs(rs("id"),Lid)
AngelString=AngelString&"</li>"
AngelString=AngelString&"<li class=""va_line"" style=""width:6px""></li>"&VbCrLf
end if  

End If
	  rs.movenext
	  i=i+1
	loop until rs.eof
  end if
  rs.close
  set rs=Nothing
  AngelCMSHeadNavigation=AngelString
end Function

Function Footerlist()
Dim SQL,Rs,StringsText
StringsText=""
SQL="select top 1 * from Angel_Site"
set Rs=server.createobject("adodb.recordset")
Rs.open SQL,conn,1,1
if not Rs.eof then
StringsText=rs("copyright")
end if
Rs.close
set Rs=Nothing
StringsText=""&StringsText&""&"<!--<span style=""font-family: Tahoma;"">Copyrights 2010-"&Year(Now())&"<a href=""http://www.angelasp.com/"">Angel_asp</a> Inc. All rights reserved</span>-->"
Footerlist=StringsText
End Function 

Function Childs(id,lid)
Dim rss,sqll,AngelStrings
AngelStrings="<ul style=""display:none;"">"
set rss = server.createobject("adodb.recordset")
  sqll="select * from Angel_Navtions where ViewFlag and Parentid="&id&" and Angel_languageid="&Lid&" order by Sequence asc"
  rss.open sqll,conn,1,1
  if rss.bof And rss.eof Then 
  Else 
do while not rss.eof
If ISHTML = 1 Then
AngelStrings=AngelStrings&"<li><a href="""&AngelSysRootDir&rss("HtmlNavUrl")&""">"&rss("NavName")&"</a></li>"&VbCrLf
Else
AngelStrings=AngelStrings&"<li><a href="""&AngelSysRootDir&rss("NavUrl")&""">"&rss("NavName")&"</a></li>"&VbCrLf
end if
rss.movenext
  loop
End If 
rss.close
Set rss=Nothing 
AngelStrings=AngelStrings&"</ul>"
Childs=AngelStrings
End Function 


function AngelCMSHeadNavigations(Headid,Angel_languageid)
  dim rs,sql,rss,sqll,AngelString
  AngelString=""
  set rs = server.createobject("adodb.recordset")
  sql="select top 8 * from Angel_Navtions where ViewFlag and Angel_languageid="&Angel_languageid&" and Parentid=0 order by Sequence asc,id asc"
  rs.open sql,conn,1,1
  if rs.bof and rs.eof then
    response.write "暂无导航"
  else
  dim i
  i=1
	Do

set rss = server.createobject("adodb.recordset")
  sqll="select * from Angel_Navtions where ViewFlag and Angel_languageid="&Angel_languageid&" and Parentid="&rs("id")&" order by Sequence asc"
  rss.open sqll,conn,1,1
   if rss.bof and rss.eof then
    goon=1
  else
    goon=0
  end if
  rss.close

If ishtml = 1 Then

If rs("NavName")="产品中心" Then 
if rs("Sequence")=Headid Then
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a>"&VbCrLf
AngelString=AngelString&"<ul id=""snavss"" style=""height:auto;background-color:#FAF2ED; text-align:center;"">"&VbCrLf
AngelString=AngelString&NavProlists(0)&VbCrLf  
AngelString=AngelString&"</ul>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf
Else 

AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a>"&VbCrLf
AngelString=AngelString&"<ul id=""snavss"" style=""height:auto;background-color:#FAF2ED; text-align:center;"">"&VbCrLf
AngelString=AngelString&NavProlists(0)&VbCrLf  
AngelString=AngelString&"</ul>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf

end If

Else 
if rs("Sequence")=Headid Then
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
Else
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("HtmlNavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
end If
End If 


Else


If rs("NavName")="产品中心" Then 

if rs("Sequence")=Headid Then
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a>"&VbCrLf
AngelString=AngelString&"<ul id=""snavss"" style=""height:auto;background-color:#FAF2ED;text-align:center;"">"&VbCrLf
AngelString=AngelString&NavProlists(0)&VbCrLf  
AngelString=AngelString&"</ul>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf
Else
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a>"&VbCrLf
AngelString=AngelString&"<ul id=""snavss"" style=""height:auto;background-color:#FAF2ED;text-align:center;"">"&VbCrLf
AngelString=AngelString&NavProlists(0)&VbCrLf               
AngelString=AngelString&"</ul>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf
end If


Else 

if rs("Sequence")=Headid Then
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
Else
AngelString=AngelString&"<li><a href="""&AngelSysRootDir&rs("NavUrl")&""">"&rs("NavName")&"</a></li>"&VbCrLf
end If

End If 


End If
	  rs.movenext
	  i=i+1
	loop until rs.eof
  end if
  rs.close
  set rs=Nothing
  AngelCMSHeadNavigations=AngelString
end Function








'***********************************************
'函数名：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


'***********************************************
'过程名：showpage
'作  用：显示“上一页 下一页”等信息
'参  数：sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
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'><tr><td>"
	strTemp=strTemp & "共 <b>" & totalnumber & "</b></font> " & strUnit & "&nbsp;&nbsp;&nbsp;"
	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;转到第<input type='text' name='pageshow' size='2' maxlength='5' value='1' onKeyPress=""if(event.keyCode==13) window.location='Admin_Count.Asp?action=all&pageshow='+this.value;"" onBlur=""window.location='Admin_Count.Asp?action=all&pageshow='+this.value;"">页 <input name="""" type=""button"" value=""转到"" />"
	end if
	strTemp=strTemp & "</td></tr></table>"
	response.write strTemp
end sub


Function ShowCount(strsql)
	set rs = server.CreateObject ("adodb.recordset")
	rs.open strsql,conn,1,1
	If Not rs.eof Then 
    ShowCount=rs(0)
	Else 
	ShowCount=0
	End If 
    rs.close
	Set rs = Nothing	
End Function 

Sub FsoDelHtml(HTMLName)
Dim Fso,FsoOut,File
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
ChSysRootDir="/"
Response.Write "<table class=""tableborder"" width=""95%"" border=""0"" align=""center"" cellpadding=""3"" cellspacing=""1"">"
Set FsoOut = Fso.GetFolder(Server.Mappath(ChSysRootDir))
    For Each File In FsoOut.Files
        If LCase(Mid(File.Name,InStrRev(File.Name,".")))="."&HTMLName&"" And HTMLName <> "asp" Then
 Response.Write "  <tr>"
 Response.Write "    <td width=""20%"" align=""right"" class=""forumRow"">" & File.Name & "</td>"
 Response.Write "   <td width=""80%"" class=""forumRowHighlight"">删除成功</td>"
 Response.Write "  </tr>"
            Fso.DeleteFile File.Path,True
        End If
    Next
Set FsoOut = Nothing
Set Fso = Nothing
Response.Write "</table>"
End Sub


function FileDelHtml(HTMLName,SelectID)
Dim filepath,deleteFileObject,delefilepath
filepath=HTMLName&SelectID&".html"
Set deleteFileObject=Server.CreateObject("Scripting.FileSystemObject") 
delefilepath=Server.MapPath(filepath) 
if deleteFileObject.FileExists(delefilepath) then 
Set delefilepath=deleteFileObject.GetFile(delefilepath) 
delefilepath.Delete 
else 
end if
set deleteFileObject=nothing
End Function 



'导航产品分类
function NavProlist(ParentID)
  dim rs,sql,AngelString
  AngelString=""
  set rs = server.createobject("adodb.recordset")
  sql="select * from Angel_ProductSort where ViewFlag and ParentID="&ParentID&" order by ID asc"
  rs.open sql,conn,1,1
  if conn.execute("select ID from Angel_ProductSort Where ViewFlag and ParentID=0").eof then
    response.write "<li style=""height:105px;width:105px;background:none;float:left;margin-left:0px;"">暂无相关信息</li>"
  end if
  do while not rs.eof
AutoLink = "ProductList.asp?SortID="&rs("ID")&""
AngelString=AngelString&"<li style=""height:105px;width:105px;background:none;float:left;margin-left:0px;"">"&VbCrLf
AngelString=AngelString&"<div style=""height:60px;width:105px;margin-top:7px;"">"&VbCrLf
AngelString=AngelString&"<img src="""&rs("Sortpic")&""" width=""60"" height=""60px"" />"&VbCrLf
AngelString=AngelString&" </div>"&VbCrLf
AngelString=AngelString&"<div id=""dvtop"" style=""height:25px;width:105px;line-height:25px; cursor:hand;"" rel="""&AutoLink&"""> "&Left(rs("SortName"),10)&"&nbsp;<img src=""images/11.jpg"" alt=""""/>"&VbCrLf
AngelString=AngelString&"</div>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf
 i=i+1
	rs.movenext
  loop 
  rs.close
  set rs=Nothing
  NavProlist=AngelString
end Function




function NavProlists(ParentID)
  dim rs,sql,AngelString
  AngelString=""
  set rs = server.createobject("adodb.recordset")
  sql="select * from Angel_ProductSort where ViewFlag and ParentID="&ParentID&" order by ID asc"
  rs.open sql,conn,1,1
  if conn.execute("select ID from Angel_ProductSort Where ViewFlag and ParentID=0").eof then
    response.write "<li style=""height:105px;width:105px;background:none;float:left;margin-left:0px;"">暂无相关信息</li>"
  end if
  do while not rs.eof
AutoLink = "ProductList.asp?SortID="&rs("ID")&""
AngelString=AngelString&"<li style=""height:auto;width:100%;background:#fff;float:left;text-align:left;"">"&VbCrLf
AngelString=AngelString&"<a href="""&AutoLink&""">"&Left(rs("SortName"),10)&"</a>"&VbCrLf
AngelString=AngelString&"</li>"&VbCrLf
 i=i+1
	rs.movenext
  loop 
  rs.close
  set rs=Nothing
  NavProlists=AngelString
end Function




%>