秀才爱上兵    复制

刚弄过来的

有没有用还有待测试

Sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
 On Error Resume Next
 Dim StreamObj,Retrieval,GetRemoteData,TempHTTPObj
 Pic_Inc=Pic_Inc+1
 TempHTTPObj = "MSXML2.XMLHTTP"
 Set Retrieval = Server.CreateObject(TempHTTPObj)
 With Retrieval
         '这里想解决XMLHTTP假死的问题
         '.setTimeouts 5000,5000,15000,15000
  .Open "Get", RemoteFileUrl, False, "", ""
  .Send
  If .Readystate<>4 or .Status > 300 then
              Retrieval=False
              Pic_Inc=Pic_Inc-1
              Exit Sub
         End If
  if Err.Number <> 0 then
   Err.Clear
   Set Retrieval = Nothing
   Pic_Inc=Pic_Inc-1
   Exit Sub
  end if
  GetRemoteData = .ResponseBody
 End With
 Set Retrieval = Nothing
 Set StreamObj = Server.CreateObject("Adodb.Stream")
 With StreamObj
  .Type = 1
  .Open
  .Write GetRemoteData
  .SaveToFile Server.MapPath(LocalFileName),2
  .Cancel()
  .Close()
 End With
 Set StreamObj = Nothing
End Sub