'Function
'Role: save files using streams
'Parameter: 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: <font color = Red>" & formatnumber (LEN (datas)/1024*2, 2) & "</font> kb"
Response. Flush
If formatnumber (LEN (datas)/1024 *)> 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: <font color = Red> file size" & formatnumber (LEN (IMGs)/1024*2, 2) & "kb, less than 1 k </font>"
Response. Flush
End if
End Function'*************************************** **************************
'Function (private)
'Purpose: Use FSO to check whether a file exists. If yes, true is returned. If no, false is returned.
'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)
'Purpose: Use FSO to check whether a folder exists. If yes, true is returned. If no folder exists, false is returned.
'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)
'Purpose: Use FSO to create a folder
'Parameter: 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)
'Purpose: Save the file and automatically create a multi-level folder
'Parameter: fromurl (Remote File address), tofiles (storage 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)
'Role: obtain remote data
'Parameter: 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)
'Purpose: format the remote image address as the local location
'Parameter: imgurl (Remote Image address), imgfolder (local image directory), and fristname (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 "<a href =" & strpath & ">" & strpath & "</a>" & vbcrlf
Else
If instr (imgurl, ". asp") then
Strpath = fristname & "_" & Mid (imgurl, faster Rev (imgurl, "=") + 1) & ". jpg"
Else
Strpath = fristname & "_" & Mid (imgurl, limit Rev (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
End if
Formatimgpath = strpath
End Function |
