asp 下载远程文件到服务器

调用download方法就可以下载文件了，程序会自动获取文件名，如果获取失败会以dat后缀保存文件

<%

'函数名:WritFile

'作用:把指定二进制数据写入文件

'参数:byt--二进制数据,file--要写入的文件名

public Function WritFile(ByVal byt, ByVal fileName)   '写入文件函数

on error resume next

Dim objAso:set objAso=server.createobject("adodb.Stream")

     objAso.Type = 1

     objAso.Mode = 3

     objAso.Open

     objAso.Position = 0

     objAso.Write byt

     objAso.SaveToFile fileName, 2

     objAso.Close

     Set objAso = Nothing

     WritFile = True

End Function

'函数名:Download

'作用:下载文件

'参数:URL-要获取的URL，savePath为文件保存地址

Public Function Download(ByVal URL, ByVal savePath)

On Error Resume Next

Dim ResBody, sStr, vPath, fileName, vErr

vErr = True

vPath = Replace(savePath, "/", "\")

If Right(vPath, 1) <> "\" Then vPath = vPath & "\"

sPos = InStrRev(URL, "/") + 1

sStr = Mid(URL, sPos)

Set Http = Server.CreateObject("MICROSOFT.XMLHTTP")

Http.Open "GET", URL, False

Http.Send

If Http.Readystate = 4 Then

If Http.Status = 200 Then

     ResBody = Http.responseBody

        head = Http.getResponseHeader("content-disposition")

        If head <> "" Then

           startpos = InStr(head, "=") + 1

           fileName = Mid(head, startpos)

        ElseIf InStr(sStr, ".") > 0 And InStr(sStr, "?") <= 0 Then

           fileName = sStr

        Else

           fileName = Getname() & ".dat"

        End If

        If WritFile(ResBody, vPath & fileName) Then vErr = False

End If

End If

Download = Not vErr

End Function

'函数名:getname

'作用:按日期获取随机数字

public Function Getname()

on error resume next

    Dim y,m,d,h,mm,S, r

    Randomize

    y = Year(Now)

    m = Month(Now): If m < 10 Then m = "0" & m

    d = Day(Now): If d < 10 Then d = "0" & d

    h = Hour(Now): If h < 10 Then h = "0" & h

    mm = Minute(Now): If mm < 10 Then mm = "0" & mm

    S = Second(Now): If S < 10 Then S = "0" & S

    r = 0

    r = CInt(Rnd() * 1000)

    If r < 10 Then r = "00" & r

    If r < 100 And r >= 10 Then r = "0" & r

    Getname = y & m & d & h & mm & S & r

End Function

call download("("."))

%>

用Microsoft.XMLHTTP组件。一般服务器都有的。

Function GetHttp(U)

On Error Resume Next

If Lcase(Left(U,7))<>"http://" Then Exit Function

Set D=Server.CreateObject(Microsoft.XMLHTTP):D.Open "GET",U,false:D.send

If D.status=200 Then GetHttp=D.ResponseBody

Set D=Nothing

End Function

Function SaveAs(B，P)

On Error Resume Next

Set D=server.createobject(OtT(5)):D.type=1:D.Mode=3:D.Open:D.Write B

If D.size>0 Then D.SaveToFile P,2:ErrN=0:

D.Close:Set D=nothing

End Function

调用方法：

<%

SaveAs GetHttp("http://../index.html")，"C:\123.html"

%>

download.asp

<%

'Code By oday

url =Trim(Request.QueryString("url")) '注意URL路径上的文件不能是被IIS解析的,如.txt就不行,要用的话自己改个后缀

fname=Trim(Request.QueryString("fname"))

if url <>"" then 'and fname<>"" then

Set xPost = CreateObject("Microsoft.XMLHTTP")

xPost.Open "GET",url,False

xPost.Send()

Set sGet = CreateObject("ADODB.Stream")

sGet.Mode = 3

sGet.Type = 1

sGet.Open()

sGet.Write(xPost.responseBody)

sGet.SaveToFile Server.MapPath(".")&"/"&fname,2

set sGet = nothing

set sPOST = nothing

response.Write("下载成功！<br>")

end if

%>

test.asp

<script>

location.href="download1.asp?url="+escape("http://58.211.102.206/hi/流行音乐/青花瓷.mp3")+"&fname=demo.mp3"

</script>

现在 这个可以运行了！！原来那个 ajax 有点问题！

---