蝙蝠岛资源网 Design By www.hbtsch.com
复制代码 代码如下:
<%
On Error Resume Next
Const uploadPath = "/uploads/" '文件存放路径
Const allowFileExt = "jpg,wma,swf,gif" '允许被采集的文件类型
'Const allowFileSize = "200"
Function getFile(url)
If url = "" Then
Exit Function
Else
url = Trim(url)
End If
'获取文件
fileExt = Lcase(Mid(url,Instrrev(url, ".")+1)) '文件类型
fileName = Lcase(Mid(url,Instrrev(url, "/")+1,Instrrev(url, ".")-Instrrev(url, "/")-1)) '无文件类型的文件名
newFilePath = getNow("Date") & "_" & Replace(FormatDateTime(Now(),3),":","") & "_" & cleanFileName(fileName) & "." & fileExt
if Instr(","&Lcase(allowFileExt)&",",","&fileExt&",") = 0 Then
getFile = "文件类型不允许"
Exit Function
End If
Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "get",url,false
xmlhttp.send
'While xmlhttp.readyState <> 4
' xmlhttp.waitForResponse 1000
'Wend
If xmlhttp.status <> 200 Then
getFile="获取文件出错"
Exit Function
Else
Set folder=Server.CreateObject("Scripting.FileSystemObject")
Dim folderName
folderName = getNow("Year")&getNow("Month") '文件夹
If folder.FolderExists(Server.MapPath(uploadPath))=False Then
folder.CreateFolder Server.MapPath(uploadPath)
End If
If folder.FolderExists(Server.MapPath(uploadPath & folderName))=False Then
folder.CreateFolder Server.MapPath(uploadPath & folderName)
End If
Set folder=Nothing
file=xmlhttp.ResponseBody
If lenb(file) > allowFileSize Then
getFile = "文件太大,不能保存!"
Exit Function
Else
Set objAdostream=Server.Createobject("ADODB.Str"&"eam")
objAdostream.Open()
objAdostream.Type=1
objAdostream.Write(file)
objAdostream.SaveToFile(Server.Mappath(uploadPath & folderName &"/" & newFilePath))
objAdostream.SetEOS
Set objAdostream=Nothing
getFile= "<a href="""&uploadPath & folderName &"/" & newFilePath&""" target=""_balnk"">采集成功</a>"
End If
End If
Set xmlhttp=Nothing
End Function
%>
<script runat="server" language="jscript">
function cleanFileName(str){
str = str.replace(/[^_\.a-zA-Z\d]/ig,"");
str = str.replace(/^[\/\.]+/,"");
return str;
}
function getNow(n)
{
d = new Date();
switch (n)
{
case "Year":
return d.getYear();
case "Month":
return (d.getMonth() + 1);
case "Date":
return d.getDate();
}
}
</script>
<%if request("do")="getfile" and request("file") <> "" then
response.write(getFile(request("file")))
else%>
<form id="gform" method="post" action="?do=getfile" style="display: inline">
<input name="file" type="input" style="font-size:12px;" size="40" value="http://blog.xiaobin.net/uploads/200512/08_093616_01.gif">
<input type="Submit" name="Submit" value="采集 " class="button">
</form>
<%end if%>
<%
On Error Resume Next
Const uploadPath = "/uploads/" '文件存放路径
Const allowFileExt = "jpg,wma,swf,gif" '允许被采集的文件类型
'Const allowFileSize = "200"
Function getFile(url)
If url = "" Then
Exit Function
Else
url = Trim(url)
End If
'获取文件
fileExt = Lcase(Mid(url,Instrrev(url, ".")+1)) '文件类型
fileName = Lcase(Mid(url,Instrrev(url, "/")+1,Instrrev(url, ".")-Instrrev(url, "/")-1)) '无文件类型的文件名
newFilePath = getNow("Date") & "_" & Replace(FormatDateTime(Now(),3),":","") & "_" & cleanFileName(fileName) & "." & fileExt
if Instr(","&Lcase(allowFileExt)&",",","&fileExt&",") = 0 Then
getFile = "文件类型不允许"
Exit Function
End If
Set xmlhttp = Server.CreateObject("Microsoft.XMLHTTP")
xmlhttp.open "get",url,false
xmlhttp.send
'While xmlhttp.readyState <> 4
' xmlhttp.waitForResponse 1000
'Wend
If xmlhttp.status <> 200 Then
getFile="获取文件出错"
Exit Function
Else
Set folder=Server.CreateObject("Scripting.FileSystemObject")
Dim folderName
folderName = getNow("Year")&getNow("Month") '文件夹
If folder.FolderExists(Server.MapPath(uploadPath))=False Then
folder.CreateFolder Server.MapPath(uploadPath)
End If
If folder.FolderExists(Server.MapPath(uploadPath & folderName))=False Then
folder.CreateFolder Server.MapPath(uploadPath & folderName)
End If
Set folder=Nothing
file=xmlhttp.ResponseBody
If lenb(file) > allowFileSize Then
getFile = "文件太大,不能保存!"
Exit Function
Else
Set objAdostream=Server.Createobject("ADODB.Str"&"eam")
objAdostream.Open()
objAdostream.Type=1
objAdostream.Write(file)
objAdostream.SaveToFile(Server.Mappath(uploadPath & folderName &"/" & newFilePath))
objAdostream.SetEOS
Set objAdostream=Nothing
getFile= "<a href="""&uploadPath & folderName &"/" & newFilePath&""" target=""_balnk"">采集成功</a>"
End If
End If
Set xmlhttp=Nothing
End Function
%>
<script runat="server" language="jscript">
function cleanFileName(str){
str = str.replace(/[^_\.a-zA-Z\d]/ig,"");
str = str.replace(/^[\/\.]+/,"");
return str;
}
function getNow(n)
{
d = new Date();
switch (n)
{
case "Year":
return d.getYear();
case "Month":
return (d.getMonth() + 1);
case "Date":
return d.getDate();
}
}
</script>
<%if request("do")="getfile" and request("file") <> "" then
response.write(getFile(request("file")))
else%>
<form id="gform" method="post" action="?do=getfile" style="display: inline">
<input name="file" type="input" style="font-size:12px;" size="40" value="http://blog.xiaobin.net/uploads/200512/08_093616_01.gif">
<input type="Submit" name="Submit" value="采集 " class="button">
</form>
<%end if%>
标签:
自动采集程序
蝙蝠岛资源网 Design By www.hbtsch.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
免责声明:本站文章均来自网站采集或用户投稿,网站不提供任何软件下载或自行开发的软件! 如有用户或公司发现本站内容信息存在侵权行为,请邮件告知! 858582#qq.com
蝙蝠岛资源网 Design By www.hbtsch.com
暂无自动采集程序的评论...
更新日志
2024年12月23日
2024年12月23日
- 小骆驼-《草原狼2(蓝光CD)》[原抓WAV+CUE]
- 群星《欢迎来到我身边 电影原声专辑》[320K/MP3][105.02MB]
- 群星《欢迎来到我身边 电影原声专辑》[FLAC/分轨][480.9MB]
- 雷婷《梦里蓝天HQⅡ》 2023头版限量编号低速原抓[WAV+CUE][463M]
- 群星《2024好听新歌42》AI调整音效【WAV分轨】
- 王思雨-《思念陪着鸿雁飞》WAV
- 王思雨《喜马拉雅HQ》头版限量编号[WAV+CUE]
- 李健《无时无刻》[WAV+CUE][590M]
- 陈奕迅《酝酿》[WAV分轨][502M]
- 卓依婷《化蝶》2CD[WAV+CUE][1.1G]
- 群星《吉他王(黑胶CD)》[WAV+CUE]
- 齐秦《穿乐(穿越)》[WAV+CUE]
- 发烧珍品《数位CD音响测试-动向效果(九)》【WAV+CUE】
- 邝美云《邝美云精装歌集》[DSF][1.6G]
- 吕方《爱一回伤一回》[WAV+CUE][454M]