首页 > 编程 > ASP > 正文

自动采集程序

2024-05-04 11:02:50
字体:
来源:转载
供稿:网友
最近在做一个音乐站,音乐文件嘛。。。一般是从网上收集。。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)
发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表