function.asp

1

<%
'==================================================
'函数名：FY_DefiniteUrl
'作  用：将相对地址转换为绝对地址
'参  数：PrimitiveUrl ------要转换的相对地址
'参  数：ConsultUrl ------当前网页地址
'==================================================
Function FY_DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
   Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
   If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" Then
      FY_DefiniteUrl="$False$"
      Exit Function
   End If
   If UCase(Left(ConsultUrl,7))<>UCase("HTTP://") Then
      ConsultUrl= "http://" & ConsultUrl
   End If
   ConsultUrl=Replace(ConsultUrl,"://",":\\")
   If Right(ConsultUrl,1)<>"/" Then
      If Instr(ConsultUrl,"/")>0 Then
         If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then   
         Else
            ConsultUrl=ConsultUrl & "/"
         End If
      Else
         ConsultUrl=ConsultUrl & "/"
      End If
   End If
   ConArray=Split(ConsultUrl,"/")
   If UCase(Left(PrimitiveUrl,7)) = UCase("http://") then
      FY_DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")
   ElseIf Left(PrimitiveUrl,1) = "/" Then
      FY_DefiniteUrl=ConArray(0) & PrimitiveUrl
   ElseIf Left(PrimitiveUrl,2)="./" Then
      FY_DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
   ElseIf Left(PrimitiveUrl,3)="../" then
      Do While Left(PrimitiveUrl,3)="../"
         PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
         Pi=Pi+1
      Loop            
      For Ci=0 to (Ubound(ConArray)-1-Pi)
         If FY_DefiniteUrl<>"" Then
            FY_DefiniteUrl=FY_DefiniteUrl & "/" & ConArray(Ci)
         Else
            FY_DefiniteUrl=ConArray(Ci)
         End If
      Next
      FY_DefiniteUrl=FY_DefiniteUrl & "/" & PrimitiveUrl
   Else
      If Instr(PrimitiveUrl,"/")>0 Then
         PriArray=Split(PrimitiveUrl,"/")
         If Instr(PriArray(0),".")>0 Then
            If Right(PrimitiveUrl,1)="/" Then
               FY_DefiniteUrl="http:\\" & PrimitiveUrl
            Else
               If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 
                  FY_DefiniteUrl="http:\\" & PrimitiveUrl
               Else
                  FY_DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               End If
            End If      
         Else
            If Right(ConsultUrl,1)="/" Then   
               FY_DefiniteUrl=ConsultUrl & PrimitiveUrl
            Else
               FY_DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
            End If
         End If
      Else
         If Instr(PrimitiveUrl,".")>0 Then
            If Right(ConsultUrl,1)="/" Then
               If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then
                  FY_DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               Else
                  FY_DefiniteUrl=ConsultUrl & PrimitiveUrl
               End If
            Else
               If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then
                  FY_DefiniteUrl="http:\\" & PrimitiveUrl & "/"
               Else
                  FY_DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
               End If
            End If
         Else
            If Right(ConsultUrl,1)="/" Then
               FY_DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
            Else
               FY_DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
            End If         
         End If
      End If
   End If
   If Left(FY_DefiniteUrl,1)="/" then
     FY_DefiniteUrl=Right(FY_DefiniteUrl,Len(FY_DefiniteUrl)-1)
   End if
   If FY_DefiniteUrl<>"" Then
      FY_DefiniteUrl=Replace(FY_DefiniteUrl,"//","/")
      FY_DefiniteUrl=Replace(FY_DefiniteUrl,":\\","://")
   Else
      FY_DefiniteUrl=PrimitiveUrl
   End If
   ConsultUrl=""
   PrimitiveUrl=""
End Function


'获取小说状态
Function FY_XSZT(FY_XS_ID)
If FY_XS_ID=0 Then
FY_XSZT="全书完"
Else
FY_XSZT="连载中"
End if
End Function

