📄 cls_js.asp
字号:
Elseif Not IsNull(DoMain) And (DoMain <> "") then
DatePathStr = DoMain &"/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
if instr(lcase(DatePathStr),"http://")=0 then DatePathStr="http://"&Replace(DatePathStr,"//","/")
End if
ElseIf LinkType=0 then
'DatePathStr =RsNewsObj("SavePath")&"/"&RsNewsObj("ClassEName")&"/"& RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
DatePathStr =RsNewsObj("SavePath")&"/"&RsNewsObj("ClassEName")&RsNewsObj("SaveNewsPath")&"/" & RsNewsObj("FileName") & "." & RsNewsObj("NewsFileExtName")
End if
End If
End if
Set RsNewsObj = Nothing
GetOneNewsLinkURL = DatePathStr
End Function
'-----自由JS时间格式化
Public Function DateFormat(DateStr,Types)
Dim DateString
if IsDate(DateStr) = False then
DateString = ""
end if
Select Case Types
Case "1"
DateString = Year(DateStr)&"-"&Month(DateStr)&"-"&Day(DateStr)
Case "2"
DateString = Year(DateStr)&"."&Month(DateStr)&"."&Day(DateStr)
Case "3"
DateString = Year(DateStr)&"/"&Month(DateStr)&"/"&Day(DateStr)
Case "4"
DateString = Month(DateStr)&"/"&Day(DateStr)&"/"&Year(DateStr)
Case "5"
DateString = Day(DateStr)&"/"&Month(DateStr)&"/"&Year(DateStr)
Case "6"
DateString = Month(DateStr)&"-"&Day(DateStr)&"-"&Year(DateStr)
Case "7"
DateString = Month(DateStr)&"."&Day(DateStr)&"."&Year(DateStr)
Case "8"
DateString = Month(DateStr)&"-"&Day(DateStr)
Case "9"
DateString = Month(DateStr)&"/"&Day(DateStr)
Case "10"
DateString = Month(DateStr)&"."&Day(DateStr)
Case "11"
DateString = Month(DateStr)&"月"&Day(DateStr)&"日"
Case "12"
DateString = Day(DateStr)&"日"&Hour(DateStr)&"时"
case "13"
DateString = Day(DateStr)&"日"&Hour(DateStr)&"点"
Case "14"
DateString = Hour(DateStr)&"时"&Minute(DateStr)&"分"
Case "15"
DateString = Hour(DateStr)&":"&Minute(DateStr)
Case "16"
DateString = Year(DateStr)&"年"&Month(DateStr)&"月"&Day(DateStr)&"日"
Case Else
DateString = DateStr
End Select
DateFormat = DateString
End Function
'---------------------------------------------
Public Function LoseHtml(ContentStr)
Dim ClsTempLoseStr,regEx
If ContentStr="" Or IsNull(ContentStr) Then Exit function
ClsTempLoseStr = Cstr(ContentStr)
Set regEx = New RegExp
regEx.Pattern = "<\/*[^<>]*>"
regEx.IgnoreCase = True
regEx.Global = True
ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
LoseHtml = ClsTempLoseStr
End Function
'---------------------------------------------
Function GotTopic(Str,StrLen)
Dim l,t,c,i
If StrLen=0 then
GotTopic=""
exit function
End If
if IsNull(Str) then
GotTopic = ""
Exit Function
end if
if Str = "" then
GotTopic=""
Exit Function
end if
Str=Replace(Replace(Replace(Replace(Str," "," "),""",Chr(34)),">",">"),"<","<")
l=len(str)
t=0
strlen=Clng(strLen)
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
GotTopic=left(str,i)
exit for
else
GotTopic=str
end if
next
GotTopic = Replace(Replace(Replace(Replace(GotTopic," "," "),Chr(34),"""),">",">"),"<","<")
end Function
'-----------------------------------------------------
Private Function ListTitle(TitleStr,TitleNum)
Dim ClsTitleStr,ClsTitleNum,i,j,ClsTempNum,k,ClsTitleStrResult,LeftStr,RightStr
ClsTitleNum = Cint(TitleNum)
ClsTempNum = Len(Cstr(TitleStr))
if ClsTitleNum > ClsTempNum then
ClsTitleNum = ClsTempNum
end if
ClsTitleStr = Left(Cstr(TitleStr),ClsTitleNum)
Dim TempStr
For i = 1 to ClsTitleNum - 1
TempStr = TempStr & Mid(ClsTitleStr,i,1) & "<br>"
Next
TempStr = TempStr & Right(ClsTitleStr,1)
ListTitle = TempStr
End Function
'生成函数
Public Function WCssA(EName,CreateFileTF)
Dim ClsJSObj,ClsJSFileObj,ClsFileSql,ClsNewsObj,TempEName,JSCodeStr,i,MyFile,CrHNJS,OpenMode
Set ClsJSObj = Conn.Execute("Select ID,EName,CName,Type,Manner,PicWidth,PicHeight,NewsNum,NewsTitleNum,TitleCSS,ContentCSS,BackCSS,RowNum,PicPath,AddTime,ShowTimeTF,ContentNum,NaviPic,DateType,DateCSS,Info,MoreContent,LinkWord,LinkCSS,RowSpace,RowBettween,OpenMode From FS_NS_FreeJS Where EName='"&NoSqlHack(EName)&"'")
If Not ClsJSObj.eof then
JSCodeStr = "document.write('<table class="""&ClsJSObj("BackCSS")&""" width=""100%"" border=""0"" cellpadding=""0"" cellspacing="""&ClsJSObj("RowSpace")&"""><tr>"
Set ClsJSFileObj=server.createobject(G_FS_RS)
ClsFileSql="Select ID,Title,JSName,FileName,PicPath,ClassID,NewsTime,ToJsTime,DelFlag From FS_NS_FreeJSFile where JSName='"&NoSqlHack(EName)&"' and DelFlag=0 order by ToJsTime desc"
ClsJSFileObj.open ClsFileSql,Conn,1,1
If ClsJSFileObj.eof then
JSCodeStr = JSCodeStr & "<td>此JS内暂无新闻</td>"
End If
If ClsJSObj("OpenMode")=1 then
OpenMode = "target=_blank"
Else
OpenMode = "target=_self"
End If
for i=1 to ClsJSObj("NewsNum")
If ClsJSFileObj.eof then Exit For
Set ClsNewsObj = Conn.Execute("Select ID,NewsID,PopId,ClassID,SpecialEName,NewsTitle,CurtTitle,NewsNaviContent,isShowReview,TitleColor,titleBorder,TitleItalic,IsURL,URLAddress,Content,isPicNews,NewsPicFile,NewsSmallPicFile,PicborderCss,Templet,isPop,Source,Editor,Keywords,Author,SaveNewsPath,FileName,FileExtName,NewsProperty,TodayNewsPic,isLock,isRecyle,addtime From FS_NS_News where FileName='"&ClsJSFileObj("FileName")&"'")
If ClsJSObj("ShowTimeTF")="1" then
JSCodeStr = JSCodeStr &"<td valign=middle ><img src="""&ClsJSObj("NaviPic")&""" /><a class="""&ClsJSObj("TitleCSS")&""" href=" & GetOneNewsLinkURL(ClsNewsObj("NewsID")) &" "&OpenMode&">"&GotTopic(ClsNewsObj("NewsTitle"),ClsJSObj("NewsTitleNum"))&"</a></td><td><Span class="""&ClsJSObj("DateCSS")&""">"&DateFormat(ClsNewsObj("AddTime"),""&ClsJSObj("DateType")&"")&"</Span></td>"
Else
JSCodeStr = JSCodeStr &"<td valign=middle><img src="""&ClsJSObj("NaviPic")&""" /><a class="""&ClsJSObj("TitleCSS")&""" href=" & GetOneNewsLinkURL(ClsNewsObj("NewsID")) &" "&OpenMode&">"&GotTopic(ClsNewsObj("NewsTitle"),ClsJSObj("NewsTitleNum"))&"</a></td>"
End If
ClsNewsObj.Close
Set ClsNewsObj = Nothing
ClsJSFileObj.MoveNext
if i mod Cint(ClsJSObj("RowNum")) = 0 or ClsJSFileObj.eof then
if ClsJSObj("ShowTimeTF")=1 then
JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))*2&""" height="""&ClsJSObj("RowSpace")&""" background="""& ClsJSObj("RowBettween")&"""></td></tr><tr>"
else
JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))&""" height="""&ClsJSObj("RowSpace")&""" background="""& ClsJSObj("RowBettween")&"""></td></tr><tr>"
end if
end if
next
ClsJSFileObj.Close
Set ClsJSFileObj = Nothing
JSCodeStr = JSCodeStr & "</tr></table>');"
JSCodeStr = Replace(JSCodeStr,"<tr></tr>","")
JSCodeStr = Replace(Replace(JSCodeStr,Chr(13),""),Chr(10),"")
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FileExists(Server.MapPath("../../../"&TempSysRootDir&"/JS/FreeJs")&"\"& EName &".js") then
MyFile.DeleteFile(Server.MapPath("../../../"&TempSysRootDir&"/JS/FreeJs")&"\"& EName &".js")
End If
If Not MyFile.FolderExists(Server.MapPath("../../../"&TempSysRootDir&"/JS")) Then
MyFile.CreateFolder(Server.MapPath("../../../"&TempSysRootDir&"/JS"))
End if
If Not MyFile.FolderExists(Server.MapPath("../../../"&TempSysRootDir&"/JS/FreeJs")) Then
MyFile.CreateFolder(Server.MapPath("../../../"&TempSysRootDir&"/JS/FreeJs"))
End if
Set CrHNJS=MyFile.CreateTextFile(Server.MapPath("../../../"&TempSysRootDir&"/JS/FreeJs")&"\"& EName &".js")
CrHNJS.write JSCodeStr
Set MyFile=nothing
'---------
ClsJSObj.Close
Set ClsJSObj = Nothing
Else
WCssA = "生成JS文件时未找到参数"
End If
End Function
Public Function WCssB(EName,CreateFileTF)
Dim ClsJSObj,ClsJSFileObj,ClsFileSql,ClsNewsObj,TempEName,JSCodeStr,i,MyFile,CrHNJS,OpenMode
Dim NewsLinkStr
Set ClsJSObj = Conn.Execute("Select ID,EName,CName,Type,Manner,PicWidth,PicHeight,NewsNum,NewsTitleNum,TitleCSS,ContentCSS,BackCSS,RowNum,PicPath,AddTime,ShowTimeTF,ContentNum,NaviPic,DateType,DateCSS,Info,MoreContent,LinkWord,LinkCSS,RowSpace,RowBettween,OpenMode From FS_NS_FreeJS Where EName='"&NoSqlHack(EName)&"'")
If Not ClsJSObj.eof then
JSCodeStr = "document.write('<table class="""&ClsJSObj("BackCSS")&""" width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr>"
Set ClsJSFileObj=server.createobject(G_FS_RS)
ClsFileSql="Select ID,Title,JSName,FileName,PicPath,ClassID,NewsTime,ToJsTime,DelFlag From FS_NS_FreeJSFile where JSName='"&NoSqlHack(EName)&"' and DelFlag=0 order by ToJsTime desc"
ClsJSFileObj.open ClsFileSql,Conn,1,1
If ClsJSFileObj.eof then
JSCodeStr = JSCodeStr & "<td>此JS内暂无新闻</td>"
end if
If ClsJSObj("OpenMode")=1 then
OpenMode = "target=_blank"
Else
OpenMode = "target=_self"
End If
ListSpaceStr = ""
for Temp_i = 1 to Cint(ClsJSObj("RowSpace"))
ListSpaceStr = ListSpaceStr & " "
next
for i=1 to ClsJSObj("NewsNum")
If ClsJSFileObj.eof then Exit For
Set ClsNewsObj = Conn.Execute("Select ID,NewsID,PopId,ClassID,SpecialEName,NewsTitle,CurtTitle,NewsNaviContent,isShowReview,TitleColor,titleBorder,TitleItalic,IsURL,URLAddress,Content,isPicNews,NewsPicFile,NewsSmallPicFile,PicborderCss,Templet,isPop,Source,Editor,Keywords,Author,SaveNewsPath,FileName,FileExtName,NewsProperty,TodayNewsPic,isLock,isRecyle,addtime From FS_NS_News where FileName='"&NoSqlHack(ClsJSFileObj("FileName"))&"'")
NewsLinkStr = GetOneNewsLinkURL(ClsNewsObj("NewsID"))
If ClsJSObj("ShowTimeTF")=1 then
JSCodeStr = JSCodeStr &"<td width="&Cint(100/Cint(ClsJSObj("RowNum")))&"% valign=""top""><table width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr><td>"& ClsJSObj("NaviPic") &"<a class="""&ClsJSObj("TitleCSS")&""" href=" & NewsLinkStr &" "&OpenMode&">"&GotTopic(ClsNewsObj("NewsTitle"),ClsJSObj("NewsTitleNum"))&"</a></td><td><Span class="""&ClsJSObj("DateCSS")&""">"&DateFormat(ClsNewsObj("AddTime"),""&ClsJSObj("DateType")&"")&"</Span></td><td rowspan=2>"&ListSpaceStr&"</td></tr>"
Else
JSCodeStr = JSCodeStr &"<td width="&Cint(100/Cint(ClsJSObj("RowNum")))&"% valign=""top""><table width=100% border=0 cellpadding=0 cellspacing="""&ClsJSObj("RowSpace")&"""><tr><td>"& ClsJSObj("NaviPic") &"<a class="""&ClsJSObj("TitleCSS")&""" href=" & NewsLinkStr &" "&OpenMode&">"&GotTopic(ClsNewsObj("NewsTitle"),ClsJSObj("NewsTitleNum"))&"</a></td><td rowspan=2>"&ListSpaceStr&"</td></tr>"
End If
If ClsJSObj("ShowTimeTF")=1 then
If ClsJSObj("MoreContent")=1 then
JSCodeStr = JSCodeStr & "<tr><td colspan=2><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&left(ClsNewsObj("Content"),ClsJSObj("ContentNum"))&"</Span>......<br><div align=""right""><a class="""&ClsJSObj("LinkCSS")&""" href="&NewsLinkStr&" "&OpenMode&">"&ClsJSObj("LinkWord")&"</a></div></td></tr></table></td>"
Else
JSCodeStr = JSCodeStr & "<tr><td colspan=2><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&left(ClsNewsObj("Content"),ClsJSObj("ContentNum"))&"</Span>......</td></tr></table></td>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -