使用XMLHttp和ADODB.Stream取得遠端檔案並儲存到本地 (轉)

使用XMLHttp和ADODB.Stream取得遠端檔案並儲存到本地 (轉)[@more@]

'****************************************************************************
'PageName:GetRemoteFiles.
'Function: the files to Server
'Author:xiaotian
'Last Modified at:-3-19
'****************************************************************************

'取得並儲存到本地
Function GetRemoteFiels(RemotePath, LocalPath, FileName)
Dim strBody
Dim FilePath

  On Error Resume Next

  '取得流
 strBody = GetBody(RemotePath)
 '取得儲存的檔名
 if Right(LocalPath, 1) <> "" then LocalPath = LocalPath & ""
 FilePath = LocalPath & GetFileName(RemotePath, FileName)
 '儲存檔案
 if SaveToFile(strBody, FilePath) = true and err.Number = 0 then
  GetRemoteFiles = true
 else
  GetRemoteFiles = false
 end if

End Function

'遠端獲取內容
Function GetBody(url)
Dim Retrieval
  '建立HTTP
  Set Retrieval = Create(".")
  With Retrieval
  .Open "Get", url, False, "", ""
  .Send
  GetBody = .ResponseBody
  End With
  Set Retrieval = Nothing
End Function

'重組檔名
Function GetFileName(RemotePath, FileName)
Dim arrTmp
Dim strFileExt
  arrTmp = Split(RemotePath, ".")
 strFileExt = arrTmp(UBound(arrTmp))
  GetFileName = FileName & "." & strFileExt
End Function

'將流內容儲存為檔案
Function SaveToFile(Stream, FilePath)
Dim objStream

  On Error Resume Next

  '建立ADO.Stream物件，必須要ADO 2.5以上版本
  Set objStream = Server.CreateObject("ADODB.Stream")
  objStream.Type = 1  '以二進位制開啟
  objStream.Open
  objstream.write Stream
  objstream.SaveToFile FilePath, 2
  objstream.Close()
  '關閉物件，釋放資源
  Set objstream = Nothing

 if err.Number <> 0 then
  SaveToFile = false
 else
  SaveToFile = true
 end if
End Function
%>