如何从服务器下在资料后保存在pc上?(提供原码请高手修改)
<%
Path=request.querystring("p")
if left(lcase(path),7) <> "http://" then
'Response.Redirect Path
Response.write "local file!"
else
RemoteFile(Path)
end if
Sub RemoteFile(sPath)
FileName = GetFileName(sPath)
'FilePath = Server.MapPath(".") & "\MyData\"&FileName
FilePath = "C:\MyData\"&FileName
trim FilePath
Response.Write FilePath&"<br>"
Set objFso = Server.CreateObject("Scripting.FileSystemObject")
if objFso.FileExists(FilePath) Then
'Response.Redirect "/MyData/" & FileName
Response.write "remote file has been downloaded!"
Else
t = GetBody(Path)
Response.BinaryWrite t
Response.Flush
SaveFile t,FilePath
End if
Set objFso = Nothing
End Sub
Function GetFileName(str)
str = Replace(lcase(str),"http://","")
str = Replace(str,"/","")
str = replace(str,vbcrlf,"")
GetFileName = str
End Function
Function GetBody(url)
'on error resume next
'Response.Write url
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", url, False, "", ""
.Send
'GetBody = .ResponseText
GetBody = .ResponseBody
End With
Set Retrieval = Nothing
End Function
Sub SaveFile(strBody,fName)
Set objStream = Server.CreateObject("ADODB.Stream")
lenstr=len(strBody)
dim code()
ReDim code(lenstr)
i = 0
Do Until i = lenstr-1
code(i) = asc("a")
'code(i) = asc(mid(strBody,i,1))
i = i + 1
Loop
With objStream
.Type = 2'adTypeBinary
.Open
'.Charset = "UNICODE"
.Position = 0
'.WriteText = strBody'mid(strBody,0)
.Write = code
Response.write "Len:"&.size
.SaveToFile fName,2
.Close
End With
Set objStream = Nothing
End Sub
%>