?? function.asp
字號:
<%
'*************************************************************************************
'函數名:SK_Class_Channel_add
'作 用:頻道管理--增加頻道
'*************************************************************************************
Function SK_Class_Channel_add(className,ParentPath)
dim sql,Ordermax
if className="" or ParentPath="" then
ErrMsg="<font color=red>請填寫完整！</font>"
Else
set rs=ConnItem.execute("select top 1 OrderID from SK_class order by OrderID desc")
if rs.eof then
Ordermax=0
Else
Ordermax=rs(0)
end if
rs.close
sql = "select top 1 * from SK_class order by ClassID desc"
Set Rs = Server.CreateObject("adodb.recordset")
Rs.Open SQL, ConnItem, 1,3
rs.addnew
if Colleclx<>0 then
rs("ChannelID")=Colleclx
Else
rs("ChannelID")=0
end if
Rs("className")=className
rs("ParentPath")=ParentPath
rs("depth")=0
rs("OrderID")=Ordermax+1
rs.update
rs.close
set rs=nothing
response.redirect("sk_class.asp?Colleclx="& Colleclx)
response.end
end if
SK_Class_Channel_add=ErrMsg
End Function
'*************************************************************************************
'函數名:SK_Class_Channel_edit
'作 用:頻道管理--修改頻道
'*************************************************************************************
Function SK_Class_Channel_edit(className,ParentPath,classID)
dim sql
if className="" or ParentPath="" then
ErrMsg="<font color=red>請填寫完整！</font>"
Else
sql = "select top 1 * from SK_class where classID=" & classID
Set Rs = Server.CreateObject("adodb.recordset")
Rs.Open SQL, ConnItem, 1,3
Rs("className")=className
rs("ParentPath")=ParentPath
rs.update
set rs=nothing
response.redirect("sk_class.asp?Colleclx="& Colleclx)
response.end
end if
SK_Class_Channel_edit=ErrMsg
End Function
'*************************************************************************************
'函數名:SK_Class_small_add
'作 用:頻道管理--增加欄目
'*************************************************************************************
Function SK_Class_small_add(ClassName,ParentPath,ParentID)
dim sql,Ordermax
if ClassName="" or ParentPath="" then
'Response.Write ClassName & ParentPath & ("asdfsadf") & ParentID
ErrMsg="<font color=red>請填寫完整！</font>"
Else
set rs=ConnItem.execute("select top 1 * from SK_class where classID=" & ParentID)
Ordermax=rs("OrderID")+1
depth=rs("depth")+1
Set Rs=ConnItem.execute("select * from SK_class where OrderID >=" & Ordermax)
while not rs.eof
Response.Write rs("classid")
ConnItem.execute("update SK_class set OrderID="& rs("OrderID")+1 &" where classid="& rs("classid") )
rs.movenext
wend
sql = "select top 1 * from SK_class order by ClassID desc"
Set Rs = Server.CreateObject("adodb.recordset")
Rs.Open SQL, ConnItem, 1,3
rs.addnew
if Colleclx<>0 then
rs("ChannelID")=Colleclx
Else
rs("ChannelID")=0
end if
Rs("className")=className
rs("ParentPath")=ParentPath
rs("ParentID")=ParentID
rs("OrderID")=Ordermax
rs("depth")=depth
rs.update
set rs=nothing
response.redirect("sk_class.asp?Colleclx="& Colleclx)
response.end
if ConnItem.execute("select count(ClassID) from sk_Class where ClassDir='"& ClassDir &"'")(0)>0 then
ErrMsg="<font color=red>目錄以存在！請用別的目錄</font>"
Else
sql = "insert into sk_Class (ChannelID,ClassName,Readme,ClassDir,ParentPath) values ('" & ChannelID & "','" & ClassName &"','" & Readme &"','" & ClassDir &"','" & ClassDir &"')"
ConnItem.execute(sql)
response.redirect("sk_smallclass.asp?ChannelID=" & ChannelID)
response.end
end if
end if
SK_Class_small_add=ErrMsg
End Function
'==================================================
'過程名：SK_Showclass_d
'作 用：顯示頻道欄目分類單機版
'==================================================
sub SK_Showclass_d(ClassID,ChannelID)
if ChannelID<>0 And ChannelID<>"" then
set Rs=connitem.execute("select * from SK_class where ChannelID="& ChannelID &" order by OrderID")
if rs.eof then Response.Write "<option value='0'> 你沒設分類</option>"
while not rs.eof
Response.Write "<option value="& rs("classid")
if Cstr(rs("classid")) = ClassID then Response.Write " selected"
Response.Write ">"
If Rs("depth") = 1 Then Response.Write " <font color=""#666666"">├</font>"
If Rs("depth") > 1 Then
For i = 2 To Rs("depth")
Response.Write " <font color=""#666666"">│</font>"
Next
Response.Write " <font color=""#666666"">├</font> "
End If
If Rs("depth") = 0 Then Response.Write ("<b>")
Response.Write rs("className")
If Rs("depth") = 0 Then Response.Write ("</b>")
Response.Write "</option>"
rs.movenext
wend
rs.close
set rs=nothing
End if
end sub
'==================================================
'過程名：SK_Showclass
'作 用：顯示頻道欄目分類
'==================================================
sub SK_Showclass(FolderID,ChannelID)
if ChannelID=0 then
Response.Write"<option selected value='555555555'>5555555555555555</option>"
Else
Dim RS,FolderName,TreeStr,ID
Set RS=Server.CreateObject("ADODB.Recordset")
FolderID = Trim(FolderID)
If Not IsNumeric(ChannelID) Then Return
RS.Open ("select ID,FolderName from KS_Class Where ChannelID=" & ChannelID & " AND tj=1 Order BY FolderOrder ASC"),conn, 1, 1
Do While Not RS.EOF
ID = Trim(RS(0))
FolderName = Trim(RS(1))
If FolderID = ID Then
TreeStr = TreeStr & "<option selected value='" & ID & "'>" & FolderName & "</option>"
Else
TreeStr = TreeStr & "<option value='" & ID & "'>" & FolderName & " </option>"
End If
TreeStr = TreeStr & ReturnSubList(ID, FolderID)
RS.MoveNext
Loop
RS.Close:Set RS = Nothing
if TreeStr="" then
Response.Write "<option value='0'> 你沒設分類 </option>"
Else
Response.Write TreeStr
end if
'KSCache.add ReturnTree,dateadd("n",1000000,now)
end if
end sub
'**************************************************
'函數名：ReturnSubClass
'作 用：查找并返子批量采集項目ID。
'參 數：ParentID ----父節點ID, K ----選擇項ID
'返回值：子樹
'**************************************************
Public Function ReturnSubClass(ParentID,k)
Dim SubRS, SpaceStr, Num,FolderName,ID,RS
'-----------------------------------------
IF k=1 then
Set RS = Server.CreateObject("ADODB.RECORDSET")
RS.Open ("Select * From Item Where ClassID ='"& ParentID &"' order by ItemID DESC" ), connItem, 1, 1
Do while Not Rs.Eof
SpaceStr= SpaceStr & RS("ItemID") & ","
Rs.Movenext
Loop
Rs.Close : Set Rs=Nothing
k=0
End If
'-----------------------------------------
Set SubRS = Server.CreateObject("ADODB.RECORDSET")
SubRS.Open ("Select ClassID,ClassName,ParentID from SK_Class Where ParentID =" & ParentID & " "), connItem, 1, 1
Do While Not SubRS.EOF
ID = Trim(SubRS(0))
'-------------------------------------
Set RS = Server.CreateObject("ADODB.RECORDSET")
RS.Open ("Select * From Item Where ClassID ='"& ID &"' order by ItemID DESC" ), connItem, 1, 1
Do while Not Rs.Eof
SpaceStr= SpaceStr & RS("ItemID") & ","
Rs.Movenext
Loop
Rs.Close : Set Rs=Nothing
'-------------------------------------
SpaceStr= SpaceStr & ReturnSubClass(ID,k)
SubRS.MoveNext
Loop
SubRS.Close : Set SubRS=Nothing
ReturnSubClass=SpaceStr
End Function
'**************************************************
'函數名：ReturnSubList
'作 用：查找并返子樹數據。
'參 數：ParentID ----父節點ID, FolderID ----選擇項ID
'返回值：子樹
'**************************************************
Public Function ReturnSubList(ParentID, FolderID)
Dim SubTypeList, SubRS, SpaceStr, k, Total, Num,FolderName, ID,TJ
Set SubRS = Server.CreateObject("ADODB.RECORDSET")
SubRS.Open ("Select count(ID) AS total from KS_Class Where TN='" & ParentID & "'"), conn, 1, 1
Total = SubRS("Total")
SubRS.Close
SubRS.Open ("Select ID,FolderName,TJ from KS_Class Where TN='" & ParentID & "' Order BY FolderOrder ASC"), conn, 1, 1
Num = 0
Do While Not SubRS.EOF
Num = Num + 1
SpaceStr = ""
TJ = CInt(SubRS(2))
For k = 1 To TJ - 1
If k = 1 And k <> TJ - 1 Then
SpaceStr = SpaceStr & " │"
ElseIf k = TJ - 1 Then
If Num = Total Then
SpaceStr = SpaceStr & " └ "
Else
SpaceStr = SpaceStr & " ├ "
End If
Else
SpaceStr = SpaceStr & " │"
End If
Next
ID = Trim(SubRS(0))
FolderName = Trim(SubRS(1))
If FolderID = ID Then
SubTypeList = SubTypeList & "<option selected value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
Else
SubTypeList = SubTypeList & "<option value='" & ID & "'>" & SpaceStr & FolderName & "</option>"
End If
SubTypeList = SubTypeList & ReturnSubList(ID, FolderID)
SubRS.MoveNext
Loop
SubRS.Close:Set SubRS = Nothing
ReturnSubList = SubTypeList
End Function
'*************************************************************************************
'函數名:GetFileID
'作 用:生成文件ID號,6位隨機+文件
'lx=采集類型
'參 數:無
'*************************************************************************************
Function GetFileID(dir,filename,lx)
Dim RSC,TempUrlArray
Set RSC=Server.CreateObject("ADODB.RECORDSET")
'6位隨機+文件
Do While True
GetFileID = dir + MakeRandom(6) + filename
select case lx
case 1
'RSC.Open "Select all from sk_photo Where PicUrls='" & GetFileID & "'", ConnItem, 1, 1
case 2
'RSC.Open "Select PicUrls from sk_photo Where PicUrls='" & GetFileID & "'", ConnItem, 1, 1
case 3
RSC.Open "Select PicUrls from sk_photo Where PicUrls LIKE '%" & GetFileID & "%'", ConnItem, 1, 1
case 6
RSC.Open "Select FileUrls from sk_all Where PicUrls LIKE '%" & GetFileID & "%'", ConnItem, 1, 1
end select
If RSC.EOF And RSC.BOF Then
Exit Do
End If
Loop
RSC.Close
Set RSC = Nothing
End Function
'*************************************************************************************
'函數名:GetClassID
'作 用:生成新目錄或頻道的ID號
'參 數:無
'*************************************************************************************
Function GetClassID()
Dim RSC
Set RSC=Server.CreateObject("ADODB.RECORDSET")
'生成目錄ID 年+10位隨機
Do While True
GetClassID = Year(Now()) & MakeRandom(10)
RSC.Open "Select ID from KS_Class Where ID='" & GetClassID & "'", ConnItem, 1, 1
If RSC.EOF And RSC.BOF Then
Exit Do
End If
Loop
RSC.Close
Set RSC = Nothing
End Function
'**************************************************
'函數名：GetFileName
'作 用：構造文件名。
'參 數：ArticleFsoType ----生成類型
' addDate -----添加時間,GetFileNameType--擴展名
'**************************************************
Public Function GetFileName(ArticleFsoType, AddDate, GetFileNameType)
Dim N
Randomize
Select Case ArticleFsoType
Case 1
GetFileName = Year(AddDate) & "/" & Month(AddDate) & "-" & Day(AddDate) & "/" & GetFileNameType '年/月-日/隨機數+擴展名
Case 2
GetFileName = Year(AddDate) & "/" & Month(AddDate) & "/" & Day(AddDate) & "/" & GetFileNameType '年/月/日/隨機數+擴展名
Case 3
GetFileName = Year(AddDate) & "-" & Month(AddDate) & "-" & Day(AddDate) & "/" & GetFileNameType '年-月-日/隨機數+擴展名
Case 4
GetFileName = Year(AddDate) & "/" & Month(AddDate) & "/" & GetFileNameType '年/月/隨機數+擴展名
Case 5
GetFileName = Year(AddDate) & "-" & Month(AddDate) & "/" & GetFileNameType '年-月/隨機數+擴展名
Case 6
GetFileName = Year(AddDate) & Month(AddDate) & Day(AddDate) & "/" & GetFileNameType '年月日/隨機數+擴展名
Case 7
GetFileName = Year(AddDate) & "/" & GetFileNameType '年/隨機數+擴展名
Case 8
GetFileName = Year(AddDate) & Month(AddDate) & Day(AddDate) & GetFileNameType '年+月+日+隨機數+擴展名
Case 9
GetFileName = GetFileNameType
Case 10
GetFileName = GetFileNameType '隨機字符
Case Else
GetFileName = Year(AddDate) & Month(AddDate) & Day(AddDate) & GetFileNameType '12位隨機數+擴展名
End Select
End Function
'*************************************************************************************
'函數名:GetInfoID_CMS
'作 用:生成文章,圖片或下載等的唯一ID
'參 數:ChannelID--頻道ID
'*************************************************************************************
Public Function GetInfoID_CMS(ChannelID)
On Error Resume Next
Dim RSC, TableNameStr
Set RSC=Server.CreateObject("ADODB.RECORDSET")
Select Case ChannelID
Case 1
TableNameStr = "Select NewsID From KS_Article Where NewsID='"
Case 2
TableNameStr = "Select PicID From KS_Photo Where PicID='"
Case 3
TableNameStr = "Select DownID From KS_DownLoad Where DownID='"
Case 4
TableNameStr = "Select FlashID From KS_Flash Where FlashID='"
End Select
Do While True
GetInfoID_CMS = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Now(), "-", ""), " ", ""), ":", ""), "PM", ""), "AM", ""), "上午", ""), "下午", "") & MakeRandom(3)
RSC.Open TableNameStr & GetInfoID_CMS & "'", conn, 1, 1
If RSC.EOF And RSC.BOF Then Exit Do
Loop
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -