'************************************************ ****************
' function
' Function: Use streams to save files
'Parameters: from (remote file address), tofile (save file location)
'************************************************ ****************
Private Function SaveFiles(byref from,byref tofile)
Dim Datas
Datas=GetData(from,0)
Response.Write saved successfully: &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 failed to save: file size&formatnumber(len(imgs)/1024*2,2)&Kb, less than 1K
response.Flush
end if
end function
'************************************************ ****************
' function (private)
' Function: Use fso to detect whether the file exists. If it exists, it will return true. If it does not exist, it will return false.
'Parameter: filespes (file location)
'************************************************ ****************
Private Function IsExists(byref filespec)
If (FSO.FileExists(server.MapPath(filespec))) Then
IsExists = True
Else
IsExists = False
End If
End Function
'************************************************ ****************
' function (private)
' Function: Use fso to detect whether the folder exists. If it exists, it returns true. If it does not exist, it returns false.
'Parameter: folder (folder location)
'************************************************ ****************
Private Function IsFolder(byref Folder)
If FSO.FolderExists(server.MapPath(Folder)) Then
IsFolder = True
Else
IsFolder = False
End If
End Function
'************************************************ ****************
' function (private)
' Function: Use fso to create a folder
'Parameter: fldr (folder location)
'************************************************ ****************
Private Function CreateFolder(byref fldr)
f
Set f = FSO.CreateFolder(Server.MapPath(fldr))
CreateFolder = f.Path
Set f=nothing
End Function
'************************************************ ****************
' function (public)
' Function: Save files and automatically create multi-level folders
'Parameters: fromurl (remote file address), tofiles (save location)
'************************************************ ****************
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 (public)
' Function: Obtain remote data
'Parameters: url (remote file address), getmode (mode: 0 is binary, 1 is Chinese encoding)
'************************************************ ****************
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 (public)
' Function: format the remote image address as a local location
'Parameters: imgurl (remote image address), imgfolder (local image directory), fristname (added prefix name)
'************************************************ ****************
Public Function FormatImgPath(byref ImgUrl,byref ImgFolder,byref FristName,byref noimg)
strpath=
ImgUrl=ImgUrl
if instr(ImgUrl,Nophoto) or 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
savedataImgUrl,strpath
end if
FormatImgPath = strpath
End function