'获取推荐程度
Function FY_XSTJ(FY_XS_ID)
If FY_XS_ID=0 Then
FY_XSTJ="普通"
ElseIf FY_XS_ID=1 Then
FY_XSTJ="编辑推荐"
ElseIf FY_XS_ID=2 Then
FY_XSTJ="潜 力 榜"
Else
FY_XSTJ="封面推荐"
End if
End Function

'获取打开方式
Function FY_OpenType(FY_OpenType_ID)
If FY_OpenType_ID=0 Then
FY_OpenType=" target=""_self"""
Else
FY_OpenType=" target=""_blank"""
End if
End Function

'获取章节名称
Function FY_Contents_Name(FY_Contents_ID)
FY_Contents_ID=FY_CLng(FY_Contents_ID)
If FY_Contents_ID<>0 Then
Dim FY_Rs,FY_sql
set FY_Rs=server.createobject("adodb.recordset")
FY_sql="select 章节名称 from [章节] where 编号="&FY_Contents_ID&""
FY_Rs.open FY_sql,conn,1,1
if Not(FY_Rs.bof and FY_Rs.eof) then 
FY_Contents_Name=FY_Rs(0)
Else
FY_Contents_Name=""
End if
FY_Rs.close
set FY_Rs=nothing
End if
End Function

'获取章节地址
'FY_Contents_ID章节ID
'FY_Class_ID 类别ID
Function FY_Contents_Url(FY_Contents_ID,FY_Class_ID,FY_Novel_ID)
FY_Contents_ID=FY_CLng(FY_Contents_ID)
If FY_Contents_ID<>0 Then
Dim FY_Contents_Url_MB,FY_Class_Url_KZ
FY_Contents_Url=""
FY_Contents_Url_MB=FY_SC_UrlMb(FY_Class_ID,2)
If FY_Cache.CacheIsEmpty("FY_Class_Url_"&FY_Class_ID&"") Then
FY_Class_Url_KZ=conn.execute("select 文件扩展名 from [分类] where 编号="&FY_Class_ID&"")(0)
FY_Cache.SetValue "FY_Class_Url_"&FY_Class_ID&"",FY_Class_Url_KZ
Else
FY_Class_Url_KZ=FY_Cache.GetValue("FY_Class_Url_"&FY_Class_ID&"")
End if
If FY_Contents_ID=-1 Then '获取章节列表路径
If FY_Class_Url_KZ<>0 Then
FY_Contents_Url_MB=FY_Name_Url(FY_Contents_Url_MB,1)
FY_Contents_Url=FY_Replace(FY_Contents_Url_MB,".","")
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$栏目编号}",FY_Class_ID)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$分类英文简称}",FY_Class_Ename(FY_Class_ID))
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$小说编号}",FY_Novel_ID)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$章节编号}",0)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$页面格式}",FY_Html_Name(FY_Class_Url_KZ))
FY_Contents_Url=FY_Contents_Url&"Index."&FY_Html_Name(FY_Class_Url_KZ)
Else
FY_Contents_Url=InstallDir&"Novel.Asp?ID="&FY_Novel_ID&"&Y=-1"
End if
Else
If FY_Class_Url_KZ<>0 Then
FY_Contents_Url=FY_Replace(FY_Contents_Url_MB,"{$栏目编号}",FY_Class_ID)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$分类英文简称}",FY_Class_Ename(FY_Class_ID))
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$小说编号}",FY_Novel_ID)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$章节编号}",FY_Contents_ID)
FY_Contents_Url=FY_Replace(FY_Contents_Url,"{$页面格式}",FY_Html_Name(FY_Class_Url_KZ))
Else
FY_Contents_Url=InstallDir&"Contents.Asp?ID="&FY_Contents_ID&""
End if
End if
Else
FY_Contents_Url="#错误章节编号"
End if
End Function

'获取小说封面图片
Function FY_Novel_Pic(Novel_Pic)
If Novel_Pic<>"" Then
FY_Novel_Pic=FY_Config(3)&""&InstallDir&""&FY_Config(9)&"/"&Novel_Pic&""
Else
FY_Novel_Pic=FY_Config(3)&""&InstallDir&"images/nopic.Gif"
End if
End Function

'获取小说地址
'FY_Novel_ID 小说ID
'FY_Class_ID 类别ID
Function FY_Novel_Url(FY_Novel_ID,FY_Class_ID)
Dim FY_Novel_Url_MB,FY_Class_Url_KZ
FY_Novel_Url=""
FY_Novel_Url_MB=FY_SC_UrlMb(FY_Class_ID,1)
If FY_Cache.CacheIsEmpty("FY_Class_Url_"&FY_Class_ID&"") Then
FY_Class_Url_KZ=conn.execute("select 文件扩展名 from [分类] where 编号="&FY_Class_ID&"")(0)
FY_Cache.SetValue "FY_Class_Url_"&FY_Class_ID&"",FY_Class_Url_KZ
Else
FY_Class_Url_KZ=FY_Cache.GetValue("FY_Class_Url_"&FY_Class_ID&"")
End if
If FY_Class_Url_KZ<>0 Then
FY_Novel_Url=FY_Replace(FY_Novel_Url_MB,"{$栏目编号}",FY_Class_ID)
FY_Novel_Url=FY_Replace(FY_Novel_Url,"{$分类英文简称}",FY_Class_Ename(FY_Class_ID))
FY_Novel_Url=FY_Replace(FY_Novel_Url,"{$小说编号}",FY_Novel_ID)
FY_Novel_Url=FY_Replace(FY_Novel_Url,"{$页面格式}",FY_Html_Name(FY_Class_Url_KZ))
Else
FY_Novel_Url=InstallDir&"Novel.Asp?Id="&FY_Novel_ID&""
End if
End Function

'获取生成文件路径格式
'FY_Class_ID 栏目ID
'FY_UrlMb_L  获取类型 0为分类路径 1为小说介绍页路径 2为章节路径
Function FY_SC_UrlMb(FY_Class_ID,FY_UrlMb_L)
Dim FY_UrlMb_LC
FY_SC_UrlMb=""
FY_Class_ID=FY_CLng(FY_Class_ID)
FY_UrlMb_L=FY_CLng(FY_UrlMb_L)
If FY_UrlMb_L=0 Then
FY_UrlMb_LC="分类生成模式"
ElseIf FY_UrlMb_L=1 Then
FY_UrlMb_LC="小说生成模式"
Else
FY_UrlMb_LC="章节生成模式"
End if
If FY_Class_ID<>0 Then
If FY_Cache.CacheIsEmpty("FY_SC_UrlMb_"&FY_Class_ID&"_"&FY_UrlMb_L&"") Then
FY_SC_UrlMb="{$分类英文简称}/"&conn.execute("select "&FY_UrlMb_LC&" from [分类] where 编号="&FY_Class_ID&"")(0)&".{$页面格式}"
FY_Cache.SetValue "FY_SC_UrlMb_"&FY_Class_ID&"_"&FY_UrlMb_L&"",FY_SC_UrlMb 
Else
FY_SC_UrlMb=FY_Cache.GetValue("FY_SC_UrlMb_"&FY_Class_ID&"_"&FY_UrlMb_L&"")
End if
End if
End Function

'获取字段中的目录名或文件名
'FY_Name_Url_A 为内容
'FY_Name_Url_B 为方式 1为获取目录 0为获取文件名
Function FY_Name_Url(FY_Name_Url_A,FY_Name_Url_B)
FY_Name_Url=""
Dim FY_Name_Url_C
If FY_Name_Url_A<>"" Then
FY_Name_Url_C=split(FY_Name_Url_A,"/")
FY_Name_Url_A=FY_Replace(FY_Replace(FY_Name_Url_A,"\","/"),"//","/")
If FY_Name_Url_B=0 Then
FY_Name_Url=FY_Name_Url_C(Ubound(FY_Name_Url_C))
Else
FY_Name_Url=FY_Replace(FY_Name_Url_A,FY_Name_Url_C(Ubound(FY_Name_Url_C)),"")
End if
End if
End Function

'获取栏目地址
Function FY_Class_Url(FY_Class_ID,FY_Class_Y)
FY_Class_Url=""
Dim FY_Class_Url_KZ
If FY_Cache.CacheIsEmpty("FY_Class_Url_"&FY_Class_ID&"") Then
FY_Class_Url_KZ=conn.execute("select 文件扩展名 from [分类] where 编号="&FY_Class_ID&"")(0)
FY_Cache.SetValue "FY_Class_Url_"&FY_Class_ID&"",FY_Class_Url_KZ
Else
FY_Class_Url_KZ=FY_Cache.GetValue("FY_Class_Url_"&FY_Class_ID&"")
End if
If FY_Class_Url_KZ<>0 Then
FY_Class_Url=FY_SC_UrlMb(FY_Class_ID,0)
If FY_Class_Y<2 Then
FY_Class_Url=FY_Name_Url(FY_Class_Url,1)&"Index."&FY_Html_Name(FY_Class_Url_KZ)
End if
FY_Class_Url=FY_Replace(FY_Class_Url,"{$分类英文简称}",FY_Class_Ename(FY_Class_ID))
FY_Class_Url=FY_Replace(FY_Class_Url,"{$栏目编号}",FY_Class_ID)
FY_Class_Url=FY_Replace(FY_Class_Url,"{$分页编号}",FY_Class_Y)
FY_Class_Url=FY_Replace(FY_Class_Url,"{$页面格式}",FY_Html_Name(FY_Class_Url_KZ))
Else
If FY_Class_Y<2 Then
FY_Class_Url=InstallDir&"Class.Asp?ID="&FY_Class_ID&""
Else
FY_Class_Url=InstallDir&"Class.Asp?ID="&FY_Class_ID&"&Y="&FY_Class_Y&""
End If
End if
End Function

'获取栏目目录
Function FY_Class_Ename(FY_Class_ID)
FY_Class_Ename=""
FY_Class_ID=FY_CLng(FY_Class_ID)
If FY_Class_ID<>0 Then
If FY_Cache.CacheIsEmpty("FY_Class_Ename_"&FY_Class_ID&"") Then
FY_Class_Ename=InstallDir&""&conn.execute("select 目录名称 from [分类] where 编号="&FY_Class_ID&"")(0)
FY_Cache.SetValue "FY_Class_Ename_"&FY_Class_ID&"",FY_Class_Ename 
Else
FY_Class_Ename=FY_Cache.GetValue("FY_Class_Ename_"&FY_Class_ID&"")
End if
End if
End Function

'获取栏目名称
Function FY_Class_Name(FY_Class_ID)
FY_Class_ID=FY_CLng(FY_Class_ID)
If FY_Class_ID<>0 Then
If FY_Cache.CacheIsEmpty("FY_Class_Name_"&FY_Class_ID&"") Then
FY_Class_Name=conn.execute("select 分类名称 from [分类] where 编号="&FY_Class_ID&"")(0)
FY_Cache.SetValue "FY_Class_Name_"&FY_Class_ID&"",FY_Class_Name 
Else
FY_Class_Name=FY_Cache.GetValue("FY_Class_Name_"&FY_Class_ID&"")
End if
End if
End Function
'转变时间显示
Function FY_Time(Time_A,Time_B)
' year(Time_A) 年 
' month(Time_A) 月 
' day(Time_A) 日
Time_B=FY_CLng(Time_B)
  If Time_B=1 Then
  FY_Time=year(Time_A)&"-"&month(Time_A)&"-"&day(Time_A)
  ElseIf Time_B=2 Then
  FY_Time=month(Time_A)&"-"&day(Time_A)
  ElseIf Time_B=3 Then
  FY_Time=year(Time_A)&"/"&month(Time_A)&"/"&day(Time_A)
  ElseIf Time_B=4 Then
  FY_Time=month(Time_A)&"/"&day(Time_A)
  ElseIf Time_B=5 Then
  FY_Time=year(Time_A)&"年"&month(Time_A)&"月"&day(Time_A)&"日"
  ElseIf Time_B=6 Then
  FY_Time=month(Time_A)&"月"&day(Time_A)&"日"
  Else
  FY_Time=Time_A
  End if
End Function

'判断文件类型
Function FY_Html_Name(FY_Html_Name_HQ_A)
FY_Html_Name_HQ_A=FY_CLng(FY_Html_Name_HQ_A)
  If FY_Html_Name_HQ_A=0 Then
  FY_Html_Name="Asp"
  ElseIf FY_Html_Name_HQ_A=1 Then
  FY_Html_Name="Htm"
  ElseIf FY_Html_Name_HQ_A=2 Then
  FY_Html_Name="Html"
  ElseIf FY_Html_Name_HQ_A=3 Then
  FY_Html_Name="SHtm"
  Else
  FY_Html_Name="SHtml"
  End if
End Function

sub KenQiao_BiaoQian()
response.write "<tr class='KenQiao_Net_ds'>"
response.write "<td colspan=""3"">"
response.write "<a href=""javascript:insertLabel('{$系统目录}')"" title=""显示系统目录"">{$系统目录}</A>  <a href=""javascript:insertLabel('{$网站名称}')"" title=""显示网站名称"">{$网站名称}</A>  <a href=""javascript:insertLabel('{$网站副标题}')"" title=""显示网站副标题"">{$网站副标题}</A>  <a href=""javascript:insertLabel('{$访问地址}')"" title=""显示访问地址"">{$访问地址}</A>  <a href=""javascript:insertLabel('{$网站域名}')"" title=""显示网站域名"">{$网站域名}</A>  <a href=""javascript:insertLabel('{$站长邮箱}')"" title=""显示站长邮箱"">{$站长邮箱}</A>  <a href=""javascript:insertLabel('{$站长QQ}')"" title=""显示站长QQ"">{$站长QQ}</A>  <a href=""javascript:insertLabel('{$keywords}')"" title=""显示keywords"">{$keywords}</A>  <a href=""javascript:insertLabel('{$description}')"" title=""显示description"">{$description}</A>  <a href=""javascript:insertLabel('{$官方连接}')"" title=""显示官方连接"">{$官方连接}</A>  <a href=""javascript:insertLabel('{$小说数量}')"" title=""显示小说数量"">{$小说数量}</A>  <a href=""javascript:insertLabel('{$栏目数量}')"" title=""显示栏目数量"">{$栏目数量}</A>  <a href=""javascript:insertLabel('{$站长名字}')"" title=""显示站长名字"">{$站长名字}</A>  <a href=""javascript:insertLabel('{$默认模板}')"" title=""显示默认模板名称"">{$默认模板}</A>  <a href=""javascript:insertLabel('{$网站版权}')"" title=""显示网站版权"">{$网站版权}</A>  <a href=""javascript:insertLabel('{$当前位置}')"" title=""显示当前位置"">{$当前位置}</A>  "
response.write "<td>"
response.write "</tr>"
end sub

Function FormatStr(String)
  String = Replace(String, "request", "")
  String = Replace(String, "execute", "")
  String = Replace(String, "eval", "")
  String = Replace(String, "include", "")
  String = Replace(String, "chr", "")
  'String = Replace(String, "<", "&lt;")
  'String = Replace(String, ">", "&gt;")
  'String = Replace(String, """", "&quot;")
  FormatStr = String
End Function