function.asp

SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.

<%
Public IsAdmin,Admin_name,Admin_type,P_Admin
'管理员验证
Sub Admin()
		if request.Cookies(Site)("IsAdmin")=empty then response.Cookies(Site)("IsAdmin")=0
		if request.Cookies(Site)("IsAdmin")=1 then
			dim sql,rs
			sql = "select * from admin where username='"&request.Cookies(Site)("Admin_name")&"'"
			set rs = ConnItem.Execute(sql)
			if rs.eof and rs.bof then
				IsAdmin = False
				Admin_name=Empty
				Admin_type=Empty
			else
				IsAdmin=true
				Admin_name=request.Cookies(Site)("Admin_name")
				Admin_type=request.Cookies(Site)("Admin_type")
				response.Cookies(Site).Expires=DateAdd("s",3600,Now())
			end if
		else
			IsAdmin=false
			Admin_name=Empty
			Admin_type=Empty
		end if
End Sub	
'*************************************************************************************
	'函数名: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"
				Set Rs = Server.CreateObject("adodb.recordset")
				Rs.Open SQL, ConnItem, 1,3
				rs.addnew
				rs("ChannelID")=0
				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")
				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")
			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"
			Set Rs = Server.CreateObject("adodb.recordset")
			Rs.Open SQL, ConnItem, 1,3
			rs.addnew
			rs("ChannelID")=0
			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")
			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
'作  用：显示频道栏目分类
'==================================================	
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 
'**************************************************
'函数名：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 & "&nbsp;&nbsp;│"
		  ElseIf k = TJ - 1 Then
			If Num = Total Then
				 SpaceStr = SpaceStr & "&nbsp;&nbsp;└ "
			Else
				 SpaceStr = SpaceStr & "&nbsp;&nbsp;├ "
			End If
		  Else
		   SpaceStr = SpaceStr & "&nbsp;&nbsp;│"
		  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
		RSC.Close:Set RSC = Nothing
	End Function
	'*************************************************************************************
	'函数名:GetInfoID
	'作  用:生成文章,图片或下载等的唯一ID
	'参  数:ChannelID--频道ID
	'*************************************************************************************
	Function GetInfoID(ChannelID)
	   On Error Resume Next
	   Dim RSC, TableNameStr
       Set RSC=Server.CreateObject("ADODB.RECORDSET")
	   Select Case ChannelID
		 Case 1
		    TableNameStr = "Select ArticleID From SK_Article Where ArticleID='"
		 Case 2
		    TableNameStr = "Select FlashID From sk_Flash Where FlashID='"
		 Case 3
			TableNameStr = "Select PicID From sk_Photo Where PicID='"
	   End Select
	   Do While True
		 GetInfoID = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Now(), "-", ""), " ", ""), ":", ""), "PM", ""), "AM", ""), "上午", ""), "下午", "") & MakeRandom(3)
			RSC.Open TableNameStr & GetInfoID & "'", ConnItem, 1, 1
				If RSC.EOF And RSC.BOF Then
					Exit Do
				End If
	   Loop
		RSC.Close
		Set RSC = Nothing
	End Function
'=============================================================================
'参  数： Tvar  ----日期   sType---选择显示类型
'返回值：成功返回随机数
'作  用：时间格式处理, 
'==============================================================================
	Public Function Format_Time(Tvar,sType)
        dim Tt,sYear,sMonth,sDay,sHour,sMinute,sSecond
        If Not IsDate(Tvar) Then Format_Time = "" : Exit Function
        Tt			= Tvar
        sYear		= Year(Tt)
        sMonth		= Right("0" & Month(Tt),2)
		sDay		= Right("0" & Day(Tt),2)
		sHour		= Right("0" & Hour(Tt),2)
		sMinute		= Right("0" & Minute(Tt),2)
		sSecond		= Right("0" & Second(Tt),2)
        Select Case sType
        Case 1	'2005-10-01 23:45:45
			Format_Time = sYear & "-" & sMonth & "-" & sDay & " " & sHour & ":" & sMinute & ":" & sSecond
        Case 2	'年-月-日 时:分:秒
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日 " & sHour & "时" & sMinute & "分" & sSecond & "秒"
        Case 3	'10-01 23:45