Copy Code code as follows:
<%
'================================================
' Function name: saveremotefile
' Function: Save remote files to local
' parameter: strFileName----Save the name of the file
' strremoteurl----remote file URL
' Return value: Boolean True/false
'================================================
Function Saveremotefile (ByVal strFileName, ByVal strremoteurl)
Dim ostream, retrieval, Getremotedata
Saveremotefile = False
On Error Resume Next
Set retrieval = Server.CreateObject ("Microsoft.XMLHTTP")
Retrieval.open "Get", Strremoteurl, False, "", ""
Retrieval.send
If retrieval.readystate <> 4 Then Exit Function
If retrieval.status > Then Exit Function
Getremotedata = Retrieval.responsebody
Set retrieval = Nothing
If LenB (getremotedata) > Then
Set ostream = Server.CreateObject ("ADODB.stream")
Ostream.type = 1
Ostream.mode = 3
Ostream.open
Ostream.write Getremotedata
Ostream.savetofile Server.MapPath (strFileName), 2
Ostream.cancel
Ostream.close
Set ostream = Nothing
Else
Exit Function
End If
If Err.Number = 0 Then
Saveremotefile = True
Else
Err.Clear
End If
End Function
%>
Copy Code code as follows:
<%
Class Download_cls
Private Suploaddir
Private nallowsize
Private Sallowext
Private Soriginalfilename
Private Ssavefilename
Private Spathfilename
Public Property Get Remotefilename ()
Remotefilename = Soriginalfilename
End Property
Public Property Get LocalFilename ()
LocalFilename = Ssavefilename
End Property
Public Property Get Localfilepath ()
Localfilepath = Spathfilename
End Property
Public Property Let Remotedir (ByVal strdir)
Suploaddir = Strdir
End Property
Public Property Let Allowmaxsize (ByVal intSize)
Nallowsize = IntSize
End Property
Public Property Let Allowextname (ByVal strext)
Sallowext = Strext
End Property
Private Sub Class_Initialize ()
On Error Resume Next
Script_object = "Scripting.FileSystemObject"
Suploaddir = "uploadfile/"
Nallowsize = 500
Sallowext = "Gif|jpg|png|bmp"
End Sub
Public Function changeremote (SHTML)
On Error Resume Next
Dim s_content
S_content = SHTML
On Error Resume Next
Dim Re, S, Remotefileurl, Savefilename, Savefiletype
Set re = New RegExp
Re. IgnoreCase = True
Re. Global = True
Re. Pattern = "((HTTP|HTTPS|FTP|RTSP|MMS):(\/\/|\\\\) {1} (([a-za-z0-9_-]) +[.]) {1,} (net|com|cn|org|cc|tv| [0-9] {1,3}) (\s*\/) ((\s) +[.] {1} ("& Sallowext &")) "
Set s = Re. Execute (s_content)
Dim A_remoteurl (), N, I, brepeat
n = 0
' Transfer to no duplicate data
For each remotefileurl in s
If n = 0 Then
n = n + 1
ReDim A_remoteurl (N)
A_remoteurl (n) = Remotefileurl
Else
Brepeat = False
For i = 1 to UBound (A_remoteurl)
If UCase (Remotefileurl) = UCase (A_remoteurl (i)) Then
Brepeat = True
Exit for
End If
Next
If brepeat = False Then
n = n + 1
ReDim Preserve a_remoteurl (n)
A_remoteurl (n) = Remotefileurl
End If
End If
Next
' Start the Replace operation
Dim Nfilenum, Scontentpath,strfilepath
Scontentpath = Relativepath2rootpath (Suploaddir)
Nfilenum = 0
For i = 1 to n
Savefiletype = Mid (A_remoteurl (i), InStrRev (A_remoteurl (i), ".") + 1)
Savefilename = Getrndfilename (Savefiletype)
strFilePath = Suploaddir & Savefilename
If saveremotefile (strFilePath, A_remoteurl (i)) = True Then
Nfilenum = nfilenum + 1
If nfilenum > 0 Then
Soriginalfilename = soriginalfilename & "|"
Ssavefilename = ssavefilename & "|"
Spathfilename = spathfilename & "|"
End If
Soriginalfilename = soriginalfilename & Mid (A_remoteurl (i), InStrRev (A_remoteurl (i), "/") + 1)
Ssavefilename = ssavefilename & Savefilename
Spathfilename = spathfilename & Scontentpath & Savefilename
S_content = Replace (s_content, A_remoteurl (i), Scontentpath & Savefilename, 1,-1, 1)
End If
Next
Changeremote = S_content
End Function
Public Function relativepath2rootpath (URL)
' This is mainly achieved. /Convert to actual path
Dim Stempurl
Stempurl = URL
If Left (stempurl, 1) = "/" Then
Relativepath2rootpath = Stempurl
Exit Function
End If
Dim Swebeditorpath
Swebeditorpath = Request.ServerVariables ("Script_name")
Swebeditorpath = Left (Swebeditorpath, InStrRev (Swebeditorpath, "/")-1)
Do While left (Stempurl, 3) = ". /"
Stempurl = Mid (Stempurl, 4)
Swebeditorpath = Left (Swebeditorpath, InStrRev (Swebeditorpath, "/")-1)
Loop
Relativepath2rootpath = Swebeditorpath & "/" & Stempurl
End Function
Public Function getrndfilename (SEXT)
Dim Srnd
Randomize
Srnd = Int (900 * Rnd) + 100
Getrndfilename = year (today) & Month (now) & Today & Hour (now) & Minute (now) & Second & "." & SExt
End Function
End Class
%>
