asp 下载远程文件到服务器

发布网友发布时间：2022-06-07 02:02

共1个回答

热心网友时间：2023-10-14 13:52

调用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("("."))
%>

追问本地和服务器上均测试失败，求解决

追答

附件中是新的程序，本地测试已成功。