📄 wm.cre_cls.asp
字号:
<%
Private xTemp,xPath,xSQL,xRs,xRso,xI,ID,CreID,i,xSort,N,MaxID,xTimer,xDir
Private xArea,xAreaAsp,AreaSelect,xCount,xCount1,xUrl
Private xCode
Private xChannelName,xChannelType,xWM_Title,xWM_Module,xChannelDir,xRe,xKey,xChannelLogo,xMetaKey,xMetaContent,xCreateHTML,xStructureType,xFileNameType,xFileExt_Index,xFileExt_Item,xWM_DefaultFolder,xWM_DefaultFiles,xID
Randomize Timer
'生成频道配置文件
Sub CreChannel()
Set Rs = Conn.Execute("Select WM_ChannelName,WM_ChannelType,WM_Title,WM_Module,WM_ChannelDir,WM_Re,WM_Key,WM_ChannelLogo,WM_MetaKey,WM_MetaContent,WM_CreateHTML,WM_StructureType,WM_FileNameType,WM_FileExt_Index,WM_FileExt_Item,WM_ID from WM_Channel Where WM_Module > 0 and WM_Module <> 5")
Call WRMPS.FsoBegin()
Do while Not Rs.Eof
xChannelName = Rs(0)
xChannelType = Rs(1)
xWM_Title = Rs(2)
xWM_Module = Rs(3)
xChannelDir = Rs(4)
xRe = Rs(5)
xKey = Rs(6)
xChannelLogo = Rs(7)
xMetaKey = Rs(8)
xMetaContent = Rs(9)
xCreateHTML = Rs(10)
xStructureType = Rs(11)
xFileNameType = Rs(12)
xFileExt_Index = Rs(13)
xFileExt_Item = Rs(14)
xID = Rs(15)
Set Rso = Conn.Execute("Select WM_DefaultFolder,WM_DefaultFiles from WM_Module Where WM_ID=" & xWM_Module & "")
If Not Rs.Eof THen
xWM_DefaultFolder = Rso(0)
xWM_DefaultFiles = Rso(1)
End If
Rso.Close
WRMPS.CreFolder "../" & xChannelDir
If xChannelType = 1 And xWM_DefaultFiles <> "" Then
xWM_DefaultFiles = Split(xWM_DefaultFiles, "|")
For xi = 0 To UBound(xWM_DefaultFiles)
WRMPS.FsoDel "File","../" & xChannelDir & "/" & xWM_DefaultFiles(i)
WRMPS.FileCopy "../" & xWM_DefaultFolder & "/" & xWM_DefaultFiles(i), "../" & xChannelDir & "/" & xWM_DefaultFiles(i)
Next
End If
WRMPS.CreateFile "../" & xChannelDir & "/Channel_Config.asp","<" & "%" & vbCrLf & "ChannelID=" & xID & vbCrLf & "ChannelDir=""" & xChannelDir & """" & vbCrLf & "ChannelName=""" & xChannelName & """" & vbCrLf & "Module=" & xWM_Module & vbCrLf & "ChannelTitle=""" & xWM_Title & """" & vbCrLf & "Revert=" & xRe & " '是否启用评论" & vbCrLf & "ChannelLogo = """ & xChannelLogo & """" & vbCrLf & "MetaKey = """ & xMetaKey & """" & vbCrLf & "MetaContent = """ & xMetaContent & """" & vbCrLf & "CreateHTML = " & xCreateHTML & "'生成HTML方式" & vbCrLf & "StructureType = " & xStructureType & "'目录结构方式" & vbCrLf & "FileNameType = " & xFileNameType & "'内容页文件的命名方式" & vbCrLf & "FileExt_Index = """ & xFileExt_Index & """" & vbCrLf & "FileExt_Item = """ & xFileExt_Item & """" & vbCrLf & "Key=" & xKey & vbCrLf & "If Key=0 Then WRMPS.ErrView ""·此频道已禁用"",0" & vbCrLf & "%" & ">"
Rs.MoveNext
Loop
Call WRMPS.FsoEnd()
Rs.Close
Set Rs = Nothing
End Sub
'生成城市JS
Sub AreaSort()
Set Rs = Conn.Execute("Select WM_ID,WM_Name,WM_Eng,WM_Domain from WM_Area Where WM_Key=1 Order By WM_ClassID,WM_Taxis")
Do While Not Rs.EOF
If Int(WR_Area(2)) = 1 Then
If Rs(3) <> "" Then
xUrl = "http://"&Rs(3)
Else
xUrl = Replace(WR_Setting(4),"http://www","http://"&Rs(2))
End If
Else
Select Case Int(WR_Setting(9))
Case 0
xUrl = WR_Setting(3)&"Index.asp?ConversionCity="&Rs(0)
Case 1
xUrl = WR_Setting(3)&"city_"&Rs(0)&"/"
End Select
End If
If xArea = "" Then
xArea = "<a target='_parent' href='"&xUrl&"'>"&Rs(1)&"</a>"
Else
xArea = xArea & " <a target='_parent' href='"&xUrl&"'>"&Rs(1)&"</a>"
End If
Rs.MoveNext
Loop
Rs.close
If Int(WR_Area(2)) = 1 Then
xArea = "<a target='_parent' href='"&WR_Setting(4)&"'><span style='color:red;font-size:14px;font-weight:bold'>"&WR_Area(0)&"</span></a><br>" & xArea
Else
Select Case Int(WR_Setting(9))
Case 0
xArea = "<a target='_parent' href='"&WR_Setting(4)&"Index.asp?ConversionCity=0'><span style='color:red;font-size:14px;font-weight:bold'>"&WR_Area(0)&"</span></a><br>" & xArea
Case 1
xArea = "<a target='_parent' href='"&WR_Setting(4)&"city_0/'><span style='color:red;font-size:14px;font-weight:bold'>"&WR_Area(0)&"</span></a><br>" & xArea
End Select
End If
xAreaAsp = "document.write("""&Replace(xArea,"'","\'")&""")"
xTimer = int(rnd*9998)+1000
xTemp = "<select name='AreaID'>"
xTemp = xTemp & "<option value=''>选择地区</option>"
xSort = ""
Set Rs = Conn.Execute("Select * from WM_Area Order By WM_ClassID,WM_Taxis")
If Rs.EOF Then
xTemp = xTemp & "<option value=''>请先添加城市</option>"
Else
xI = 1
Do While Not Rs.EOF
xSort = xSort & "Arr"&xTimer&"["&xI-1&"] = new Array("""
If Rs("WM_Child") > 0 Then xSort = xSort & "+ " Else xSort = xSort & " "
xSort = xSort & Rs("WM_Name")&""","&Rs("WM_ID")&","&Rs("WM_ParentID")&","&Rs("WM_Child")&","&Rs("WM_Depth")&");" & vbCrLf
MaxID = xI
xI = xI + 1
xTemp = xTemp & "<option value='" & Rs("WM_ID") & "'>"
If Rs("WM_Depth") > 0 Then
For i = 1 To Rs("WM_Depth")
xTemp = xTemp & " "
Next
End If
If Rs("WM_Child") > 0 Then xTemp = xTemp & "+ " Else xTemp = xTemp & "- "
xTemp = xTemp & Rs("WM_Name")
xTemp = xTemp & "</option>"
Rs.MoveNext
Loop
End If
Rs.Close
xTemp = xTemp & "</select>"
Set Rs = Nothing
xTemp = WRMPS.ToJs(xTemp)
xSort = SortJs(xSort,MaxID,xTimer,"AreaID")
Call WRMPS.FsoBegin()
Call WRMPS.CreateFile("../Inc/Js/Area.Js",xAreaAsp)
Call WRMPS.CreateFile("../Inc/Js/AreaSelect.Js",xTemp)
Call WRMPS.CreateFile("../Inc/Js/AreaPost.Js",xSort)
Call WRMPS.FsoEnd()
End Sub
'广告文件
Sub AdsFile(xID)
Set Rs = Server.CreateObject("ADODB.RecordSet")
If xID <> "" Then
Select Case xID
Case 0
xSQL = "Select Top 1 * From WM_ADS Where WM_SkinDir = '"&WR_Setting(5)&"' Order By WM_ID Desc"
Case Else
xSQL = "Select * From WM_ADS Where WM_ID in("&xID&") and WM_SkinDir = '"&WR_Setting(5)&"' Order By WM_ID Desc"
End Select
Else
xSQL = "Select * From WM_ADS Where WM_SkinDir = '"&WR_Setting(5)&"' Order By WM_ID Desc"
End If
Call WRMPS.FsoBegin()
Rs.Open xSQL,Conn,1,1
DO While Not Rs.Eof
Select Case Rs("WM_Type")
Case 1,2,3
Call WRMPS.CreateFile("../Img/AD_"&Rs("WM_AreaID")&"_"&Rs("WM_Big")&Rs("WM_Small")&".asp",WRTemp.CreateAdsJs(Rs("WM_Sort"),Rs("WM_Type"),Rs("WM_Pic"),Rs("WM_Text"),Rs("WM_Url"),Rs("WM_Size"),Rs("WM_OpenType"),Rs("WM_PlayType"),Rs("WM_Begin"),Rs("WM_End")))
Case 4
xCode = Rs("WM_Code")
Call WRMPS.CreateFile("../Img/AD_"&Rs("WM_AreaID")&"_"&Rs("WM_Big")&Rs("WM_Small")&".asp",WRTemp.CreateAdsCodeJs(Rs("WM_PlayType"),Rs("WM_Begin"),Rs("WM_End"),WRMPS.CheckStr(xCode,7)))
Case 5
xCode = Rs("WM_Magic")
If xCode <> "" Then
Call WRMPS.CreateFile("../Img/AD_"&Rs("WM_AreaID")&"_"&Rs("WM_Big")&Rs("WM_Small")&".asp",WRTemp.CreateAdsHDJs(xCode,Rs("WM_ID")))
End If
End Select
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing
Call WRMPS.FsoEnd()
End Sub
'每日帖士
Sub LabelNote()
Dim NoteContent,WM_Note,N,Path
Set Rs = Server.Createobject("adodb.recordset")
Rs.Open"Select WM_Note from WM_Config",Conn,1,1
If Not Rs.Eof Then
WM_Note = Rs(0)
WM_Note = Replace(WM_Note,"""","\""")
If WM_Note <> "" Then
NoteContent = "tips = new Array({$Num});" & vbCrLf
N = 0
If InStr(WM_Note, "§§§") > 0 Then
For i = 0 To UBound(Split(WM_Note, "§§§"))
N = N + 1
NoteContent = NoteContent & "tips[" & i & "] = """ & WRMPS.CheckStr(Split(WM_Note, "§§§")(i),6) & """;" & vbCrLf
Next
Else
N = N + 1
NoteContent = NoteContent & "tips[0] = """ & WRMPS.CheckStr(WM_Note,6) & """;" & vbCrLf
End If
NoteContent = Replace(NoteContent, "{$Num}", N)
NoteContent = NoteContent & "index = Math.floor(Math.random() * tips.length);" & vbCrLf
NoteContent = NoteContent & "document.write(tips[index]);"
End If
End If
Rs.Close
Set Rs = Nothing
If NoteContent <> "" and IsNUll(NoteContent) = False Then
Path = "../Inc/Js/Note.Js"
Call WRMPS.FsoBegin()
Call WRMPS.CreateFile(Path,NoteContent)
Call WRMPS.FsoEnd()
End If
End Sub
'店铺分类
Sub CompanySort()
xTimer = int(rnd*9998)+1000
xTemp = "<select name='ClassID' style='font: 12px Tahoma, Verdana;font-weight: normal'>"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -