'************************************************* ****************
' function
' 作用：利用流保存文件
' 參數：from（遠端檔案位址），tofile（儲存檔案位置）
'************************************************* ****************
Private Function SaveFiles(byref from,byref tofile)
Dim Datas
Datas=GetData(from,0)
Response.Write 儲存成功：&formatnumber(len(Datas)/1024*2,2)&Kb
response.Flush
if formatnumber(len(Datas)/1024*2,2)>1 then
ADOS.Type = 1
ADOS.Mode =3
ADOS.Open
ADOS.write Datas
ADOS.SaveToFile server.mappath(tofile),2
ADOS.Close()
else
Response.Write 儲存失敗：檔案大小&formatnumber(len(imgs)/1024*2,2)&Kb，小於1K
response.Flush
end if
end function
'************************************************* ****************
' function（私有）
' 作用：利用fso檢測檔案是否存在,存在回傳true,不存在回傳false
' 參數：filespes（檔案位置）
'************************************************* ****************
Private Function IsExists(byref filespec)
If (FSO.FileExists(server.MapPath(filespec))) Then
IsExists = True
Else
IsExists = False
End If
End Function
'************************************************* ****************
' function（私有）
' 作用：利用fso檢測資料夾是否存在,存在回傳true,不存在回傳false
' 參數：folder（資料夾位置）
'************************************************* ****************
Private Function IsFolder(byref Folder)
If FSO.FolderExists(server.MapPath(Folder)) Then
IsFolder = True
Else
IsFolder = False
End If
End Function
'************************************************* ****************
' function（私有）
' 作用：利用fso建立資料夾
' 參數：fldr（資料夾位置）
'************************************************* ****************
Private Function CreateFolder(byref fldr)
Dim f
Set f = FSO.CreateFolder(Server.MapPath(fldr))
CreateFolder = f.Path
Set f=nothing
End Function
'************************************************* ****************
' function（公有）
' 作用：儲存文件，並自動建立多層資料夾
' 參數：fromurl（遠端檔案位址），tofiles （儲存位置）
'************************************************* ****************
Public Function SaveData(byref FromUrl,byref ToFiles)
ToFiles=trim(Replace(ToFiles,//,/))
flName=ToFiles
fldr=
If IsExists(flName)=false then
GetNewsFold=split(flName,/)
For i=0 to Ubound(GetNewsFold)-1
if fldr= then
fldr=GetNewsFold(i)
else
fldr=fldr&/&GetNewsFold(i)
end if
If IsFolder(fldr)=false then
CreateFolder fldr
End if
Next
SaveFiles FromUrl,flName
End if
End function
'************************************************* ****************
' function（公有）
' 作用：取得遠端數據
' 參數：url（遠端檔案位址），getmode （模式:0為二進制，1為中文編碼）
'************************************************* ****************
Public Function GetData(byref url,byref GetMode)
'on error resume next
SourceCode = OXML.open (GET,url,false)
OXML.send()
if OXML.readystate<>4 then exit function
if GetMode=0 then
GetData = OXML.responseBody
else
GetData = BytesToBstr(OXML.responseBody)
end if
if err.number<>0 then err.Clear
End Function
'************************************************* ****************
' function（公有）
' 作用：格式化遠端圖片位址為本機位置
' 參數：imgurl（遠端圖片位址），imgfolder （本機圖片目錄），fristname（加入的前綴名稱）
'************************************************* ****************
Public Function FormatImgPath(byref ImgUrl,byref ImgFolder,byref FristName,byref noimg)
strpath=
ImgUrl=ImgUrl
if instr(ImgUrl,Nophoto) 或 lenb(GetData(ImgUrl,0))<=0 then
strpath=noimg
Response.Write &strpath& &vbcrlf
else
if Instr(ImgUrl,.asp) then
strpath=FristName&_&Mid(ImgUrl, InStrRev(ImgUrl, =)+1)&.jpg
else
strpath=FristName&_&Mid(ImgUrl, InStrRev(ImgUrl, /)+1)
end if
strpath = ImgFolder&/&strpath
strpath = Replace(strpath,//,/)
if left(strpath,1)=/ then strpath=right(strpath,len(strpath)-1)
strpath = trim(strpath)
Response.Write &strpath& &vbcrlf
savedata ImgUrl,strpath
end if
FormatImgPath = strpath
End function