自动采集程序

所属分类: 网络编程 / ASP编程 阅读数: 1380
收藏 0 赞 0 分享
最近在做一个音乐站,音乐文件嘛。。。一般是从网上收集。。so。。写了一段采集程序。 
复制代码 代码如下:

<%
  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">&nbsp;
 <input type="Submit" name="Submit" value="采集 " class="button">
</form>
<%end if%>
更多精彩内容其他人还在看

TsysV1.1 系统文件清单介绍

TsysV1.1 系统文件清单介绍
收藏 0 赞 0 分享

好久没发布新玩意,完成了tsys的少年不在版

好久没发布新玩意,完成了tsys的少年不在版
收藏 0 赞 0 分享

tsys _rss程序

tsys _rss程序
收藏 0 赞 0 分享

TSYS 新闻列表JS调用下载

TSYS 新闻列表JS调用下载
收藏 0 赞 0 分享

使用asp代码突破图片的防盗连

使用asp代码突破图片的防盗连
收藏 0 赞 0 分享

一种理论上最快的Web数据库分页方法

一种理论上最快的Web数据库分页方法
收藏 0 赞 0 分享

asp:debug类调试程序

asp:debug类调试程序
收藏 0 赞 0 分享

如何增加Referer功能--反向链接插件

如何增加Referer功能--反向链接插件
收藏 0 赞 0 分享

pjblog中清空引用的小程序

pjblog中清空引用的小程序
收藏 0 赞 0 分享

光碟工具 Alcohol 120% v1.9.6.4719 下载(附序列号注册码)

光碟工具 Alcohol 120% v1.9.6.4719 下载(附序列号注册码)
收藏 0 赞 0 分享
查看更多