%
Dim Cts
Set Cts = New CtsPublicFunction
Class CtsPublicFunction
Public vReg
'类初始
Private Sub Class_Initialize()
End Sub
'结束类
Private Sub Class_Terminate()
IF IsObject(Conn) Then
IF conn.state<>0 then Conn.Close
Set Conn = Nothing
End IF
'Response.Write "
Class结束了
"
End Sub
Public Function Execute(sql)
'On Error Resume Next
Set Execute = conn.Execute(sql)
'If Err Then
' Err.Clear
' Set conn = Nothing
' Response.Write "查询数据的时候发现错误,请检查您的查询代码是否正确。"
' Response.End
'End If
End Function
Public Function CloseConn(typ)
IF isobject(rs) Then
rs.CLose
Set rs=Nothing
End IF
IF typ=1 Then
IF isobject(Conn) Then
Conn.CLose
Set Conn=Nothing
End IF
End IF
End Function
'Sql 分页查询
Function QueryPageByNotIn(ByVal selects, ByVal table, ByVal where, ByVal key, ByVal order, ByVal startRowIndex, ByVal maximumRows)
Dim sql
If where="" or isnull(where) Then
where = " Where 1=1 "
Else
where = " Where (" & where & ") " '这个括号很重要,因为可能where里面有or语句,而后面用and连接,就会影响逻辑
End If
If startRowIndex<=1 Then '取所有记录或者仅取第一页
If maximumRows<1 Then '所有记录
sql = "Select " & selects & " From " & table & where & " Order By " & order
Else '第一页,使用Top
sql = "Select Top " & maximumRows & " " & selects & " From " & table & where & " Order By " & order
End If
Else '取任意页
If maximumRows<1 Then '取某一行以后的所有记录
'sql = "Select " & selects & " From " & table & where & " And " & key & "Not In(Select Top " & startRowIndex-1 & " " & key & " From " & table & where & " Order By " & order & ")" & " Order By " & order
sql = "Select " & selects & " From " & table & where & " And " & key & "Not In(Select Top " & startRowIndex & " " & key & " From " & table & where & " Order By " & order & ")" & " Order By " & order
Else '取一定行数
'sql = "Select Top " & maximumRows & " " & selects & " From " & table & where & " And " & key & " Not In(Select Top " & startRowIndex-1 & " " & key & " From " & table & where & " Order By " & order & ") Order By " & order
sql = "Select Top " & maximumRows & " " & selects & " From " & table & where & " And " & key & " Not In(Select Top " & startRowIndex & " " & key & " From " & table & where & " Order By " & order & ") Order By " & order
End If
End If
QueryPageByNotIn = sql
End Function
'获取记录集
Function P_rs(sql, w) 'w表示是否允许修改记录集数据,0否1是
If w<>0 And w<>1 Then w = 0
On Error resume Next
Err.clear
Set P_rs = Server.CreateObject("ADODB.RecordSet")
P_rs.open sql, Conn, 1, w * 2 + 1
If Err.Number <> 0 Then
Response.write "错误的SQL字符串:" & sql & "
" & Err.Description
P_rs.Close
Set P_rs=Close
Response.End
Exit Function
End If
If P_rs.State = 0 Then Response.write("没有打开记录集"):Response.End
'调试输出是否EOF,是否BOF,以及记录数
'"EOF = " & P_rs.Eof & " BOF = " & P_rs.Bof & " RecordCount = " & P_rs.RecordCount
End Function
'示例
'Public Function getCompanyInfo(f)
' dim rs,body
' body = ""
' set rs = server.CreateObject("adodb.recordset")
' rs.LockType = 3'adLockOptimistic 只在调用 Update 方法时锁定记录。
' rs.CursorType = 3'AdOpenDynamic 动态游标。可以看见其他用户所作的添加、更改和删除
' on error resume next
' rs.open "select "&f&" from CompanyInfo",con
' call checkConError(con,rs)
' if rs.recordcount > 0 then
' rs.movefirst
' body = rs(f)
' end if
' rs.close
' set rs = nothing
' getCompanyInfo = body
'End function
'函数 检查connection对象是否出错,输出错误信息并终止页面执行
Public Sub checkConnError(cn,r)
dim E
set E = server.CreateObject("adodb.error")
if IsObject(cn) = true then
if cn.Errors.count > 0 then
for each E in con.Errors
response.Write(E.Description&"
")
next
set E = nothing
if isObject(r) = true then
set r = nothing
end if
response.End()
end if
end if
set E = nothing
End Sub
'//////////////////////读文件///////////////////////////////
Function ReadFile(Path)
On Error Resume Next
Set MyFile=Server.CreateObject("Scripting.FileSystemObject")
Set CountFile=MyFile.OpenTextFile(server.MapPath(Path))
If Err Then
err.Clear
Set MeyFile=Nothing
Response.Write "读取文件路径错误!!!"
Response.End
End If
ReadFile=CountFile.ReadAll
Set MeyFile=Nothing
End Function
Function DelFile(Path)
On Error Resume Next
ASPArr=Split(Path,".")
IF instr(1,ASPArr(ubound(ASPArr)),"asp",1)>0 Then
'Response.Write("动态文件,禁止删除!!!")
DelFile="动态文件,禁止删除!!!"
Exit Function
End IF
Set MyFile=Server.CreateObject("Scripting.FileSystemObject")
IF MyFile.FileExists(Server.MapPath(Path)) then
MyFile.DeleteFile(Server.MapPath(Path))
'Response.Write("删除成功")
DelFile="删除成功"
Else
'Response.Write("没有找到该文件")
DelFile="没有找到该文件"
End IF
Set MeyFile=Nothing
End Function
Function WriteFile(Path,Content)
'On Error Resume Next
Set MyFile=Server.CreateObject("Scripting.FileSystemObject")
'/////////////////////////创建目录///////////////////////////////////////////
PathArr=split(Path,"/")
Arrubound=ubound(PathArr)
IF Arrubound=0 Then
PathArr=split(Path,"\")
Arrubound=ubound(PathArr)
End IF
IF Arrubound>0 Then
IF PathArr(0)="" Then
Pathyuan=Server.MapPath("/")
Else
Pathyuan=Server.MapPath(PathArr(0))
IF MyFile.FolderExists(Pathyuan)=false then MyFile.CreateFolder(Pathyuan)
End IF
End IF
For i=1 to ubound(PathArr)-1
Pathyuan=Pathyuan&"\"&PathArr(i)
IF MyFile.FolderExists(Pathyuan)=false then MyFile.CreateFolder(Pathyuan)
Next
'/////////////////////////创建目录结束///////////////////////////////////////////
'/////////////////////////禁止写入格式///////////////////////////////////////////
ASPArr=Split(Path,".")
IF instr(1,ASPArr(ubound(ASPArr)),"asp",1)>0 Then
Response.Write(Path&"格式错误!!!")
Exit Function
End IF
'/////////////////////////禁止写入格式结束///////////////////////////////////////////
Set WriteFile=MyFile.CreateTextFile(Server.MapPath(Path))
If Err Then
err.Clear
Set MeyFile=Nothing
Response.Write "创建文件路径错误!!!"
Response.End
End If
WriteFile.Write(Content)
If Err Then
err.Clear
Set MeyFile=Nothing
Response.Write "写入文件错误!!!"
Response.End
End If
Set MeyFile=Nothing
End Function
'//////////////////////////////////////////////////////////////
'新闻调用
'1省2市3类4记录数5字符数6样式
Public Function News(Prov,City,NewClass,TopNum,ChrNum,Style,Showdate)
Dim Sql,Title
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF NewClass<>"" and NewClass<>0 Then
IF Sql="" Then
Sql="F_Class="&NewClass
Else
Sql=Sql&" and F_Class="&NewClass
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" id,Title,STitle,Path,FileName,BiaotiNews,UBiaotiNews,AddDate From News Where Del=0 and NewsCheck=0 and "&Sql&" order by DGNews desc,id desc"
Else
Sql="Select Top "&TopNum&" id,Title,STitle,Path,FileName,BiaotiNews,UBiaotiNews,AddDate From News Where Del=0 and NewsCheck=0 order by DGNews desc,id desc"
End IF
News="
"
Set Rs=conn.Execute(Sql)
IF Showdate=0 Then
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaoTiNews")=true Then
News=News&"- ·"&Left(Title,ChrNum)&"
"
Else
News=News&"- ·"&Left(Title,ChrNum)&"
"
End IF
Rs.movenext
Loop
Else
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaoTiNews")=true Then
News=News&"- ·"&Left(Title,ChrNum)&" ["&formatdatetime(rs("AddDate"),2)&"]
"
Else
News=News&"- ·"&Left(Title,ChrNum)&" ["&formatdatetime(rs("AddDate"),2)&"]
"
End IF
Rs.movenext
Loop
End IF
Rs.close
Set Rs=nothing
News=News&"
"
End Function
'//////////////////////////////////////////////////////////////
'文章调用
'1省2市3一级类4二级类5记录数6字符数7样式
Public Function Art(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,Style)
Dim Sql,Title
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Fu_Colum<>"" and Fu_Colum<>0 Then
IF Sql="" Then
Sql="Fu_Colum="&Fu_Colum
Else
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="Colum_ID="&Colum_ID
Else
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt From Art Where del=0 and ArtCheck=0 and "&Sql&" order by DGArt desc,id desc"
Else
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt From Art Where del=0 and ArtCheck=0 order by DGArt desc,id desc"
End IF
Set Rs=conn.Execute(Sql)
Art=""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaotiArt")=true Then
Art=Art&"- ·"&Left(Title,ChrNum)&"
"
Else
Art=Art&"- ·"&Left(Title,ChrNum)&"
"
End IF
Rs.movenext
Loop
Rs.close
Art=Art&"
"
End Function
Public Function Art2(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,Style) '为生成地区文章而修改,两个colum_ID
Dim Sql,Title
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Sql="" Then
Sql="and (Colum_ID=203 or Colum_ID=320)"
Else
Sql=Sql&" and (Colum_ID=203 or Colum_ID=320)"
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt From Art Where del=0 and ArtCheck=0 and "&Sql&" order by DGArt desc,id desc"
Else
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt From Art Where del=0 and ArtCheck=0 order by DGArt desc,id desc"
End IF
Set Rs=conn.Execute(Sql)
Art2=""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaotiArt")=true Then
Art2=Art2&"- ·"&Left(Title,ChrNum)&"
"
Else
Art2=Art2&"- ·"&Left(Title,ChrNum)&"
"
End IF
Rs.movenext
Loop
Rs.close
Art2=Art2&"
"
End Function
Public Function Art3(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,Style) '输出所属国[prov]
Dim Sql,Title
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Fu_Colum<>"" and Fu_Colum<>0 Then
IF Sql="" Then
Sql="Fu_Colum="&Fu_Colum
Else
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="Colum_ID="&Colum_ID
Else
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,City From Art Where del=0 and ArtCheck=0 and "&Sql&" order by DGArt desc,id desc"
Else
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,City From Art Where del=0 and ArtCheck=0 order by DGArt desc,id desc"
End IF
Set Rs=conn.Execute(Sql)
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaotiArt")=true Then
Art3=Art3&"·["& ProvCityCN(2,Rs("City"))&"] "&Left(Title,ChrNum)&"
"
Else
Art3=Art3&"·["& ProvCityCN(2,Rs("City"))&"] "&Left(Title,ChrNum)&"
"
End IF
Rs.movenext
Loop
Rs.close
End Function
Public Function ChuJingJD(Prov,City,Fu_Colum,Colum_ID,h,l,ChrNum,Style) '输出所属国景点
Dim Sql,Title
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Fu_Colum<>"" and Fu_Colum<>0 Then
IF Sql="" Then
Sql="Fu_Colum="&Fu_Colum
Else
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="Colum_ID="&Colum_ID
Else
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&h*l&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,City,BiaoTi_pic From Art Where del=0 and ArtCheck=0 and IntopPic=1 and "&Sql&" order by DGArt desc,id desc"
Else
Exit Function
End IF
Set Rs=conn.Execute(Sql)
ChuJingJD=""
For i=1 to h
ChuJingJD=ChuJingJD&""
For b=1 to l
IF Not(Rs.Eof or rs.Bof) Then
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaotiArt")=true Then
ArtLikn=Rs("BiaotiArt")
Else
ArtLikn="/Art/"&Rs("Path")&"/"&Rs("FileName")&".html"
End IF
ChuJingJD=ChuJingJD&" | "
Else
ChuJingJD=ChuJingJD&""&_
""&_
"| | "&_
" "&_
"| | "&_
" | "
End IF
Rs.movenext
Next
ChuJingJD=ChuJingJD&"
"
Next
Rs.close
ChuJingJD=ChuJingJD&"
"
End Function
Public Function GJProvCity(Prov)
IF FL(Prov,"Number")=0 Then Exit Function
Set rs=Conn.Execute("Select * From Prov_Class Where Prov="&Prov&"")
Do while Not (rs.Eof or rs.Bof)
Response.Write(rs("Prov_CN"))
'Set CRS=Conn.Execute("Select id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,City,BiaoTi_pic From Art Where del=0 and ArtCheck=0 order by DGArt desc,id asc")
' Do while Not(CRS.Eof or CRS.Bof)
' Response.Write(Crs("Title")&" ")
' CRS.Movenext
' Loop
' CRS.Close
' Set CRS=Nothing
Response.Write("
")
rs.Movenext
Loop
rs.Close
Set rs=Nothing
End Function
'//////////////////////////////////////////////////////////////
'线路调用
'1省2市3一级类4二级类5记录数6关键字7字符数8样式
Public Sub XL(CFProv,CFCity,MJDProv,MJDCity,XLType,NameKeyWord,TopNum,ChrNum,Account,Style)
Dim Sql
IF CFProv<>0 Then
Sql=" and ChuFD_provid1="&CFProv
End IF
IF CFCity<>0 Then
IF Sql="" Then
Sql=" and ChuFD_cityid1="&CFCity
Else
Sql=Sql&" and ChuFD_cityid1="&CFCity
End IF
End IF
IF MJDProv<>0 Then
IF Sql="" Then
Sql=" and MuJD_provid2="&MJDProv
Else
Sql=Sql&" and MuJD_provid2="&MJDProv
End IF
End IF
IF MJDCity<>0 Then
IF Sql="" Then
Sql=" and MuJD_cityid2 like "&MJDCity
Else
Sql=Sql&" and MuJD_cityid2 like "&MJDCity
End IF
End IF
IF XLType<>0 Then
IF Sql="" Then
Sql=" and XL_Type="&XLType
Else
Sql=Sql&" and XL_Type="&XLType
End IF
End IF
IF NameKeyWord<>"" Then
IF Sql="" Then
Sql=" and XL_Name like '%"&NameKeyWord&"%'"
Else
Sql=Sql&" and XL_Name like '%"&NameKeyWord&"%'"
End IF
End IF
IF Account<>"" Then
IF Sql="" Then
'Sql="Member_Account='"&Account&"'"
Sql=Account
Else
'Sql=Sql&" and Member_Account='"&Account&"'"
Sql=Sql&Account
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" ID,XL_Name,XL_Type,Member_Account,XLFileName,YouHui_Price,ShiChang_Price from XianLu Where del=0 and XL_Check=0 "&Sql&" order by AddDate desc"
Else
Sql="Select Top "&TopNum&" ID,XL_Name,XL_Type,Member_Account,XLFileName,YouHui_Price,ShiChang_Price from XianLu Where del=0 and XL_Check=0 order by AddDate desc"
End IF
Set Rs=conn.Execute(Sql)
Response.Write("")
End Sub
Public Sub Hotel(Prov,City,KeyWord,TopNum,ChrNum,Style,PC,St,PR)
Dim Sql
IF Prov<>0 Then
Sql=" and h.hotelsheng="&Prov
End IF
IF City<>0 Then
IF Sql="" Then
Sql=" and h.hotelcity="&City
Else
Sql=Sql&" and h.hotelcity="&City
End IF
End IF
IF KeyWord="" Then
IF Sql="" Then
Sql=" and h.jdname like '%"&KeyWord&"%'"
Else
Sql=Sql&" and h.jdname like '%"&KeyWord&"%'"
End IF
End IF
Set rs=Conn.Execute("Select Top "&TopNum&" j.*,member.Account,member.MemberType From (select h.id,h.jdname,h.hotelsheng,h.Account,h.jibie,h.show,r.price from hotel as h inner join (select hotelid,min(zhou1) as price from Hotelroom where show=0 group by hotelid) r on h.id=r.hotelid where h.show=0"&Sql&") as j inner join Member on member.Account=j.Account where member.Expires>getdate() order by j.id desc")
Response.Write("")
Do while not (rs.Eof or rs.Bof)
Response.Write("")
IF PC=1 Then Response.Write("| [] | ")
Response.Write(" "&Left(rs("JDName"),ChrNum)&" | ")
IF St=1 Then Response.Write(""&rs("jibie")&"星 | ")
IF Pr=1 Then Response.Write("¥"&rs("Price")&" | ")
Response.Write("
")
rs.Movenext
Loop
Response.Write("
")
rs.Close
Set rs=Nothing
End Sub
Public Sub JDList(Prov,City)
Dim ProvCityArr(),ProvCityArrCN(),p
IF Prov<>"" and City="" Then
Set Prs=Conn.Execute("Select * From Prov_Class Where Prov='"&Prov&"' order by id asc")
p=0
Do while not (Prs.Eof or Prs.Bof)
Redim Preserve ProvCityArr(p)
Redim Preserve ProvCityArrCN(p)
ProvCityArr(p)=Prs("Prov_EN")
ProvCityArrCN(p)=""&Prs("Prov_CN")&"
"
p=p+1
Prs.Movenext
Loop
Else
Set Prs=Conn.Execute("Select * From Prov_Class Where Prov_En='"&City&"' and Prov<>0 order by id asc")
IF Prs.Eof or Prs.Bof Then
Exit Sub
Else
Redim Preserve ProvCityArr(0)
Redim Preserve ProvCityArrCN(0)
ProvCityArr(0)=Prs("Prov_EN")
ProvCityArrCN(0)=""&Prs("Prov_CN")&"
"
End IF
End IF
Prs.Close
For i=0 to ubound(ProvCityArr)
Response.Write(ProvCityArrCN(i))
Set rs=Conn.Execute("Select * From Member Where City='"&ProvCityArr(i)&"' and MemberType='Sight' order by id asc")
Do while not (rs.Eof or rs.Bof)
Response.Write(" "&rs("UserName")&"
")
rs.movenext
Loop
rs.CLose
Set rs=Nothing
Response.Write("
")
Next
End Sub
Public Sub JiuDianList(Prov,City,TopNum,Style)
Dim Sql
IF Prov<>"" Then
Sql="shengfen="&Prov
End IF
IF City<>"" Then
IF Sql="" Then
Sql="diqu="&City
Else
Sql=Sql&" and diqu="&City
End IF
End IF
IF Sql<>"" Then
Sql="select Top "&TopNum&" * from hotelroom where show='1' and shenhe='0' "&Sql&" order by inputtime desc"
Else
Sql="select Top "&TopNum&" * from hotelroom where show='1' and shenhe='0' order by inputtime desc"
ENd IF
Set rs=Conn.Execute(Sql)
Response.Write("")
Do while not (rs.Eof or rs.Bof)
Response.Write("")
Response.Write("| ·[] "&left(rs("hotelname"),10)&" | ")
Response.Write(""&rs("roomclass")&" | ")
Response.Write("¥"&rs("youhuiprice")&" |
")
rs.movenext
Loop
rs.CLose
Response.Write("
")
End Sub
Function ArtMore(ColumID,PageName,PagePath,MoreSql,KeyWord) 'yuliu预留选项
Dim ArtList,ColumTitle,ArtListMoBan,YeiMa,CtsHeadTop
Dim i:i=1
ColumID=Fl(ColumID,"Number")
'PagePath&Replace(PageName,"[Page]",1)&Kuozm
'检查是不是有旧文件 whc 2008-3-23 21:34
Do while (DelFile(PagePath&Replace(PageName,"[Page]",i)&Kuozm)="删除成功")
i=i+1
Loop
'检查完成
CtsHeadTop=ReadFile("/NewStyle/CtsHtmlMoBan/xwList.asp")
ArtListMoBan=Load.SubReplace("$TopReplace",CtsHeadTop)
ArtListMoBan=Load.SubReplace("$KeyWordList",ArtListMoBan)
ArtListMoBan=Load.SubReplace("$RMNews",ArtListMoBan)
'IF ColumID=0 Then
' ColumTitle="没有找到结果!!!"
' ArtList="没有找到结果!!!"
' ArtList=Replace(ArtListMoBan,"$ArtList$",ArtList)
' ArtList=Replace(ArtList,"$ColumTitle$",ColumTitle)
' ArtList=Replace(ArtList,"$YeiMa$","")
' Call WriteFile(PagePath&Replace(PageName,"[Page]",1)&Kuozm,ArtList)
'Else
Set rs=Conn.Execute("Select * From Colum Where ID='"&ColumID&"' and Fu_Class<>1")
IF rs.Eof or rs.Bof Then
ColumTitle="没有找到结果!!!"
ArtList="没有找到结果!!!"
ArtList=Replace(ArtListMoBan,"$ArtList$",ArtList)
ArtList=Replace(ArtList,"$ColumTitle$",ColumTitle)
ArtList=Replace(ArtList,"$YeiMa$","")
Call WriteFile(PagePath&Replace(PageName,"[Page]",1)&Kuozm,ArtList)
Else
ColumTitle=rs("Colum")
IF rs("Fu_Class")=0 Then '验证调用大类还是小类
Sql=" and Fu_Colum='"&rs("ID")&"'"
Else
Sql=" and Colum_ID='"&rs("ID")&"'"
End IF
IF MoreSql<>"" Then
IF Sql="" Then
Sql=MoreSql
Else
Sql=Sql&MoreSql
End IF
End IF
End IF
IF Sql<>"" Then '取记录数,记录数为0写空页
Set rs=Conn.Execute("Select count(id) From Art Where BiaotiArt=0 and Del=0 and ArtCheck=0 "&Sql)
ArtNum=rs(0)
PageSize=30
IF (ArtNum mod PageSize)=0 Then
ArtPagecount=Cint(ArtNum\PageSize)
Else
ArtPagecount=Cint(ArtNum\PageSize)+1
End IF
IF ArtNum=0 Then '如果为0条记录,写空页,退出函数
ColumTitle="没有找到结果!!!"
ArtList="没有找到结果!!!"
ArtList=Replace(ArtListMoBan,"$ArtList$",ArtList)
ArtList=Replace(ArtList,"$ColumTitle$",ColumTitle)
ArtList=Replace(ArtList,"$YeiMa$","")
Call WriteFile(PagePath&Replace(PageName,"[Page]",1)&Kuozm,ArtList)
Exit Function
End IF
rs.Close
Set rs=Nothing
Set rs=Conn.Execute("Select Title,Path,FileName,AddDate,Content From Art Where BiaotiArt=0 and Del=0 and ArtCheck=0 "&Sql&" Order by id desc")
For P=1 to ArtPagecount
ArtList="" & vbcrlf
For i=1 To PageSize
IF rs.Eof or rs.Bof Then Exit For
ArtList=ArtList&"- " & vbcrlf
ArtList=ArtList&""&rs("Title")&"" & vbcrlf
ArtList=ArtList&"" & vbcrlf
ArtList=ArtList&""&rs("AddDate")&"" & vbcrlf
ArtList=ArtList&"
"&Left(NoHtml(rs("Content")),150)&"[阅读全文]
" & vbcrlf
ArtList=ArtList&" " & vbcrlf
rs.Movenext
Next
ArtList=ArtList&"
" & vbcrlf
ArtList=Replace(ArtListMoBan,"$ArtList$",ArtList)
ArtList=Replace(ArtList,"$ColumTitle$",ColumTitle)
IF P=1 Then
IF ArtPagecount>1 Then
YeiMa="共"&ArtNum&"条信息 首页 上一页 下一页 末页 第"&P&"页/共"&ArtPagecount&"页"
Else
YeiMa="共"&ArtNum&"条信息 首页 上一页 下一页 末页 第"&P&"页/共"&ArtPagecount&"页"
End IF
Else
IF P=ArtPagecount Then
YeiMa="共"&ArtNum&"条信息 首页 上一页 下一页 末页 第"&P&"页/共"&ArtPagecount&"页"
Else
YeiMa="共"&ArtNum&"条信息 首页 上一页 下一页 末页 第"&P&"页/共"&ArtPagecount&"页"
End IF
End IF
ArtList=Replace(ArtList,"$YeiMa$",YeiMa)
Call WriteFile(PagePath&Replace(PageName,"[Page]",P)&Kuozm,ArtList)
'Response.Write(ArtList&"
")
Next
Else
End IF
'End IF
'2007-11-27日修改,直接输出地址
'2008-5-27 加上"http://www.cts2008.com" 因为二级域名的原因,
IF KeyWord<>"" Then '根据返回的KEY输出地址
ArtMore=""&KeyWord&""
Else
ArtMore="http://www.cts2008.com"&PagePath&Replace(PageName,"[Page]",1)&Kuozm
End IF
End Function
'-----------------------------------分类调用查询------------------------------------------------
Function XL_TYPES2(ID)
Set C2rs=Conn.Execute("Select *,(select count(x.ID) From XianLu as x inner join Member as m on x.Member_Account=m.Account where m.Expires>getdate() and x.XL_TypeS=T.ID and del=0 and XL_Check=0) as coun From Member_TraveType as T where T.Fu_Class='"&ID&"' order by T.OrderID asc")
Do while not (C2rs.Eof or C2rs.Bof)
Response.Write(""&C2rs("Title")&"("&C2rs("coun")&")"&" ")
C2rs.Movenext
Loop
'临时添加图季滑雪专题
IF ID=4 Then Response.write("温泉滑雪专题 ")
C2rs.CLose
Set C2rs=Nothing
End Function
Function XL_TypeS1()
Set rs=Conn.Execute("Select z.* From Member_TraveType as z Where (z.Fu_Class is null) and (Select count(ID) From Member_TraveType Where Fu_Class=z.ID)>0 order by z.OrderID asc")
Do while not (rs.Eof or rs.Bof)
Response.Write(""&rs("Title")&"
")
XL_TYPES2(rs("ID"))
Response.Write("
")
rs.Movenext
Loop
Rs.CLose
Set rs=Nothing
End Function
'-----------------------------------分类调用查询结束------------------------------------------------
'-----------------------------------线路调用[下方]-----------------------------------------------
Function XLTypeList(ID,ChrNum,ViewType) 'ViewType0,1
ID=FL(ID,"Number")
ChrNum=FL(ChrNum,"Number")
ViewType=FL(ViewType,"Number")
XLTypeList=""
Set rs=Conn.Execute("Select * From Admin_XLAD Where ID='"&ID&"'")
IF Not(rs.Eof or rs.Bof) Then
IDArr=Split(rs("TypeIDArr"),"||")
NumArr=Split(rs("TypeNumArr"),"||")
For i=0 to ubound(IDArr)
XLTypeList=XLTypeList&XLTypeList2(Replace(NumArr(i),"|",""),Replace(IDArr(i),"|",""),ChrNum,ViewType)
Next
End IF
XLTypeList=XLTypeList&"
"
End Function
Function XLTypeList2(Top,XLType,ChrNum,ViewType)
Set rs=conn.Execute("Select Top "&Top&" x.*,m.UserName From XianLu as x inner join Member as m on x.Member_Account=m.Account Where Member_Account='bqxd' and del=0 and XL_Check=0 and XL_TypeS='"&XLType&"' order by x.AddDate desc")
Do While Not (rs.Eof or rs.Bof)
IF rs("YouHui_Price")="" Then
YouHui_Price="详细"
Else
YouHui_Price=rs("YouHui_Price")
End IF
IF rs("ShiChang_Price")="" Then
ShiChang_Price="详细"
Else
ShiChang_Price=rs("ShiChang_Price")
End IF
IF Len(rs("XL_Name"))>ChrNum Then
XL_Name=Left(rs("XL_Name"),ChrNum-2)&"..."
Else
XL_Name=rs("XL_Name")
End IF
IF ViewType=0 Then
XLTypeList2=XLTypeList2&""
XLTypeList2=XLTypeList2&""
XLTypeList2=XLTypeList2&"¥"&ShiChang_Price&""
XLTypeList2=XLTypeList2&"¥"&YouHui_Price&"
"
ElseIF ViewType=1 Then
XLTypeList2=XLTypeList2&""
XLTypeList2=XLTypeList2&""
XLTypeList2=XLTypeList2&""
XLTypeList2=XLTypeList2&""&YouHui_Price&"
"
XLTypeList2=XLTypeList2&"¥"&ShiChang_Price&""
End IF
rs.Movenext
Loop
rs.Close
Set rs=Nothing
End Function
'-----------------------------------线路调用[下方]-----------------------------------------------
'Function ProvCityArtMore(如果为0则跳过该务件,生成页名称须加[page],路径,特殊SQL,例表名称)
Function ProvCityArtMore(FColumID,ColumID,Prov,City,PageName,PagePath,MoreSql,ColumTitle) 'be(1为省2为市)与ArtMore相比,内容有所增加
Dim ArtList,ArtListMoBan,YeiMa,CtsHeadTop,ProvORCityName
Dim CSProvName,CSCityName
'ProvORCityName=ProvCityCN(3,FL(ProvORCity,"Number"))
'IF ProvORCityName="" Then
' Exit Function '如果没有找到返回城市则退出!!!
'End IF
CSProvName=ProvCityCN(3,FL(Prov,"Number"))
CSCityName=ProvCityCN(3,FL(City,"Number"))
IF CSCityName<>"" Then
ProvORCityName=CSCityName
Prov=City
Sql="and City='"&City&"'"
ArtListMoBan=ReadFile("\NewStyle\CtsHtmlMoBan\prov\citymore.html")
ArtListMoBan=Replace(ArtListMoBan,"$F_ProvID{}$",CP.F_PCID)
ArtListMoBan=Replace(ArtListMoBan,"$F_ProvCN{}$",CP.F_PCCN)
ElseIF CSProvName<>"" and CSCityName="" Then
ProvORCityName=CSProvName
Sql="and Prov='"&Prov&"'"
ArtListMoBan=ReadFile("\NewStyle\CtsHtmlMoBan\prov\provmore.html")
Else
Exit Function '如果没有找到返回城市则退出!!!
End IF
'CtsHeadTop=ReadFile("/Ctshead4.htm")
'ArtListMoBan=Replace(ArtListMoBan,"$CtsHeadTop$",CtsHeadTop)
IF FColumID<>0 Then
Sql=Sql&" and Fu_Colum='"&ColumID&"'"
End IF
IF ColumID<>0 Then
Sql=Sql&" and Colum_ID='"&ColumID&"'"
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
'IF Prov<>0 Then
' IF Sql="" Then
' Sql="and Prov='"&Prov&"'"
'Else
' Sql=Sql&"and Prov='"&Prov&"'"
'End IF
'ArtListMoBan=Replace(ArtListMoBan,"$News$",News(Prov,0,0,20,13,"blank",0))
'End IF
'IF City<>0 Then
' IF Sql="" Then
' Sql="and City='"&City&"'"
'Else
' Sql=Sql&"and City='"&City&"'"
'End IF
'ArtListMoBan=Replace(ArtListMoBan,"$News$",News(0,City,0,20,13,"blank",0))
'End IF
IF Sql<>"" Then
Set rs=Conn.Execute("Select count(id) From Art Where BiaotiArt=0 and Del=0 and ArtCheck=0 "&Sql)
ArtNum=rs(0)
IF (ArtNum mod 25)=0 Then
ArtPagecount=Cint(ArtNum\25)
Else
ArtPagecount=Cint(ArtNum\25)+1
End IF
IF ArtNum=0 Then '如果为0条记录,写空页,退出函数
ArtList=Replace(ArtListMoBan,"[$ArtList]","没有找到"&ColumTitle&"!!!
")
ArtList=Replace(ArtList,"[$ColumTitle]",ColumTitle)
ArtList=Replace(ArtList,"[$YeiMa]","")
ArtList=Replace(ArtList,"[$ProvID]",Prov)
'ArtList=Replace(ArtList,"$News$","")
ArtList=Replace(ArtList,"[$ProvCN]",ProvORCityName)
Call WriteFile(PagePath&Replace(Replace(PageName,"[$P]",""),"[$C]","")&Kuozm,ArtList)
Exit Function
End IF
rs.Close
Set rs=Nothing
Set rs=Conn.Execute("Select Title,Path,FileName,AddDate,Content From Art Where BiaotiArt=0 and Del=0 and ArtCheck=0 "&Sql&" Order by id desc")
For P=1 to ArtPagecount
ArtList="" & vbcrlf
For i=1 To 25
IF rs.Eof or rs.Bof Then Exit For
ArtList=ArtList&"- " & vbcrlf
ArtList=ArtList&""
ArtList=ArtList&"" & vbcrlf
ArtList=ArtList&"| "&rs("AddDate")&"" & vbcrlf
ArtList=ArtList&"
"&Left(NoHtml(rs("Content")),150)&"
[阅读全文] " & vbcrlf
ArtList=ArtList&" " & vbcrlf
rs.Movenext
Next
ArtList=ArtList&"
" & vbcrlf
ArtList=Replace(ArtListMoBan,"[$ArtList]",ArtList)
ArtList=Replace(ArtList,"[$ColumTitle]",ColumTitle)
ArtList=Replace(ArtList,"[$ProvCN]",ProvORCityName)
ArtList=Replace(ArtList,"[$ProvID]",Prov)
'Response.Write("ArtFPage("&ArtPagecount&","&ArtNum&","&P&",""_"","&PageName&Kuozm&")
")
'Response.Write(ArtFPage(ArtPagecount,ArtNum,P,"_",PageName&Kuozm))&"
"
ArtList=Replace(ArtList,"[$YeiMa]",ArtFPage(ArtPagecount,ArtNum,P,"_",PageName&Kuozm))
IF P=1 Then
Call WriteFile(PagePath&Replace(Replace(PageName,"[$P]",""),"[$C]","")&Kuozm,ArtList)
Else
Call WriteFile(PagePath&Replace(Replace(PageName,"[$P]",P),"[$C]","_")&Kuozm,ArtList)
End IF
'Response.Write(ArtList&"
")
Next
Else
End IF
'End IF
End Function
Public Sub JiPiaoList(Prov,City,TopNum,Style)
Dim Sql
IF Prov<>"" Then
Sql="shengfen="&Prov
End IF
IF City<>"" Then
IF Sql="" Then
Sql="diqu="&City
Else
Sql=Sql&" and diqu="&City
End IF
End IF
IF Sql<>"" Then
Sql="select Top "&TopNum&" * from jipiao where show='1' and shenhe='0' and dazhe='1' "&Sql&" order by indata desc"
Else
Sql="select Top "&TopNum&" * from jipiao where show='1' and shenhe='0' and dazhe='1' order by indata desc"
ENd IF
Set rs=Conn.Execute(Sql)
Response.Write("")
Do while not (rs.Eof or rs.Bof)
Response.Write("")
Response.Write("| ·"&left(rs("Title"),25)&" | ")
Response.Write(""&rs("price")&" | ")
Response.Write(""&rs("HbNo")&" | ")
Response.Write(""&FormatDateTime(rs("indata"),2)&" |
")
rs.movenext
Loop
rs.CLose
Response.Write("
")
End Sub
Public Function NoHtml(str) '去掉HTML的正则表达式
NoHtml=str&""
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern="(\<.*?\>)"
NoHtml=re.replace(NoHtml,"")
re.Pattern="(\<\/.*?\>)"
NoHtml=re.replace(NoHtml,"")
End Function
Public Function GLJS(Str)
GLJS=str
dim re
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
'MBContent= re.Replace(MBContent,"$LiuYan_PageList{"&UserID&",$1}$")
're.Pattern="(\<.*?\>)"
re.Pattern="(\<.*?\>.*\<\/.*?\>)?"
GLJS=re.replace(GLJS,"")
're.Pattern="([^(\<\/.*?\>)])"
'GLJS=re.replace(GLJS,"")
End Function
Public Function ProvCityCN(lei,ProvCityNum) '取地区中文名字
'IF cint(lei)=1 Then '省
' Set PCrs=Conn.Execute("Select Prov_CN From Prov_Class WHere Prov_EN='"&ProvCityNum&"' and Prov=0")
'ElseIF cint(lei)=2 Then '市
' Set PCrs=Conn.Execute("Select Prov_CN From Prov_Class WHere Prov_EN='"&ProvCityNum&"' and Prov<>0")
'ElseIF cint(lei)=3 Then'不限制
' Set PCrs=Conn.Execute("Select Prov_CN From Prov_Class WHere Prov_EN='"&ProvCityNum&"'")
'Else
' ProvCityCN=""
' Exit Function
'End IF
'IF PCrs.Eof or PCrs.Bof Then
' ProvCityCN=""
' PCrs.Close
' Exit Function
'Else
' ProvCityCN=PCrs("Prov_CN")
' PCrs.Close
'End IF
ProvCityCN=ProvCity_CN(ProvCityNum,0) '以前使用该函数的都为无连接的,故如此调用
End Function
Public Function ProvCity_CN(ID,ShowUrl)
Dim rs
ID=FL(ID,"Number")
ShowUrl=FL(ShowUrl,"Number")
IF ID=0 Then Exit Function
Set rs=Execute("Select * From Prov_Class Where Prov_EN='"&ID&"'")
IF Not(rs.Eof or rs.Bof) Then
IF ShowUrl=1 Then
ProvCity_CN=""&rs("Prov_CN")&""
Else
ProvCity_CN=rs("Prov_CN")
End IF
Else
ProvCity_CN=""
End IF
rs.CLose
Set rs=Nothing
End Function
'*******************************过滤类函数开始****************************
Public Sub InitReg()
If Not IsObject(vReg) Then
Set vReg = New RegExp
vReg.Global = True
vReg.IgnoreCase = True
End If
End Sub
'批量验证,使用方法:arr("City","Prov")为数组,变最须以变量名字符串加入
Function PLCheck(arr,chrType)
For i=0 to ubound(arr)
Execute(arr(i)&"=Cts.FL("&arr(i)&","""&chrType&""")")
Next
End Function
Public Function FL(Str,FilterType)
Select Case FilterType
Case "Sql" '0 '常用过滤,防SQL注入
FL = FL2(Str,"['#%;]")
' Case fNumber '1 '数字
Case "Number" '1 '数字 ,为了兼容,保留Number
FL = FL1(Str, "^-?\d+$")
'If IsNull(FL) Or IsEmpty(FL) Or FL = "" Then FL = 0
If IsNull(FL) Or IsEmpty(FL) Or FL = "" OR Len(FL)>8 Then '增加位数判断
FL = 0
Else
FL = CLng(FL)
End IF
Case "String" '2 '字母
' FL = FL1(Str, "[a-zA-Z]+")
FL = FL2(Str, "[^a-zA-Z]")
Case "LCase" '3 '小写字母
FL = FL2(Str, "[^a-z]")
' FL = FL1(Str, "[a-z]+")
Case "UCase" '4 '大写字母
FL = FL2(Str, "[^A-Z]")
' FL = FL1(Str, "[A-Z]+")
Case "NumberAndString" '5 '数字/大小写字母/下划线,这是标准变量
FL = FL1(Str, "\w+")
Case "All" '6 '数字/大小写字母/可显示符号
FL = Str
Case "Real" '8 '浮点数
FL = FL1(Str, "^-?\d+(\.\d*)?(e-?\d*)?$")
Case "SqlT" '0 '常用过滤,替换为全角
'FL = FL3(Str,"'|#|%|;","’|#|%|;")
FL = FL3(Str,"'|#|%","’|#|%")
Case "SqlR" '0 '常用过滤,防SQL注入
'FL = FL3(Str,"'|#|%|;","$Cts’$|$Cts#$|$Cts%$|$Cts;$")
FL = FL3(Str,"'|#|%","$Cts’$|$Cts#$|$Cts%$")
Case "SqlC" '0 '常用过滤,防SQL注入
'FL = FL3(Str,"$Cts’$|$Cts#$|$Cts%$|$Cts;$","'|#|%|;")
FL = FL3(Str,"$Cts’$|$Cts#$|$Cts%$|$Cts;$","'|#|%|;")
Case Else
FL = FL1(Str, FilterType)
End Select
End Function
'只返回允许的字符
Public Function FL1(Str,AllowStr)
Dim i,j,t,mStr, Rex
FL1 = ""
If Not IsObject(vReg) Then
Call InitReg()
End If
FL1 = ""
vReg.Pattern = AllowStr
If vReg.Test(Str&"") Then FL1 = Str
End Function
'删除不允许的字符
Public Function FL2(Str,NotAllowStr)
Dim i,mStr
FL2 = ""
If Not IsObject(vReg) Then
Call InitReg()
End If
vReg.Pattern = NotAllowStr
FL2 = vReg.Replace(Str&"", "")
End Function
'替换不允许的字符为指定字符
Public Function FL3(Str,NotAllowStr,RCstr)
IF Str="" or NotAllowStr="" or RCstr="" Then
Exit Function
End IF
YStr=Split(NotAllowStr,"|")
GStr=Split(RCstr,"|")
For i=0 to ubound(YStr)
Str=Replace(Str&"",YStr(i)&"",GStr(i)&"")
Next
FL3=Str
End Function
Function HTMLEncode(fString)
fString=FL3(fString,"'|#|%","’|#|%")
fString=Trim(Server.HtmlEncode(fString))
fString=Replace(fString,";",";")
fString=Replace(fString,"&","&")'
fString=Replace(fString,"\","\")
fString=Replace(fString,"--","--")
fString=Replace(fString,CHR(9)," ")
fString=Replace(fString,CHR(10),"
")
fString=Replace(fString,CHR(13),"")
fString=Replace(fString,CHR(22),"")
fString=Replace(fString,CHR(32)," ")
fString=Replace(fString,CHR(39),"'")'单引号
HTMLEncode=fString
End Function
'反编Server.URLEncode()
Public Function urldecode(encodestr)
Dim newstr,havechar,lastchar,i
newstr=""
havechar=false
lastchar=""
For i=1 to len(encodestr)
char_c=mid(encodestr,i,1)
IF char_c="+" Then
newstr=newstr & " "
ElseIF char_c="%" Then
next_1_c=mid(encodestr,i+1,2)
next_1_num=cint("&H" & next_1_c)
IF havechar Then
havechar=false
newstr=newstr & chr(cint("&H" & lastchar & next_1_c))
Else
IF abs(next_1_num)<=127 Then
newstr=newstr & chr(next_1_num)
Else
havechar=true
lastchar=next_1_c
End IF
End IF
i=i+2
Else
newstr=newstr & char_c
End IF
Next
urldecode=newstr
End Function
'取字符串
Function CutStr(Str,LenNum)
Dim P_num
Dim I,X
If StrLen(Str)<=LenNum Then
Cutstr=Str
Else
P_num=0
X=0
Do While Not P_num > LenNum-2
X=X+1
If Asc(Mid(Str,X,1))<0 Then
P_num=Int(P_num) + 2
Else
P_num=Int(P_num) + 1
End If
Cutstr=Left(Trim(Str),X)
Loop
End If
End Function
'计算字符串长度
Function strLen(Str)
If Trim(Str)="" Or IsNull(str) Then Exit Function
Dim P_len,x
P_len=0
StrLen=0
P_len=Len(Trim(Str))
For x=1 To P_len
If Asc(Mid(Str,x,1))<0 Then
StrLen=Int(StrLen) + 2
Else
StrLen=Int(StrLen) + 1
End If
Next
End Function
'关键词过滤
Public Function KeyWordFilter(Content_Str)
Dim rs,Key_Arr,i,s,TH
Set rs=Execute("Select Keyword From KeyWordFilter")
IF rs.Eof or rs.Bof THen
KeyWordFilter=Content_Str
ElseIF rs("Keyword")="" or isnull(rs("Keyword")) Then
KeyWordFilter=Content_Str
Else
Key_Arr=Split(rs("Keyword"),vbcrlf)
For i=0 to ubound(Key_Arr)
IF instr(1,Content_Str,Key_Arr(i),1) > 0 Then
TH=""
For s=1 to len(Key_Arr(i))
TH=TH&"*"
Next
Content_Str=Replace(Content_Str,Key_Arr(i),TH)
End IF
Next
End IF
rs.Close
Set rs=Nothing
KeyWordFilter=Content_Str
End Function
Public Function IPFilter()
Dim IPArr
Set rs=Execute("Select IP From KeyWordFilter")
IF Not(rs.Eof or rs.Bof) THen
IPArr=rs("IP")
rs.CLose
Set rs=Nothing
IF instr(1,IPArr,IP(),1) > 0 Then
Response.write("您被禁止访问该页面!")
Response.End()
End IF
End IF
End Function
'*******************************过滤类函数结束****************************
Public Function ArtFPage(Zong,ArtCount,P,C,FName) 'index.asp[$C][$P] index[$][$P].html
Dim StarPage,EndPage,P_PageNum
P_PageNum=P
IF Zong=0 Then Exit Function
IF Zong=1 Then Exit Function
IF P_PageNum=1 THen
ArtFPage="首页"
ArtFPage=ArtFPage&"上页"
ElseIF P_PageNum=2 Then
ArtFPage="首页"
ArtFPage=ArtFPage&"上页"
Else
ArtFPage="首页"
ArtFPage=ArtFPage&"上页"
End IF
StarPage=P_PageNum-3
EndPage=P_PageNum+3
IF StarPage<1 Then StarPage=1
IF EndPage>Zong Then EndPage=Zong
IF StarPage=1 and Zong>=7 Then EndPage=7
IF EndPage=Zong and Zong>7 Then StarPage=(Zong-6)
For Pi=StarPage to EndPage
IF Pi=P_PageNum Then
ArtFPage=ArtFPage&""&Pi&""
'ElseIF P=2 Then
'ArtFPage=ArtFPage&""&Pi&""
ElseIF P_PageNum<>1 and Pi=1 Then
ArtFPage=ArtFPage&""&Pi&""
Else
ArtFPage=ArtFPage&""&Pi&""
End IF
Next
IF P_PageNum=Zong Then
ArtFPage=ArtFPage&"下页"
ArtFPage=ArtFPage&"尾页"
Else
ArtFPage=ArtFPage&"下页"
ArtFPage=ArtFPage&"尾页"
End IF
ArtFPage=ArtFPage&""&P_PageNum&"/"&Zong&"页共"&ArtCount&"条"
End Function
'///////////////////////////////友情连接///////////////////////////////////
Public Function LinkOut(LinkType,LinkPage,hang,lie) '类型,栏目页,行,列
Dim TopNum,width,SType,SPage,MoreSql:MoreSql=""
TopNum=cint(hang*lie)
width=cint(730/lie)
SType=Cts.FL(LinkType,"Number")
SPage=Cts.FL(LinkPage,"Number")
IF SType > 0 Then
MoreSql=" and LinkType="&SType
End IF
IF SPage > 0 Then
MoreSql=MoreSql&" and LanPage="&SPage
End IF
Set rs=Conn.Execute("Select top "&TopNum&" ID,SiteLink,SiteName,SiteLOGO,Content From SiteLink where SiteLOGO='' "&MoreSql&" Order by SiteTop desc,id desc")
LinkOut=""
rs.CLose
Set rs=Nothing
Set rs=Conn.Execute("Select top 20 ID,SiteLink,SiteName,SiteLOGO,Content From SiteLink where SiteLOGO<>'' "&MoreSql&" order by SiteTop desc,id desc")
LinkOut=LinkOut&""& vbcrlf
while not(rs.Eof or rs.Bof)
'LinkOut=LinkOut&"![]() | "& vbcrlf
LinkOut=LinkOut&"![]()
"& vbcrlf
rs.Movenext
wend
rs.CLose
Set rs=Nothing
LinkOut=LinkOut&"
"& vbcrlf
End Function
'///////////////////////////////////////////////////////////////////////////
Function jserr(Content)
Response.Write("")
Response.End()
End Function
Function Errer(Content)
Response.Write ReadFile("../CtsHead4.htm")
Response.Write ""
Response.Write ""
Response.Write "| "&Content&" | "
Response.Write "
"
Response.Write ""
Response.Write "| 返回上一页 | "
Response.Write "
"
Response.Write "
"
Response.Write ""
Response.End
End Function
Public Function alert(Content,Redirec)
IF Redirec<>"" Then
Response.Write("")
Response.End()
Else
Response.Write("")
End IF
End Function
Public Function alert2(Content)
Response.Write("")
Response.End()
End Function
'**************************************获取IP********************************************
Public Function IP()
IF Request.ServerVariables("HTTP_X_FORWARDED_FOR")="" Then
IP = Request.ServerVariables("REMOTE_ADDR")
Else
IP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End IF
End Function
'**************************************增加********************************************
'修改时间2007-6-21 原为用户名记录,现为ID,
'添加积分为0分时不进行操做
Public Function UserJF(Num,UserID,ShiJian,Ty)
Dim rs
IF FL(UserID,"Number")=0 Then '有的位置不能直接提供用户ID而是用户名,在此找用户ID
Set rs=Conn.Execute("Select ID From Cts_User Where UserName='"&FL(UserID,"Sql")&"'")
IF rs.Eof or rs.Bof Then
rs.CLose:Set rs=Nothing
Exit Function
Else
UserID=rs("ID")
rs.CLose:Set rs=Nothing
End IF
End IF
IF FL(Num,"Number")<>0 Then
IF FL(Ty,"Number")=1 Then
Conn.Execute("Update Cts_User Set XFJiFen=XFJiFen+"&FL(Num,"Number")&" Where ID='"&FL(UserID,"Number")&"'")
Conn.Execute("insert into User_JiFen(UserID,JiFenNum,Reason,AddDate,XGDD,JFType) Values('"&FL(UserID,"Number")&"','"&FL(Num,"Number")&"','"&FL(ShiJian,"Sql")&"',getdate(),'',1)")
ElseIF FL(Ty,"Number")=0 Then
Conn.Execute("Update Cts_User Set JiFen=JiFen+"&FL(Num,"Number")&" Where ID='"&FL(UserID,"Number")&"'")
Conn.Execute("insert into User_JiFen(UserID,JiFenNum,Reason,AddDate,XGDD,JFType) Values('"&FL(UserID,"Number")&"','"&FL(Num,"Number")&"','"&FL(ShiJian,"Sql")&"',getdate(),'',0)")
End IF
End IF
End Function
Public Function TJRegUser(CtsUserID,TJRegUserID,JF)
CtsUserID=FL(CtsUserID,"Number")
TJRegUserID=FL(TJRegUserID,"Number")
JF=FL(JF,"Number")
IF JF <=0 Then TJRegUser="积分小于或等于0跳出操作!":Exit Function
IF Request.Cookies("RuserCheck") <> "" Then TJRegUser="重复注册!":Exit Function
IF Execute("Select Top 1 ID From Cts_User where id='"&CtsUserID&"'").Eof Then TJRegUser="没有找到推荐人!":Exit Function
IF Not Execute("Select Top 1 ID From Cts_User_TJ Where ip='"&IP&"' and datediff(d,Regdate,getdate())<1").Eof Then TJRegUser="该IP今天以注册!":Exit Function
IF Not Execute("Select Top 1 ID From Cts_User Where ip='"&IP&"' and id='"&CtsUserID&"'").Eof Then TJRegUser="系统怀疑您自已推荐自已!":Exit Function
Execute("insert into Cts_User_TJ(CtsUserID,RegUserID,Regdate,IP) values('"&CtsUserID&"','"&TJRegUserID&"',getdate(),'"&IP&"')")
Call UserJF(JF,CtsUserID,"推存会员["&TJRegUserID&"]",0)
'Response.Cookies.domain=""
Response.Cookies("RuserCheck")="Yes"
Response.Cookies("RuserCheck").Expires = Date + 1
TJRegUser="操作成功"
End Function
'****************************************缩略图********************************************
Sub SuoLT(Saveslimage,imgurl,width,height)
Dim Jpeg,BiLi
On Error Resume Next
Set Jpeg = Server.CreateObject("Persits.Jpeg")
IF imgurl<>"" then
Jpeg.Open Server.MapPath(imgurl)'图片路径并打开它
If Err Then
err.Clear
Response.Write "读取图片路径不正确!"
Exit Sub
End If
Else
response.write ""
Exit Sub
End IF
'测试代码
'缩放图片,并裁剪
IF (Jpeg.Width < width) and (Jpeg.Height < height) Then
'Exit Sub
Else
IF (Jpeg.Width / Jpeg.Height) > (width/height) Then
Jpeg.Width=(height/Jpeg.Height)*Jpeg.Width
Jpeg.Height=height
IF Jpeg.Width > width Then
Jpeg.Crop (Jpeg.Width/2) - (width/2) , 0, (Jpeg.Width/2) + (width/2), height
End IF
Else
Jpeg.Height=(width/Jpeg.Width)*Jpeg.Height
Jpeg.Width=width
IF Jpeg.Height > height Then
Jpeg.Crop 0 , (Jpeg.Height/2) - (height/2) , width, (Jpeg.Height/2) + (height/2)
End IF
End IF
End IF
'
'IF Jpeg.Width > Jpeg.Height Then
' BiLi=width/Jpeg.Width
'Else
' BiLi=height/Jpeg.Height
'End IF
'Jpeg.Width = Jpeg.OriginalWidth * BiLi
'Jpeg.Height = Jpeg.OriginalHeight * BiLi
Jpeg.Save Server.MapPath(Saveslimage)
If Err Then
err.Clear
Response.Write "保存图片路径不正确!"
Exit Sub
End If
Set Jpeg = Nothing
'If Err Then
'err.Clear
' Response.Write "缩略图生成错误"
'Response.End
'End If
End SUb
'水印
Sub JpegTu(imgurl,isbold,Horflip) '图片水印
Dim Jpeg,font_color,font_size,font_family,f_width,f_height,f_content,f_Horflip
Set Jpeg = Server.CreateObject("Persits.Jpeg")
IF imgurl<>"" then
Jpeg.Open Server.MapPath(imgurl)'图片路径并打开它
Else
response.write ""
Exit Sub
End IF
IF jpeg.Width<177*2 or jpeg.Height<38*2 then '如果上传图片小于水印LOGO的四倍则不添加水印
Response.write ""
Exit Sub
End IF
'图片
Set Logobox = Server.CreateObject("Persits.Jpeg")
Logobox.Open Server.MapPath("/images/sylogo.gIF") '//读取添加的图片。
jpeg.Canvas.Pen.Color = &H000000 '//增加水印后图片的边框色彩。
jpeg.Canvas.Pen.Width = 1 '//增加水印后图片的边框宽度。
jpeg.Canvas.Brush.Solid = False '//边框内是否填充颜色,你可以试试看值为True时的效果^o^
jpeg.DrawImage jpeg.width-177, jpeg.height-38, Logobox, 0.5 '//水印图片的起始坐标,我这里ogvbox.width-186, ogvbox.height-52,表示图片在右下角,因为我的图片宽是186,高是52,所以这样写,你可以根据自己的图片进行调整。0.5是透明度,我这里是半透明,1表示不透明,你也可以试试看0.7或者0.8的效果。
jpeg.Canvas.Bar 0, 0, jpeg.Width, jpeg.Height '//水印可用的范围。我这里表示左上角至右下角,即整张图片的任意为止都可加水印。
IF isbold=1 then
Jpeg.Canvas.Font.Bold = True
End IF
IF Horflip = 1 Then
Jpeg.FlipH
'Jpeg.SEndBinary
End IF
Jpeg.Save Server.MapPath(imgurl)
Set Jpeg = Nothing
Set Logobox = Nothing
End Sub
Public Function DTPath() '生成日期及文件名称
DTPath=year(now)&"-"&month(now)&"-"&day(now)
End Function
End Class
Function ShowPage(ByRef PageCount,RecordCount,CurrentPage,PageSize,LinkFile,ColumID)
Dim Retval,J,StartPage,EndPage
If (RecordCount Mod PageSize)=0 Then
PageCount=RecordCount \ PageSize
Else
PageCount=RecordCount \ PageSize+1
End If
If PageCount=0 Then PageCount=1
If CurrentPage="" Then CurrentPage=1 else CurrentPage=CInt(CurrentPage)
Retval=Retval & ""
Retval=Retval & ""
Retval=Retval & "| "
If CurrentPage=1 Then
Retval=Retval & "共搜索到"&RecordCount&"条记录 首页 | 前页 | "
Else
Retval=Retval & "共搜索到"&RecordCount&"条记录 首页 | 前页 | "
End If
If CurrentPage=PageCount Then
Retval=Retval & "后页 | 末页"
Else
Retval=Retval & "后页 | 末页"
End if
If RecordCount>0 Then
Retval=Retval & " | "&CurrentPage&"页/"&CInt(PageCount)&"页"
End If
Retval=Retval & " | "
StartPage = Page-3
EndPage = Page+3
If EndPage>PageCount Then EndPage=PageCount
If EndPage < PageCount Then Retval= Retval & " ... :"
Retval=Retval & " | "
Retval=Retval & "
"
Retval=Retval & "
"
ShowPage=Retval
End Function
%>
<%
Const JDCreatePath="/Member/Sight/" '景点生成路径
Const Kuozm=".html" '生成文件扩展名
Const JDCLink="" 'http://www.cts2008.com/mudidi/mu/一定要与JDCreatePath常量相关联
%>
<%
'blog常用
'全局常量或变量、参数定义程序段
'重要以下两个选项,每次修改文件都需认真查看
Const Modules_Folder="/Modules/" '静态页面归档目录 A_id,M_Id,S_id
Const blogdir = "/"
'blog程序所在目录,非常重要,默认为根目录,如为blog目录请改为/blog/
Const tdir="team"
Const f_ext = "html" '(23)
'生成的日志静态文件后缀,可以为htm,html,shtml,asp四种格式
Const cookies_name = "oblog4" 'cookies名,一般无须修改(7)
Const cookies_domain = "" 'cookeies域名根,一般留空(8)
Const cache_name_user = "oblog4" '系统缓存名前缀,一般无须修改
Const cache_name = "oblog4" '系统缓存名前缀,一般无须修改
Const SYSFOLDER_ADMIN = "admin" '该目录名称将被作为系统禁止注册的用户名使用
Const SYSFOLDER_MANAGER = "manager" '该目录名称将被作为系统禁止注册的用户名使用
Const upload_dir = "UploadFiles" '默认上传目录,为空则使用用户所在目录,若需要修改为其他目录,请手工建目录
Const is_unamedir = 1 '是否使用username作用户目录,1为使用,0为关闭
Const en_nameisnum = 0 '是否允许全数字的用户名,1为允许,0为不允许
Const logfilepath = 1 '日志文件路径,0为根目录,1为"/archives/年份/"目录
Const str_htmlfilt = "" '自定义过滤的html代码,必须以|结束,格式如aaa|bbb|,则过滤aaa和bbb标签(对评论和留言有效)
Const is_debug = 1 '是否开启调试模式,1为开启,0为关闭
Const is_relativepath = 1 '站内连接路径参数,1为相对路径,0为绝对路径
Const P_TAGS_SPLIT = " " 'TAG Split
Const P_TAGS_MAX = 10 'TAGS IN ONE BLOG
Const P_TAGS_DESC = "日志标签" 'TAG DESC
Const P_TAGS_ICON = "TAG" 'TAG DESC
Const P_TAGS_CLOUD = 1 '1:CLOUD;2:LIST DESC
Const P_TAGS_PerLine = 8
Const P_TAGS_SYSURL = "tags.asp"
Const P_TRACKBACK_MAX = 5
Const P_QQ_NAME = "群组"
Const P_QQ_MASTERNAME = "组长"
Const p_Group_MaxUser=500
Const P_QQ_MINBLOGS = 0 '发表多少篇日志才能创建圈圈,0为不限制
Const P_Site_Hours = 0 '服务器与时差设置
Const P_BLOG_UPDATEPAUSE = 2 '每生成5篇日志的暂停时间(1~100)
Const C_BLOGSTAR_MINBLOGS = 10 '最少发布多少篇日志才允许申请博客之星,0为不限制
Const C_SKIN_USERGOOD = 0 '是否启用用户推荐自己的模板功能,0为否,1为启用
Const C_Sequence_Max = 0 '系统允许同时进行整站更新的数目,0为不限制
Const C_Reg_AutoCreate = 1 '是否启用注册后自动创建用户目录
Const C_Reg_AutoTemplate = 1 '是否启用注册后自动选择默认模板(如果启用,C_Reg_AutoCreate的值必须为1)
Const C_Reg_AutoPost = 1 '是否启用注册后自动发布一篇默认日志
Const C_Reg_AutoPostStr = "" '用户注册后自动发布日志的内容
Const C_User_ViewUploadfiles = 1 '是否启用后台上传图片文件的预览功能
'垃圾注册、回复、留言控制v1.0
Const C_Spam_RegCodeTime = 180 '注册授权码更新间隔时间,单位为分钟,30分钟最小,一天最大(1440分钟),间隔太小,可能会造成正常用户注册失败
Const C_Spam_RegCheckTime = 300 '帐号注册间隔时间单位秒
Const C_Spam_RegInOneHour = 2 '连续1小时内同一IP的注册数目,0为不限制
Const C_Spam_RegInOneIP = 10 '同一IP允许注册的最大数目,如果超过该数目,该IP的注册用户将被全部禁止;0为不限制
Const C_Spam_ChkMinutes=5 '检查时间间隔(请根据站点的流量和反应度设置)
Const C_Spam_OneIp = 10 '如果设置间隔内回复/评论连续超过一定数目,则该IP将被列入黑名单
Const C_Spam_AllIp = 15 '如果设置间隔内回复/评论连续超过一定数目,则该IP将被列入黑名单
'真实域名相关参数
Const true_domain = 0 '是否启用真实二级域名,需OblogDns组件支持(6)
Dim blogurl, str_domain
If true_domain = 1 Then
'真实域名必填,设置blog程序绝对路径
blogurl = "http://blog.cts2008.com/"
str_domain = ",custom_domain"
Else
blogurl = blogdir
End If
'分页公用变量
Dim G_P_PerMax,G_P_AllRecords,G_P_AllPages,G_P_This,G_P_FileName,G_P_Guide
dim C_Editor
C_Editor=blogdir&"editor"
Const C_Vote_Action1="鲜花"
Const C_Vote_Action2="板砖"
Const C_UserIcon_Width="48"
Const C_UserIcon_Height="48"
Const En_OutRss=1 '是否允许订阅站外rss源
Const En_Recycle=1 '是否启用回收站功能(只对日志及用户数据启用,回复、评论、文件等不启用)
%>
<%
'Option Explicit
Response.Buffer = True
Dim Conn
dim CTSName,CTSPass,CTSDatabaseName,CTSLocal,Str
CTSname="web294651"
CTSPass="a1s2d3f4g5h6"
CTSDatabaseName="www_cts2008_com"
CTSLocal="(local)"
On Error Resume Next
Set Conn = Server.CreateObject("ADODB.Connection")
Str = "Provider = Sqloledb; User ID = " & CTSname & "; Password = " & CTSPass & "; Initial Catalog = " & CTSDatabaseName & "; Data Source = " & CTSLocal & ";"
Conn.open Str
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "数据库连接出错,请检查连接字串。"
Response.End
End If
'set rs=server.CreateObject("adodb.recordset")
%>
<%
Dim load
Set load = New Loadresponse
Class Loadresponse
Private Sub Class_Initialize() '生成头部文件
Dim objFSO,objFile
Dim CreatePath:CreatePath="/NewStyle/Cts_Top_T.html"
'Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'If objFSO.FileExists(Server.MapPath(CreatePath)) Then
'Set objFile = objFSO.GetFile(Server.MapPath(CreatePath))
'IF datediff("n",objFile.DateLastModified,Now()) >= 120 Then '120分钟
' IF datediff("n",objFile.DateLastModified,Now()) >= 1440 Then '一天重写一次
' Call Cts.WriteFile(CreatePath,SubReplace("$KeyWordList",TopReplace("/NewStyle/CtsHtmlMoBan/Top.asp","","","home")))
' End IF
'Else
' Call Cts.WriteFile(CreatePath,SubReplace("$KeyWordList",TopReplace("/NewStyle/CtsHtmlMoBan/Top.asp","","","home")))
'End If
'Set objFile = Nothing
' Set objFSO = Nothing
IF application("CreateTop_T_Date")="" or isdate(application("CreateTop_T_Date"))=false Then
Call Cts.WriteFile(CreatePath,SubReplace("$KeyWordList",TopReplace("/NewStyle/CtsHtmlMoBan/Top.asp","","","home")))
application("CreateTop_T_Date")=now()
Else
IF datediff("n",application("CreateTop_T_Date"),Now()) >= 1440 Then '一天重写一次
Call Cts.WriteFile(CreatePath,SubReplace("$KeyWordList",TopReplace("/NewStyle/CtsHtmlMoBan/Top.asp","","","home")))
End IF
End IF
End Sub
Public Function HeadTop(RehTop)
HeadTop=Cts.ReadFile(RehTop)
End Function
'FLASH广告输出
Public Function FalshAd(ColumID,AdNum,ADWidth,ADHeight,ADTextHeight,DY_Type) '分类,数量,宽,高,文字高,分类
Dim AdPic,AdPath,AdText,ArtPath_S,Sql
ColumID=Cts.FL(ColumID,"Number")
AdNum=Cts.FL(AdNum,"Number")
ADWidth=Cts.FL(ADWidth,"Number")
ADHeight=Cts.FL(ADHeight,"Number")
ADTextHeight=Cts.FL(ADTextHeight,"Number")
FalshAd="" & vbcrlf
End Function
'新闻调用省,市,类,更多SQL,标题长度,简介长度,显示时间,显示分类名,显示图片
Public Function OneNews(Prov,City,NewClass,MoreSql,ChrNum,ContentChrNum,Showdate,Type_name,ShowPic)
Dim Sql,Title,NewUrl
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
NewClass=Cts.FL(NewClass,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
ContentChrNum=Cts.FL(ContentChrNum,"Number")
IF Prov>0 Then
Sql=" and Prov="&Prov
End IF
IF City>0 Then
Sql=Sql&" and City="&City
End IF
IF NewClass>0 Then
Sql=Sql&" and F_Class="&NewClass
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
IF ShowPic="Yes" Then
Sql=Sql&" and IntopPic=1"
End IF
IF Type_name="Yes" Then '相不到此处关系如何写,判断一次Type_namel输出ColunName 所以写了两个IF,麻烦
Set Rs=conn.Execute("Select Top 1 id,Title,STitle,Path,FileName,BiaotiNews,UBiaotiNews,AddDate,Content,BiaoTi_Pic,(Select Colum From Colum Where Fu_Class=1 and Colum.id=News.F_Class) as ColumName From News Where Del=0 and NewsCheck=0 "&Sql&" order by DGNews desc,id desc")
IF rs.Eof or rs.Bof Then
rs.Close
Set rs=Nothing
Exit Function
Else
ColumName=rs("ColumName")&":"
End IF
Else
Set Rs=conn.Execute("Select Top 1 id,Title,STitle,Path,FileName,BiaotiNews,UBiaotiNews,AddDate,Content,BiaoTi_Pic From News Where Del=0 and NewsCheck=0 "&Sql&" order by DGNews desc,id desc")
IF rs.Eof or rs.Bof Then
rs.Close
Set rs=Nothing
Exit Function
End IF
End IF
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaoTiNews")=true Then
NewUrl=Rs("UBiaotiNews")
Else
NewUrl="/News/"&Rs("Path")&"/"&Rs("FileName")&".html"
End IF
OneNews=""&ColumName&""&Title&""
IF ShowPic="Yes" Then '加上图片
OneNews="
"&OneNews
End IF
IF Showdate="Yes" Then
OneNews=OneNews&"["&formatdatetime(rs("AddDate"),2)&"]
"
Else
OneNews=OneNews&""
End IF
OneNews=OneNews&""&Left(Cts.NoHtml(rs("Content")),ContentChrNum)&"...[详细]
"
Rs.close
Set Rs=nothing
End Function
'新闻调用
Public Function News(Prov,City,NewClass,MoreSql,TopNum,ChrNum,BiaoZhi,Showdate,PicNew)
Dim Sql,Title,NewUrl
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
NewClass=Cts.FL(NewClass,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
IF Prov>0 Then
Sql=" and Prov="&Prov
End IF
IF City>0 Then
Sql=Sql&" and City="&City
End IF
IF NewClass>0 Then
Sql=Sql&" and F_Class="&NewClass
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
IF PicNew="Yes" Then
Sql=Sql&" and IntopPic=1"
ENd IF
News=""
Set Rs=conn.Execute("Select Top "&TopNum&" id,Title,STitle,Path,FileName,BiaotiNews,UBiaotiNews,AddDate,BiaoTi_pic From News Where Del=0 and NewsCheck=0 "&Sql&" order by DGNews desc,id desc")
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaoTiNews")=true Then
NewUrl=Rs("UBiaotiNews")
Else
NewUrl="http://www.cts2008.com/News/"&Rs("Path")&"/"&Rs("FileName")&".html"
End IF
IF PicNew="Yes" Then
News=News&"- "&BiaoZhi&"
"&Title&""
Else
News=News&" - "&BiaoZhi&""&Title&""
End IF
IF Showdate="Yes" Then
News=News&"["&formatdatetime(rs("AddDate"),2)&"]
"
Else
News=News&""
End IF
Rs.movenext
Loop
Rs.close
Set Rs=nothing
News=News&"
"
End Function
'热门新闻排行
Public Function RMNews(ChrNum,ContentChrNum,PicNum)
Dim Sql,Title,NewUrl,Rs
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
ContentChrNum=Cts.FL(ContentChrNum,"Number")
PicNum=Cts.FL(PicNum,"Number")
RMNews=""
Set Rs=conn.Execute("Select Top 10 id,Title,STitle,Path,FileName,AddDate,PicNews,BiaoTi_pic,Content From News Where BiaoTiNews=0 and Del=0 and NewsCheck=0 order by coun desc,id desc")
For i=1 to 10
IF rs.Eof or rs.Bof Then Exit For
NewUrl="/News/"&Rs("Path")&"/"&Rs("FileName")&Kuozm
IF PicNum > 0 and rs("PicNews")=True Then
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum-8)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum-8)
End IF
PicNum=PicNum-1
RMNews=RMNews&"- "
RMNews=RMNews&"
"
RMNews=RMNews&""
RMNews=RMNews&" "
Else
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
RMNews=RMNews&"
"&Title&" "
End IF
Rs.movenext
Next
Rs.close
Set Rs=nothing
RMNews=RMNews&"
"
End Function
'文章热门排行
Public Function RMArt(ChrNum,ContentChrNum,PicNum)
Dim Sql,Title,ArtUrl,Rs
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
ContentChrNum=Cts.FL(ContentChrNum,"Number")
PicNum=Cts.FL(PicNum,"Number")
RMArt=""
Set Rs=conn.Execute("Select Top 10 id,Title,STitle,Path,FileName,AddDate,PicArt,BiaoTi_pic,Content From Art Where BiaoTiArt=0 and Del=0 and ArtCheck=0 order by coun desc,id desc")
For i=1 to 10
IF rs.Eof or rs.Bof Then Exit For
ArtUrl="/Art/"&Rs("Path")&"/"&Rs("FileName")&Kuozm
IF PicNum > 0 and rs("PicArt")=True Then
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum-8)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum-8)
End IF
PicNum=PicNum-1
RMArt=RMArt&"- "
RMArt=RMArt&"
"
RMArt=RMArt&""
RMArt=RMArt&" "
Else
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
RMArt=RMArt&"
"&Title&" "
End IF
Rs.movenext
Next
Rs.close
Set Rs=nothing
RMArt=RMArt&"
"
End Function
'文章调用
Public Function ArtList(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,MoreSql,Style,BiaoZhi,ShowDate)
Dim Sql,Title
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Fu_Colum=Cts.FL(Fu_Colum,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
IF Prov<>0 Then
Sql=" and Prov="&Prov
End IF
IF City<>0 Then
Sql=Sql&" and City="&City
End IF
IF Fu_Colum<>0 Then
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
IF Colum_ID<>0 Then
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
Sql="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,AddDate From Art Where del=0 and ArtCheck=0 "&Sql&" order by DGArt desc,id desc"
Set Rs=Conn.Execute(Sql)
ArtList=""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaotiArt")=true Then
ArtList=ArtList&"- "&BiaoZhi&""&Title&""
Else
ArtList=ArtList&"
- "&BiaoZhi&""&Title&""
End IF
IF ShowDate="Yes" Then
ArtList=ArtList&"["&Formatdatetime(Rs("AddDate"),2)&"]
"
Else
ArtList=ArtList&""
End IF
Rs.movenext
Loop
Rs.close
ArtList=ArtList&"
"
End Function
Public Function Art_PICText(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,PicTitleNum,ContentNum,MoreSql,Style,BiaoZhi,ShowDate)
Dim Title,Sql,Sql1,Sql2
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Fu_Colum=Cts.FL(Fu_Colum,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
ContentNum=Cts.FL(ContentNum,"Number")
PicTitleNum=Cts.FL(PicTitleNum,"Number")
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Fu_Colum<>"" and Fu_Colum<>0 Then
IF Sql="" Then
Sql="Fu_Colum="&Fu_Colum
Else
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="Colum_ID="&Colum_ID
Else
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
End IF
IF MoreSql<>"" Then
IF Sql="" Then
Sql=MoreSql
Else
Sql=Sql&MoreSql
End IF
End IF
'图片部分
IF Sql<>"" Then
Sql1="Select Top 1 id,Title,Stitle,FileName,Path,BiaoTi_Pic,AddDate,Content,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0 and "&Sql
Else
Sql1="Select Top 1 id,Title,Stitle,FileName,Path,BiaoTi_Pic,AddDate,Content,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0"
End IF
IF ContentNum > 0 THen
Sql1=Sql1&" and BiaotiArt=0 order by DGArt desc,id desc"
Else
Sql1=Sql1&" order by DGArt desc,id desc"
End IF
Set Rs=Conn.Execute(Sql1)
IF Not(rs.Eof or rs.Bof) Then
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
IF Rs("BiaotiArt")=true Then
Art_PICText="
"
Else
Art_PICText="
"
End IF
'输出正文字数为0的,输出为空,样式为一图多文字链接
IF ContentNum > 0 Then
Art_PICText=Art_PICText&"" & _
""&Left(Cts.NoHtml(rs("Content")),ContentNum)&"...[详细]
"
End IF
Else
Art_PICText=""
End IF
rs.Close
Set rs=Nothing
'文字部分
IF Sql<>"" Then
Sql2="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,AddDate From Art Where del=0 and ArtCheck=0 and "&Sql&" order by DGArt desc,id desc"
Else
Sql2="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,AddDate From Art Where del=0 and ArtCheck=0 order by DGArt desc,id desc"
End IF
Set Rs=Conn.Execute(Sql2)
Art_PICText=Art_PICText&""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaotiArt")=true Then
Art_PICText=Art_PICText&"- "&BiaoZhi&""&Title&""
Else
Art_PICText=Art_PICText&"
- "&BiaoZhi&""&Title&""
End IF
IF ShowDate="Yes" Then
Art_PICText=Art_PICText&"["&Formatdatetime(Rs("AddDate"),2)&"]
"
Else
Art_PICText=Art_PICText&""
End IF
Rs.movenext
Loop
Rs.close
Art_PICText=Art_PICText&"
"
End Function
Public Function Art_PICText2(Prov,City,Fu_Colum,Colum_ID,TopNum,ChrNum,PicTopNum,PicTitleNum,ContentNum,MoreSql,Style,BiaoZhi,ShowDate)
Dim Title,Sql,Sql1,Sql2,Content,PICTextLink
Dim IDarr,i:i=0
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Fu_Colum=Cts.FL(Fu_Colum,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
ContentNum=Cts.FL(ContentNum,"Number")
PicTitleNum=Cts.FL(PicTitleNum,"Number")
PicTopNum=Cts.FL(PicTopNum,"Number")
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Fu_Colum<>"" and Fu_Colum<>0 Then
IF Sql="" Then
Sql="Fu_Colum="&Fu_Colum
Else
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="Colum_ID="&Colum_ID
Else
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
End IF
IF MoreSql<>"" Then
IF Sql="" Then
Sql=MoreSql
Else
Sql=Sql&MoreSql
End IF
End IF
'图片部分
IF Sql<>"" Then
Sql1="Select Top "&PicTopNum&" id,Title,Stitle,FileName,Path,BiaoTi_Pic,AddDate,Content,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0 and "&Sql&"order by DGArt desc,id desc"
Else
Sql1="Select Top "&PicTopNum&" id,Title,Stitle,FileName,Path,BiaoTi_Pic,AddDate,Content,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0 order by DGArt desc,id desc"
End IF
Set Rs=Conn.Execute(Sql1)
Do while not (rs.Eof or rs.Bof)
IF i=0 Then IDarr=rs("ID") Else IDarr=IDarr&","&rs("ID")
i=i+1
IF Rs("BiaotiArt")=true Then
Title=Rs("Title")
Content=Rs("STitle")
PICTextLink=rs("UBiaotiArt")
Else
IF Rs("Stitle")="" Then
Title=Rs("Title")
Else
Title=Rs("STitle")
End IF
Content=rs("Content")
PICTextLink="http://www.cts2008.com/Art/"&Rs("Path")&"/"&Rs("FileName")&".html"
End IF
'正文为0时,只输出图片和标题
IF ContentNum > 0 Then
Art_PICText2=Art_PICText2&"
" & _
""&Left(Cts.NoHtml(Content),ContentNum)&"...[详细]
"
Else
Art_PICText2=Art_PICText2&"
"&left(Title,PicTitleNum)&" "
End IF
rs.Movenext
Loop
'如果没有相关记录,同时也不输出标签
IF Art_PICText2<>"" THen Art_PICText2=""
rs.Close
Set rs=Nothing
'文字部分
IF Sql<>"" Then
Sql2="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,AddDate From Art Where del=0 and ArtCheck=0 and "&Sql&" and id not in("&IDarr&") order by DGArt desc,id desc"
Else
Sql2="Select Top "&TopNum&" id,Title,Stitle,FileName,Path,BiaotiArt,UBiaotiArt,AddDate From Art Where del=0 and ArtCheck=0 and id not in("&IDarr&") order by DGArt desc,id desc"
End IF
Set Rs=Conn.Execute(Sql2)
Art_PICText2=Art_PICText2&""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaotiArt")=true Then
Art_PICText2=Art_PICText2&"- "&BiaoZhi&""&Title&""
Else
Art_PICText2=Art_PICText2&"
- "&BiaoZhi&""&Title&""
End IF
IF ShowDate="Yes" Then
Art_PICText2=Art_PICText2&"["&Formatdatetime(Rs("AddDate"),2)&"]
"
Else
Art_PICText2=Art_PICText2&""
End IF
Rs.movenext
Loop
Rs.close
Art_PICText2=Art_PICText2&"
"
End Function
Public Function ArtPic(Prov,City,Fu_Colum,Colum_ID,TopNum,MoreSql,ChrNum,Style)
Dim Sql,Title
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Fu_Colum=Cts.FL(Fu_Colum,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
IF Prov > 0 Then
Sql=" and Prov="&Prov
End IF
IF City > 0 Then
Sql=Sql&" and City="&City
End IF
IF Fu_Colum > 0 Then
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
IF Colum_ID > 0 Then
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
'IF Sql<>"" Then
Sql="Select Top "&TopNum&" id,Title,Stitle,BiaoTi_Pic,FileName,Path,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0 "&Sql&" order by DGArt desc,id desc"
'Else
'Sql="Select Top "&TopNum&" id,Title,Stitle,BiaoTi_Pic,FileName,Path,BiaotiArt,UBiaotiArt From Art Where PicArt=1 and del=0 and ArtCheck=0 order by DGArt desc,id desc"
'End IF
Set Rs=Conn.Execute(Sql)
ArtPic=""
Do While Not(Rs.Eof or Rs.Bof)
IF Rs("Stitle")="" Then
'Title=Rs("Title")
Title=RepTitle(Rs("Title"),ChrNum)
Else
'Title=Rs("STitle")
Title=RepTitle(Rs("STitle"),ChrNum)
End IF
IF Rs("BiaotiArt")=true Then
ArtPic=ArtPic&"
"&Title&" "
Else
ArtPic=ArtPic&"
"&Title&" "
End IF
Rs.movenext
Loop
Rs.close
ArtPic=ArtPic&"
"
End Function
'线路调用
Public Function XianLu(CFProv,CFCity,MJDProv,MJDCity,XLType,NameKeyWord,TopNum,ChrNum,Account,ShowMember)
Dim Sql,Sql2,XLTitle
CFProv=Cts.FL(CFProv,"Number")
CFCity=Cts.FL(CFCity,"Number")
MJDProv=Cts.FL(MJDProv,"Number")
MJDCity=Cts.FL(MJDCity,"Number")
XLType=Cts.FL(XLType,"Number")
NameKeyWord=Cts.FL(NameKeyWord,"Sql")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
Account=Replace(Account,"|",",") '在生成Rep函数中以“,”为数组不能再也现“,”所以用|来替换
IF CFProv<>0 Then
Sql=" and ChuFD_provid1="&CFProv
End IF
IF CFCity<>0 Then
IF Sql="" Then
Sql=" and ChuFD_cityid1="&CFCity
Else
Sql=Sql&" and ChuFD_cityid1="&CFCity
End IF
End IF
IF MJDProv<>0 Then
IF Sql="" Then
Sql=" and (MuJD_cityid2 like '%,"&MJDProv&"%' or MuJD_Provid2='"&MJDProv&"')"
Else
Sql=Sql&" and (MuJD_cityid2 like '%,"&MJDProv&"%' or MuJD_Provid2='"&MJDProv&"')"
End IF
End IF
IF MJDCity<>0 Then
IF Sql="" Then
Sql=" and (MuJD_cityid2 like '%,"&MJDCity&"%' or MuJD_cityid2='"&MJDCity&"')"
Else
Sql=Sql&" and (MuJD_cityid2 like '%,"&MJDCity&"%' or MuJD_cityid2='"&MJDCity&"')"
End IF
End IF
IF XLType<>0 Then
IF Sql="" Then
Sql=" and XL_Type="&XLType
Else
Sql=Sql&" and XL_Type="&XLType
End IF
End IF
IF NameKeyWord<>"" Then
IF Sql="" Then
Sql=" and XL_Name like '%"&NameKeyWord&"%'"
Else
Sql=Sql&" and XL_Name like '%"&NameKeyWord&"%'"
End IF
End IF
IF Account<>"" Then
IF Sql="" Then
'Sql="Member_Account='"&Account&"'"
Sql=Account
Else
'Sql=Sql&" and Member_Account='"&Account&"'"
Sql=Sql&Account
End IF
End IF
IF ShowMember="Yes" Then
Sql2=",(Select UserName From Member Where MemberType='Trave' and Account=XianLu.Member_Account) as UserName"
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" ID,XL_Name,XL_Type,Member_Account,XLFileName,YouHui_Price,ShiChang_Price"&Sql2&" from XianLu Where (Member_Account='bqxd' or Member_Account='zylxs') and del=0 and XL_Check=0 "&Sql&" order by AddDate desc"
Else
Sql="Select Top "&TopNum&" ID,XL_Name,XL_Type,Member_Account,XLFileName,YouHui_Price,ShiChang_Price"&Sql2&" from XianLu Where (Member_Account='bqxd' or Member_Account='zylxs') and del=0 and XL_Check=0 order by AddDate desc"
End IF
Set Rs=conn.Execute(Sql)
XianLu=""
Do While Not(Rs.Eof or Rs.Bof)
IF len(rs("XL_Name"))>ChrNum Then
XLTitle=Left(Replace(rs("XL_Name"),"""",""),ChrNum)&"..."
Else
XLTitle=Replace(rs("XL_Name"),"""","")
End IF
XianLu=XianLu&"- "&XLTitle&""
IF ShowMember="Yes" THen
XianLu=XianLu&""&left(rs("UserName"),14)&""
Else
End IF
IF Rs("XL_Type")=5 Then
XianLu=XianLu&"电询电询
"
Else
XianLu=XianLu&""&rs("YouHui_Price")&"¥"&rs("ShiChang_Price")&""
End IF
Rs.movenext
Loop
XianLu=XianLu&"
"
End Function
'----------------------------------------周围边游调用---------------------------------------------
'周边图文加文字链接
Public Function ZBPicArt(ArtNum,ColumID,MoreSql,ChrNum)
Dim PicID,zSql,ZPTitle
ArtNum=Cts.FL(ArtNum,"Number")
ColumID=Cts.FL(ColumID,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
PicID=0
IF Cts.FL(ColumID,"Number")>0 Then
zSql=" and Colum_ID='"&ColumID&"'"
End IF
IF MoreSql<>"" Then
IF zSql="" Then
zSql=MoreSql
Else
zSql=zSql&MoreSql
End IF
End IF
Set ZPrs=Conn.Execute("Select * From Art Where PicArt=1 and del=0 and ArtCheck=0 and biaotiArt=0 "&zSql&" order by DGArt desc,ID desc")
IF Not(ZPrs.Eof or ZPrs.Bof) Then
IF len(ZPrs("Title"))>12 Then
ZPTitle=Left(ZPrs("Title"),11)&"..."
Else
ZPTitle=ZPrs("Title")
ENd IF
IF ZPrs("BiaotiArt")=true Then
ArtPath=ZPrs("UBiaotiArt")
Else
ArtPath="/Art/"&ZPrs("Path")&"/"&ZPrs("FileName")&Kuozm
End IF
ZBPicArt="![]()
"& vbcrlf
ZBPicArt=ZBPicArt&"- "&left(Cts.NoHtml(ZPrs("Content")),55)&"...[详细]
"& vbcrlf
ZBPicArt=ZBPicArt&"
"& vbcrlf
PicID=ZPrs("ID")
End IF
ZPrs.Close
Set ZPrs=Nothing
ZBPicArt=ZBPicArt&""
Set ZPrs=Conn.Execute("Select Top "&ArtNum&" * From Art Where ID<>"&PicID&" and del=0 and ArtCheck=0 and biaotiArt=0 "&zSql&" order by DGArt desc,ID desc")
Do while Not(ZPrs.Eof or ZPrs.Bof)
IF len(ZPrs("Title"))>ChrNum Then
ZPTitle=Left(ZPrs("Title"),ChrNum-1)&"..."
Else
ZPTitle=ZPrs("Title")
End IF
IF ZPrs("BiaotiArt")=true Then
ArtPath=ZPrs("UBiaotiArt")
Else
ArtPath="/Art/"&ZPrs("Path")&"/"&ZPrs("FileName")&Kuozm
End IF
ZBPicArt=ZBPicArt&"- "&ZPTitle&"
"& vbcrlf
ZPrs.Movenext
Loop
ZPrs.Close
Set ZPrs=Nothing
ZBPicArt=ZBPicArt&"
"
End Function
'调用一篇文章,输出120个字符
Public Function OneArt(Prov,City,Fu_Colum,Colum_ID,ChrNum,ContentChrNum,MoreSql)
Dim Sql
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Fu_Colum=Cts.FL(Fu_Colum,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
IF Prov > 0 Then
Sql=" and Prov="&Prov
End IF
IF City > 0 Then
Sql=Sql&" and City="&City
End IF
IF Fu_Colum > 0 Then
Sql=Sql&" and Fu_Colum="&Fu_Colum
End IF
IF Colum_ID > 0 Then
Sql=Sql&" and Colum_ID="&Colum_ID
End IF
IF MoreSql<>"" Then
Sql=Sql&MoreSql
End IF
Set oners=Conn.Execute("Select Top 1 Title,STitle,Content,Path,FileName From Art Where del=0 and ArtCheck=0 and biaotiArt=0 "&Sql&" order by DGArt desc,ID desc")
IF Not (oners.Eof or oners.Bof) Then
OneArt=""&left(oners("Title"),ChrNum)&""
OneArt=OneArt&Left(Cts.NoHtml(oners("Content")),ContentChrNum)&"...[详细]"
End IF
oners.Close
Set oners=Nothing
End Function
'----------------------------------------周围边游调用结束-----------------------------------------
'-------------------------------------------国内游调用--------------------------------------------
Public Function CitysearchLink(Prov)
Dim ProvID,ChrNum
ProvID=Cts.FL(Prov,"Number")
ChrNum=0
Set rs=Conn.Execute("Select * From Prov_Class Where Prov='"&ProvID&"' order by Prov_EN asc")
Do while not(rs.Eof or rs.Bof)
ChrNum=ChrNum+len(rs("Prov_CN"))
IF ChrNum>40 Then
Exit DO
Else
CitysearchLink=CitysearchLink&""&rs("Prov_CN")&""
rs.Movenext
End IF
Loop
rs.Close
Set rs=Nothing
End Function
Public Function ProvCityInFoOne(Prov,City)
Dim PCSql,ArtPath
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
IF Prov>0 THen
PCSql=" and Prov="&Prov
End IF
'IF City>0 Then '如果为省调用,市应为0,所以此外不做叛断
IF PCSql="" Then
PCSql=" and City="&City
Else
PCSql=PCSql&" and City="&City
End IF
'End IF
Set rs=Cts.Execute("Select * From Art Where PicArt=1 and del=0 and ArtCheck=0 and biaotiArt=0 and Colum_ID=247 "&PCSql)
IF rs.Eof or rs.Bof Then
Else
IF rs("BiaotiArt")=true Then
ArtPath=rs("UBiaotiArt")
Else
ArtPath="/Art/"&rs("Path")&"/"&rs("FileName")&Kuozm
End IF
ProvCityInFoOne="
"
End IF
rs.Close
Set rs=Nothing
End Function
'-----------------------------------------国内游调用结束------------------------------------------
Public Function PhotoList(Prov,City,Colum_ID,TopNum,ChrNum,MoreSql,BiaoZhi,Show,StyleType,PaiXu)
Dim Sql
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
Colum_ID=Cts.FL(Colum_ID,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
Show=Cts.FL(Show,"Number")
IF Prov<>"" and Prov<>0 Then
Sql="Prov="&Prov
End IF
IF City<>"" and City<>0 Then
IF Sql="" Then
Sql="City="&City
Else
Sql=Sql&" and City="&City
End IF
End IF
IF Colum_ID<>"" and Colum_ID<>0 Then
IF Sql="" Then
Sql="ColumID="&Colum_ID
Else
Sql=Sql&" and ColumID="&Colum_ID
End IF
End IF
IF MoreSql<>"" Then
IF Sql="" Then
Sql=MoreSql
Else
Sql=Sql&MoreSql
End IF
End IF
IF Sql<>"" Then
Sql="Select Top "&TopNum&" Img_Title.*,Img_Photo.SmallImageFile,Img_Photo.ImageFile From Img_Title inner join Img_Photo on Img_Title.ID=Img_Photo.FuTitleID Where Img_Photo.OrderID=1 and Img_Title.show=0 and "&Sql&" order by Img_Title."&PaiXu&" desc"
Else
Sql="Select Top "&TopNum&" Img_Title.*,Img_Photo.SmallImageFile,Img_Photo.ImageFile From Img_Title inner join Img_Photo on Img_Title.ID=Img_Photo.FuTitleID Where Img_Photo.OrderID=1 and Img_Title.show=0 order by Img_Title."&PaiXu&" desc"
End IF
Set Rs=Conn.Execute(Sql)
PhotoList=""
Do While Not(Rs.Eof or Rs.Bof)
IF StyleType="Pic" Then
IF isnull(rs("SmallImageFile")) Then
PhotoList=PhotoList&"
"&Left(rs("Title"),ChrNum)&""
Else
PhotoList=PhotoList&"
"&Left(rs("Title"),ChrNum)&""
End IF
Else
PhotoList=PhotoList&"- "&BiaoZhi&""&Left(rs("Title"),ChrNum)&""
End IF
IF Show=1 Then
PhotoList=PhotoList&"时间:"&Formatdatetime(Rs("AddDate"),2)&"
"
ElseIF Show=2 Then
PhotoList=PhotoList&"发布者:"&Rs("Author")&""
ElseIF Show=3 Then
PhotoList=PhotoList&"发布者:"&Rs("Author")&""
PhotoList=PhotoList&"时间:"&Formatdatetime(Rs("AddDate"),2)&""
Else
PhotoList=PhotoList&""
End IF
Rs.movenext
Loop
Rs.close
PhotoList=PhotoList&"
"
End Function
'日志调用
Public Function Bloglog_Load(SystemClass,UserClass,TopNum,ChrNum,ShowUser,ShowDJ,ShowDate,byorder,MoreSql,ShowStyle)
Dim rs,Sql,LogSrt,p:p=1
Dim TFaceimg
SystemClass = Cts.FL(SystemClass,"Number")
UserClass = Cts.FL(UserClass,"Number")
TopNum = Cts.FL(TopNum,"Number")
ChrNum = Cts.FL(ChrNum,"Number")
ShowUser = Cts.FL(ShowUser,"Number")
ShowDJ = Cts.FL(ShowDJ,"Number")
ShowDate = Cts.FL(ShowDate,"Number")
byorder = Cts.FL(byorder,"Number")
MoreSql = Cts.FL(MoreSql,"Sql")
ShowStyle = Cts.FL(ShowStyle,"Number")
IF SystemClass > 0 Then
Sql=" and b.System_Type="&SystemClass
End IF
IF UserClass > 0 Then
Sql=Sql&" and b.User_Type="&UserClass
End IF
IF MoreSql <> "" Then
Sql=Sql&MoreSql
End IF
IF byorder=1 Then
Sql=Sql&" order by b.Show_Num desc"
ElseIF byorder=2 Then
Sql=Sql&" order by b.PL_Num desc"
ElseIF byorder=3 Then '精华
Sql=Sql&" order by b.JingHua desc,b.id desc"
ELse
Sql=Sql&" order by b.id desc"
End IF
'IF ShowUser=1 Then
Set rs=Cts.Execute("Select Top "&TopNum&" b.*,u.UserName as UserName,u.Face as Face From Cts_Blog as b inner join Cts_User as u on b.UserID=u.ID where b.Save_Type=0 and b.Secret=1 "&Sql)
'Else
' Set rs=Conn.Execute("Select Top "&TopNum&" * From Cts_Blog where Save_Type=0 and Secret=1 "&Sql)
'End IF
While Not (rs.Eof or rs.Bof)
LogSrt=LogSrt&"- "
IF ShowStyle=2 and p=1 Then
'LogSrt=""
IF (rs("Face")&"")="" Then
TFaceimg="
"
Else
TFaceimg="
"
End IF
LogSrt=""
p=p+1
Else
IF ShowStyle=1 or ShowStyle=2 Then
LogSrt=LogSrt&"
"
p=p+1
End IF
IF len(rs("Title")) > ChrNum Then
'LogSrt=LogSrt&""&Left(rs("Title"),ChrNum)&CtsUser.logjh(rs("JingHua"))&"..."
LogSrt=LogSrt&""&Left(rs("Title"),ChrNum)&Home.logjh(rs("JingHua"))&"..."
Else
'LogSrt=LogSrt&""&rs("Title")&CtsUser.logjh(rs("JingHua"))&""
LogSrt=LogSrt&""&rs("Title")&Home.logjh(rs("JingHua"))&""
End IF
IF ShowUser=1 Then
LogSrt=LogSrt&""&rs("UserName")&""
End IF
IF ShowDJ=1 Then
LogSrt=LogSrt&""&rs("Show_Num")&""
End IF
IF ShowDate=1 Then
LogSrt=LogSrt&""&Formatdatetime(rs("AddTime"),2)&""
End IF
End IF
LogSrt=LogSrt&" "
rs.Movenext
Wend
rs.CLose
Set rs=Nothing
IF LogSrt="" Then
Bloglog_Load=""
Else
Bloglog_Load=""
End IF
End Function
Public Function Blog_Type()
Dim rs
Set rs=Cts.Execute("Select * From Cts_Blog_SystemType order by id desc")
Do while not (rs.Eof or rs.Bof)
Blog_Type=Blog_Type&"- "&rs("Title")&"
"
rs.Movenext
Loop
rs.Close
Set rs=Nothing
Blog_Type=""
End Function
'家园之星调用
Public Function HomeStarLoad(TopNum,ChrNum)
Dim rs
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
Set rs=Cts.Execute("Select Top "&TopNum&" * From Cts_HomeStar where HomeStar_Check=1 order by id desc")
Do while not (rs.Eof or rs.Bof)
HomeStarLoad=HomeStarLoad&"- "
HomeStarLoad=HomeStarLoad&"
"&rs("HomeName")&""
HomeStarLoad=HomeStarLoad&""&Left(rs("Content"),ChrNum)&"...
"
HomeStarLoad=HomeStarLoad&" "
rs.Movenext
Loop
rs.Close
Set rs=Nothing
HomeStarLoad=""
End Function
Public Function xmlhttphtml(url) 'whc 觉的有问题,以后修改
On Error Resume Next
Set xml = Server.CreateObject("Microsoft.XMLHTTP")
xml.Open "GET", url, False
xml.Send
If Err Then
err.Clear
xmlhttphtml="加载出错!"
Exit Function
End If
BodyText=xml.ResponseBody
xmlhttphtml=BytesToBstr(BodyText,"gb2312")
Set xml = Nothing
End Function
Public Function BytesToBstr(body,Cset) '转utf-8
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function
'向utf-8页中传中文参数时可以使用转换函数或escape("天津") unescape("%u5929%u6D25") 等方法
'utf-8转gb2312
Public Function U2UTF8(Byval a_iNum)
Dim sResult,sUTF8
Dim iTemp,iHexNum,i
iHexNum = Trim(a_iNum)
If iHexNum = "" Then
Exit Function
End If
sResult = ""
If (iHexNum < 128) Then
sResult = sResult & iHexNum
ElseIf (iHexNum < 2048) Then
sResult = ChrB(&H80 + (iHexNum And &H3F))
iHexNum = iHexNum \ &H40
sResult = ChrB(&HC0 + (iHexNum And &H1F)) & sResult
ElseIf (iHexNum < 65536) Then
sResult = ChrB(&H80 + (iHexNum And &H3F))
iHexNum = iHexNum \ &H40
sResult = ChrB(&H80 + (iHexNum And &H3F)) & sResult
iHexNum = iHexNum \ &H40
sResult = ChrB(&HE0 + (iHexNum And &HF)) & sResult
End If
U2UTF8 = sResult
End Function
'gb2312转uft-8
Public Function GB2UTF(Byval a_sStr)
Dim sGB,sResult,sTemp
Dim iLen,iUnicode,iTemp,i
sGB = Trim(a_sStr)
iLen = Len(sGB)
For i = 1 To iLen
sTemp = Mid(sGB,i,1)
iTemp = Asc(sTemp)
If (iTemp>127 OR iTemp<0) Then
iUnicode = AscW(sTemp)
If iUnicode<0 Then
iUnicode = iUnicode + 65536
End If
Else
iUnicode = iTemp
End If
sResult = sResult & U2UTF8(iUnicode)
Next
GB2UTF = sResult
End Function
'机票版面使用,表格
Public Function Member_FlyJP(TopNum,ChrNum,MoreSql)
Dim CommPany
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
Set Hrs=conn.Execute("select Top "&TopNum&" * from Member_JiPiao where JP_Check=0 "&HSql&" order by AddTime desc")
Member_FlyJP=""
Do while Not (Hrs.Eof or Hrs.Bof)
Member_FlyJP=Member_FlyJP&""
For i=1 to 2
IF Hrs.Eof or Hrs.Bof Then
Member_FlyJP=Member_FlyJP&"| | " &_
" | "
Else
Member_FlyJP=Member_FlyJP&""&left(Hrs("Title"),ChrNum)&" | " &_
"¥"&Hrs("yhPrice")&" | "
Hrs.Movenext
End IF
Next
Member_FlyJP=Member_FlyJP&"
"
Loop
Hrs.Close
Set Hrs=Nothing
End Function
'机票调用
Public Function Member_JP(TopNum,ChrNum,MoreSql)
Dim CommPany
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
Set Hrs=conn.Execute("select Top "&TopNum&" * from Member_JiPiao where JP_Check=0 "&HSql&" order by AddTime desc")
Member_JP=""
Do while Not (Hrs.Eof or Hrs.Bof)
Member_JP=Member_JP&"- "
Member_JP=Member_JP&""&left(Hrs("Title"),ChrNum)&"" &_
"¥"&Hrs("yhPrice")&""
Hrs.Movenext
Member_JP=Member_JP&"
"
Loop
Member_JP=Member_JP&"
"
Hrs.Close
Set Hrs=Nothing
End Function
'酒店调用
Public Function Member_Hotel(Prov,City,TopNum,ChrNum,MoreSql,CityShow,NameShow,StaShow,PriceShow)
Dim Sql,HotelPrice,rs
Prov=Cts.FL(Prov,"Number")
City=Cts.FL(City,"Number")
TopNum=Cts.FL(TopNum,"Number")
ChrNum=Cts.FL(ChrNum,"Number")
IF Prov > 0 Then
Sql=" and hotelsheng="&Prov
End IF
IF City > 0 Then
Sql=Sql&" and hotelcity="&City
End IF
IF MoreSql <>"" Then
Sql=Sql&MoreSql
End IF
Member_Hotel=""
Set rs=Cts.Execute("Select Top "&TopNum&" ID,Account,MemberType,JDName,hotelcity,jibie,(Select Top 1 zhou1 From hotelroom where HotelID=Hotel.ID order by zhou1 asc) as price From Hotel where shenhe=0 "&Sql&" order by id desc")
Do while not(rs.Eof or rs.Bof)
IF isnull(rs("Price")) or rs("Price")="" Then
HotelPrice="暂无"
Else
HotelPrice=rs("Price")
End IF
Member_Hotel=Member_Hotel&"- "
IF CityShow="Yes" Then
Member_Hotel=Member_Hotel&"["&Cts.ProvCity_CN(rs("hotelcity"),1)&"]"
End IF
Member_Hotel=Member_Hotel&""&left(rs("jdName"),ChrNum)&""
IF PriceShow="Yes" THen
Member_Hotel=Member_Hotel&""&HotelPrice&""
End IF
IF StaShow="Yes" Then
Member_Hotel=Member_Hotel&""&rs("jibie")&"星"
End IF
Member_Hotel=Member_Hotel&"
"
rs.Movenext
Loop
rs.Close
Set rs=Nothing
Member_Hotel=Member_Hotel&"
"
End Function
'线路小分类输出
Public Function XL_TypeS()
Dim rs,onjs
'Set rs=Cts.Execute("Select z.* From Member_TraveType as z Where (z.Fu_Class is null) and (Select count(ID) From Member_TraveType Where Fu_Class=z.ID)>0 order by z.OrderID asc")
Set rs=Cts.Execute("Select z.* From Member_TraveType as z Where (z.Fu_Class is null) order by z.OrderID asc")
Do while not (rs.Eof or rs.Bof)
' XL_TypeS=XL_TypeS&""
'XL_TypeS=XL_TypeS&"