📄 cls_js.asp
字号:
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
ClsTempLoseStr = 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,NewsID,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 NewsID='"&ClsJSFileObj("NewsID")&"'")
If ClsJSObj("ShowTimeTF")="1" then
JSCodeStr = JSCodeStr &"<td valign=middle ><img src="""&ClsJSObj("NaviPic")&""" /><a class="""&ClsJSObj("TitleCSS")&""" href=http://"&Replace(Conn.execute("SELECT MF_Domain FROM FS_MF_Config")(0),"/"&G_VIRTUAL_ROOT_DIR,"") & 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=http://"&Replace(Conn.execute("SELECT MF_Domain FROM FS_MF_Config")(0),"/"&G_VIRTUAL_ROOT_DIR,"") & 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(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/"))&"\"& EName &".js") then
MyFile.DeleteFile(Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/"))&"\"& EName &".js")
End If
CreatePath Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/")),Server.MapPath(replace(replace("../../../"&TempSysRootDir,"///","/"),"//","/"))
Set CrHNJS=MyFile.CreateTextFile(Server.MapPath(replace(replace("../../../"&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,NewsID,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 NewsID='"&ClsJSFileObj("NewsID")&"'")
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><img src="""&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><img src="""&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&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]","")," ",""),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&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]","")," ",""),ClsJSObj("ContentNum"))&"</Span>......</td></tr></table></td>"
End If
Else
If ClsJSObj("MoreContent")=1 then
JSCodeStr = JSCodeStr & "<tr><td><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]","")," ",""),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><Span class="""&ClsJSObj("ContentCSS")&""">"&TitleSpaceStr&GotTopic(Replace(Replace(Replace(LoseHtml(ClsNewsObj("Content")),chr(13) & chr(10),""),"[Page]","")," ",""),ClsJSObj("ContentNum"))&"</Span>......</td></tr></table></td>"
End If
End If
ClsNewsObj.Close
Set ClsNewsObj = Nothing
ClsJSFileObj.MoveNext
if i mod Cint(ClsJSObj("RowNum")) = 0 or ClsJSFileObj.eof then
JSCodeStr = JSCodeStr &"</tr><tr><td colspan="""&Cint(ClsJSObj("RowNum"))&""" height="""&ClsJSObj("RowSpace")&""" background="""&ClsJSObj("RowBettween")&"""></td></tr><tr>"
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),"")
if CreateFileTF = True then
Set MyFile=Server.CreateObject(G_FS_FSO)
If MyFile.FileExists(Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/"))&"\"& EName &".js") then
MyFile.DeleteFile(Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/"))&"\"& EName &".js")
End If
CreatePath Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/")),Server.MapPath(replace(replace("../../../"&TempSysRootDir,"///","/"),"//","/"))
Set CrHNJS=MyFile.CreateTextFile(Server.MapPath(replace(replace("../../../"&TempSysRootDir&"/JS/FreeJs","///","/"),"//","/"))&"\"& EName &".js")
CrHNJS.write JSCodeStr
Set MyFile=nothing
ClsJSObj.Close
Set ClsJSObj = Nothing
else
WCssB = JSCodeStr
end if
Else
WCssB = "生成JS文件时未找到参数"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -