⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 function.asp

📁 SK信息采集2.0功能介绍: 1.可针对任何静态网页,动态网页进行采集。包括htm,html,shtml,ASP,ASPX,JSP,PHP等。 2.增加自定文件采集.用户可采集网页中的所有文件.
💻 ASP
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
			Format_Time = sMonth & "-" & sDay & " " & sHour & ":" & sMinute
        Case 4	'2005-10-01
			Format_Time = sYear & "-" & sMonth & "-" & sDay
        Case 5	'2005年10月01日
			Format_Time = sYear & "年" & sMonth & "月" & sDay & "日"
        Case 6	'10-01
			Format_Time = sMonth & "-" & sDay
        Case 7	'20051001234545
			Format_Time = sYear & sMonth & sDay & sHour & sMinute & sSecond		
		Case 8	'20051001234545
			Format_Time = sYear & sMonth & sDay & sHour & sMinute
        Case Else
			Format_Time = Tt
        End Select
    End Function
'===================================================
'小金通用采集系统
'函数名：MakeRandom
'作  用：生成指定位数的随机数
'参  数： maxLen  ----生成位数
'返回值：成功返回随机数
'===================================================
	Function MakeRandom(ByVal maxLen)
	
	  Dim strNewPass
	  Dim whatsNext, upper, lower, intCounter
	  Randomize
	
	 For intCounter = 1 To maxLen
	   upper = 57
	   lower = 48
	   strNewPass = strNewPass & Chr(Int((upper - lower + 1) * Rnd + lower))
	 Next
	   MakeRandom = strNewPass
	End Function
'===================================================
'小金通用采集系统
'过程名：km_template()
'作  用：显示栏目
'===================================================
sub km_template()
	 set rs= ConnItem.execute("Select * From ks_template")
	 if rs.eof then
	 	response.write "暂无分类"
	 else 
	
	 	Response.Write "<table width=100% border=0 cellspacing=0 cellpadding=0>"
		Response.Write "<tr><td width='40%'>ID号</td><td width='60%'>名子</td></tr>"
		do while not rs.eof
		 if rs("ChannelID")<>0 then		
			Response.Write "<tr height='22'><td><input name='km_asdfsf' type='text'value="&rs("TemplateID")&" size='15' /></td><td>&nbsp;"&rs("TemplateName")&"--模板</td></tr>"
		  end if
		rs.movenext
		loop
		Response.Write "</table>"
	 end if
	 rs.close
	 set rs=nothing
end sub	
'==================================================
'小金通用采集系统
'过程名：km_class()
'作  用：显示输出目标栏目
'==================================================
sub km_class()
	 set rs= ConnItem.execute("Select * From ks_class")
	 if rs.eof then
	 	response.write "暂无分类"
	 else 
	
	 	Response.Write "<table width=100% border=0 cellspacing=0 cellpadding=0>"
		Response.Write "<tr><td width='40%'>ID号</td><td width='60%'>名子</td></tr>"
		do while not rs.eof
		 if rs("tn")=0 then
		Response.Write "<tr height='22'><td><font color='#FF0000'>"&rs("id")&"</font></td><td><font color='#FF0000'>&nbsp;"&rs("FolderName")&"--频道</font></td></tr>"
			else
			Response.Write "<tr height='22'><td><input name='km_asdfsf' type='text'value="&rs("id")&" size='15' /></td><td>&nbsp;"&rs("FolderName")&"--栏目</td></tr>"
		  end if
		rs.movenext
		loop
		Response.Write "</table>"
	 end if
	 rs.close
	 set rs=nothing
end sub	 

'==================================================
'小金通用采集系统
'函数名：sk_dir_get()
'作  用：读取目录
'==================================================
Function sk_dir_get(ClassID,lx)
Dim strInstallDir,CacheTemp,rs,strtemp,strChannelDir,Arr_Path,i,PathTemp,SaveTf
strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
'strtemp = strtemp & strInstallDir 

set rs = ConnItem.execute("select top 1 ArticleDir,flashdir,photoDir from SK_Config")
if lx =1 then strtemp = strtemp & rs("ArticleDir")
if lx =2 then strtemp = strtemp  & rs("flashdir")
if lx =3 then strtemp = strtemp  & rs("photoDir") 
rs.close
set rs = ConnItem.execute("select top 1 * from SK_Class where ClassID=" & ClassID)
strtemp = strtemp & rs("ClassDir") &"/"
sk_dir_get = strtemp
rs.close
set rs=nothing
end function
'==================================================
'小金通用采集系统
'函数名：sk_dir()
'PicUrls=远程文件地址
'作  用：建立保存目录
'==================================================
Function sk_dir(ClassID,lx,FileUrl)
Dim strInstallDir,CacheTemp,rs,strtemp,strChannelDir,Arr_Path,i,PathTemp,SaveTf
strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
strtemp = strtemp & strInstallDir 

set rs = ConnItem.execute("select top 1 ArticleDir,flashdir,photoDir from SK_Config")
if lx =1 then strtemp = strtemp & rs("ArticleDir")
if lx =2 then strtemp = strtemp  & rs("flashdir")
if lx =3 then strtemp = strtemp  & rs("photoDir") 
rs.close
set rs = ConnItem.execute("select top 1 * from SK_Class where ClassID=" & ClassID)
strtemp = strtemp & rs("ClassDir") &"/"
Call SaveRemoteFile(strtemp,FileUrl)'保存远程文件
sk_dir = strtemp
rs.close
set rs=nothing
end function
'==================================================
'小金通用采集系统
'函数名：Sk_GetSaveDir()
'lx=类型1=新闻 2=flash 3=图片 4=音乐 5=软件 6=自定
'作  用：读取文件保存目录设置
'==================================================
Function Sk_GetSaveDir(lx)
Dim strInstallDir,CacheTemp,rs,strtemp,strChannelDir,Arr_Path,Tempi,PathTemp,SaveTf,TempUrlArray,Ranfilestr
strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
set rs = ConnItem.execute("select top 1 ArticleDir,flashdir,photoDir,DownDir,AllDir from SK_Config")
if lx =1 then strtemp = strtemp  & rs("ArticleDir")
if lx =2 then strtemp = strtemp  & rs("flashdir")
if lx =3 then strtemp = strtemp  & rs("photoDir")
if lx =5 then strtemp = strtemp  & rs("DownDir")
if lx =6 then strtemp = strtemp  & rs("AllDir")
Sk_GetSaveDir = strtemp & SaveFileUrl
rs.close
set rs=nothing
end function
'==================================================
'小金通用采集系统
'函数名：Sk_SaveFile()
'PicUrls=远程文件地址
'作  用：保存远程文件替换地址
'==================================================
Function Sk_SaveFile(lx,FileUrl)
Dim strInstallDir,CacheTemp,rs,strtemp,strChannelDir,Arr_Path,Tempi,PathTemp,SaveTf,TempUrlArray,Ranfilestr,Ranfilestr1
strInstallDir=trim(request.ServerVariables("SCRIPT_NAME"))
strInstallDir=left(strInstallDir,instrrev(lcase(strInstallDir),"/")-1)
'strtemp = strtemp & strInstallDir 
FileUrl=replace(replace(FileUrl,"""","")," ","")
set rs = ConnItem.execute("select top 1 ArticleDir,flashdir,photoDir,AllDir from SK_Config")
if lx =1 then strtemp = strtemp & rs("ArticleDir")
if lx =2 then strtemp = strtemp  & rs("flashdir")
if lx =3 then strtemp = strtemp  & rs("photoDir")
if lx =6 then strtemp = strtemp  & rs("AllDir")
strtemp = strtemp & SaveFileUrl
      Arr_Path=Split(strtemp,"/")
      PathTemp=""
      For Tempi=0 To Ubound(Arr_Path)
         If Tempi=0 Then
            PathTemp=Arr_Path(0) & "/"
         ElseIf Tempi=Ubound(Arr_Path) Then
            Exit For
         Else
            PathTemp=PathTemp & Arr_Path(Tempi) & "/"
         End If
         If CheckDir(PathTemp)=False Then
            If MakeNewsDir(PathTemp)=False Then
               SaveTf=False
               Exit For
            End If
         End If
      Next
TempUrlArray=Split(FileUrl,"/")  
Ranfilestr=GetFileID(strtemp,TempUrlArray(Ubound(TempUrlArray)),3)'生成文件名
'Call SaveRemoteFile(Ranfilestr,FileUrl)'保存远程文件
If SaveRemoteFile(Ranfilestr,FileUrl)<>False then'保存远程文件
Ranfilestr1=Ranfilestr
if Thumb_WaterMark=1 then call SKThumb.AddWaterMark(Ranfilestr)'水印
Sk_SaveFile = Ranfilestr1
Else
Sk_SaveFile = False
End if
rs.close
set rs=nothing
end function
'==================================================
'小金通用采集系统
'过程名：SaveFile()
'作  用：远程保存-
'==================================================
Sub SaveFile()
dim Savelx,ChannelID,ClassID,id,FoundErr,ErrMsg,sql,rs,strChannelDir,pici,picii,SaveErr,TempArray,i,lx,n
Savelx=Request("Savelx")
	ChannelID=Request("ChannelID")
	ClassID=Request("ClassID")
	lx=0
		If ChannelID="" or ChannelID=0 Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>未指定频道</li>"
		Else
		   ChannelID=Clng(ChannelID)
		End If
		If ClassID="" or ClassID = 0  Then
		   FoundErr=True
		   ErrMsg=ErrMsg & "<br><li>未指定栏目</li>"
		Else
		   ClassID=CLng(ClassID)
		  set rs=ConnItem.execute("select * From SK_Class Where ClassID=" & ClassID)
		   If rs.bof and rs.eof then
				 FoundErr=True
				 ErrMsg=ErrMsg & "<br><li>找不到指定的栏目</li>"
			End If
			strChannelDir=rs("ClassDir")
			rs.close
			Set rs=Nothing


		End if
		if FoundErr=True then'错误信息
			Response.Write ErrMsg
		call Main()	
		else
		if ConnItem.execute("select count(ArticleID) from PE_Article where ClassID="& ClassID & " and Passed=true and SaveFile<>True")(0) >0 then lx=1
		if ConnItem.execute("select count(ID) from SK_Flash where TID="& ClassID &" and Verific=1 and SaveFile=0")(0) >0 then lx=2
		if ConnItem.execute("select count(ID) from sk_photo where TID="& ClassID &" and Verific=1 and SaveFile=0" )(0) >0 then lx=3
		if lx=0 then
				Response.Write "没找到所要的数据.检查是否审合 或 你以经保存过了"
		else
		
			Response.Redirect "savefile.asp?lx="& lx &"&ClassID="& ClassID 
		end if
			call Main()	
		end if
end sub
'--------------------------SQL函数集------------------------
'===================================================
'小金通用采集系统
'作  用：SQL计算记录集总数
'===================================================
'==================================================
'过程名：Admin_ShowChannel_Name
'作  用：显示频道名称
'参  数：ChannelID ------频道ID
'==================================================
Sub Admin_ShowChannel_Name(ChannelID)   
   Dim Sqlc,Rsc,TempStr
   ChannelID=Clng(ChannelID)
   Sqlc ="select top 1 ChannelName from sk_Channel Where ChannelID=" & ChannelID   
   Set Rsc=server.CreateObject("adodb.recordset")   
   Rsc.open Sqlc,ConnItem,1,1   
   If Rsc.Eof and Rsc.Bof then   
      TempStr="无指定频道"   
   Else   
      TempStr=Rsc("ChannelName")
   End if   
   Rsc.Close   
   Set Rsc=Nothing
   response.write TempStr   
End Sub  

'==================================================
'过程名：Admin_ShowChannel_Option
'作  用：显示频道选项
'参  数：ChannelID ------频道ID
'==================================================
'--ipq改
Sub Admin_ShowChannel_Option(ChannelID)   
   Dim Sqlc,Rsc,ChannelName,TempStr
   ChannelID=Clng(ChannelID)
   Sqlc ="select ChannelID,ChannelName from sk_Channel where ModuleType=1 order by ChannelID asc"   
   Set Rsc=server.CreateObject("adodb.recordset")   
   Rsc.Open Sqlc,ConnItem,1,1  
   TempStr="<option value=""0"">请选择频道</option>"    
   If Rsc.Eof and Rsc.Bof Then
      TempStr=TempStr & "<option value=""0"">请添加频道</option>"   
   Else
      Do while not Rsc.Eof   
         TempStr=TempStr & "<option value=" & """" & Rsc("ChannelID") & """" & "" 
         If ChannelID=Rsc("ChannelID") Then
            TempStr=TempStr & "selected"
			End If
		 TempStr=TempStr & ">" & Rsc("ChannelName")
         TempStr=TempStr & "</option>"  
      Rsc.Movenext   
      Loop   
   End if
   Rsc.Close   
   Set Rsc=Nothing   
   Response.Write TempStr   
End sub 
'--ipq改
Sub Admin_ShowChannel_Opin(ChannelID)   
   Dim Sqlc,Rsc,ChannelName,TempStr
   ChannelID=Clng(ChannelID)
   Sqlc ="select ChannelID,ChannelName from sk_Channel where ModuleType=1 order by ChannelID asc"   
   Set Rsc=server.CreateObject("adodb.recordset")   
   Rsc.Open Sqlc,ConnItem,1,1  
   TempStr="<option value=""0"" selected>请选择频道</option>"    
   If Rsc.Eof and Rsc.Bof Then
      TempStr=TempStr & "<option value=""0"">请添加频道</option>"   
   Else
      Do while not Rsc.Eof   
         TempStr=TempStr & "<option value=" & """" & Rsc("ChannelID") & """" & "" 
         If ChannelID=Rsc("ChannelID") Then
            TempStr=TempStr & ""
         End If
         TempStr=TempStr & ">" & Rsc("ChannelName")
         TempStr=TempStr & "</option>"  
      Rsc.Movenext   
      Loop   
   End if
   Rsc.Close   
   Set Rsc=Nothing   
   Response.Write TempStr   
End sub 

'==================================================
'过程名：Admin_ShowClass_Name
'作  用：显示栏目名称
'参  数：ChannelID ------频道ID
'参  数：ClassID ------栏目ID
'==================================================
Sub Admin_ShowClass_Name(ChannelID,ClassID)   
   Dim SqlC,RsC,TempStr
   Sqlc ="Select top 1 FolderName from ks_Class Where ID='"& ClassID &"'"   
   Set RsC=server.CreateObject("adodb.recordset")   
   RsC.Open SqlC,conn,1,1   
   If RsC.Eof And RsC.Bof Then   
      TempStr="无指定栏目"   
   Else   
      TempStr=RsC("FolderName")
   End if   
   RsC.Close   
   Set RsC=Nothing
   Response.Write TempStr   
End Sub  

'==================================================
'过程名：Admin_ShowSpecial_Name
'作  用：显示专题名称
'参  数：ChannelID ------频道ID
'参  数：SpecialID ------专题ID
'==================================================
Sub Admin_ShowSpecial_Name(ChannelID,SpecialID)   
   Dim Sqlc,Rsc,TempStr
   ChannelID=Clng(ChannelID)
   SpecialID=Clng(SpecialID)
   Sqlc ="select top 1 SpecialName from SK_Special Where ChannelID=" & ChannelID & " and SpecialID=" & SpecialID   
   Set Rsc=server.CreateObject("adodb.recordset")
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -