Collection, collection ' function
' Function: Save file with Stream
' Parameters: from (remote file address), ToFile (save file location)
'*****************************************************************
Private Function savefiles (ByRef from,byref ToFile)
Dim Datas
Datas=getdata (from,0)
Response.Write "Save success: <font color=red>" &formatnumber (Len (Datas)/1024*2,2) & "</FONT>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 "Save failed: <font color=red> file Size" &formatnumber (len (IMGs)/1024*2,2) & "Kb, less than 1k</font>"
Response. Flush
End If
End Function
'*****************************************************************
' Function (private)
' Role: Using the FSO to detect whether a file exists, exists to return true, does not exist returns 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)
' Role: Using the FSO to detect whether a folder exists, exists to return true, does not exist returns false
' Parameters: folder (folders location)
'*****************************************************************
Private Function Isfolder (ByRef Folder)
If FSO. FolderExists (server. MapPath (Folder)) Then
Isfolder = True
Else
Isfolder = False
End If
End Function
'*****************************************************************
' Function (private)
' Role: Create folders with FSO
' Parameters: Fldr (folder location)
'*****************************************************************
Private Function CreateFolder (ByRef fldr)
Dim F
Set f = FSO. CreateFolder (Server.MapPath (FLDR))
CreateFolder = F.path
Set f=nothing
End Function
'*****************************************************************
' Function (public)
' Function: Save files and automatically create multilevel 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: Get Remote Data
' Parameters: URL (remote file address), GetMode (mode: 0 is binary, 1 is encoded in Chinese)
'*****************************************************************
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 remote picture address as local location
' Parameters: Imgurl (remote picture address), Imgfolder (local picture directory), Fristname (prefix name added)
'*****************************************************************
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 "<a href=" &strpath& ">" &strpath& "</a>" &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 "<a href=" &strpath& ">" &strpath& "</a>" &vbcrlf
SaveData Imgurl,strpath
&