SoFunction
Updated on 2025-03-10

Under asp, the code to replace the remote file with a local file and save the remote file


<% 
'Whether to save remote pictures when adding resources
Const sSaveFileSelect=True

'Remote image save directory, please do not add "/" at the end
Const sSaveFilePath="/images/News"

'Remote image saving type
Const sFileExt="jpg|gif|bmp|png"

'/////////////////////////////////////////////////////
'Function: Replace the remote file in the string as a local file and save the remote file
'Parameters:
'        sHTML        : The string to be replaced
'     sSavePath   : The path to save the file
'       sExt
Function ReplaceRemoteUrl(sHTML, sSaveFilePath, sFileExt)
    Dim s_Content
    s_Content = sHTML
    If IsObjInstalled("") = False then
        ReplaceRemoteUrl = s_Content
        Exit Function
    End If

    Dim re, RemoteFile, RemoteFileurl,SaveFileName,SaveFileType,arrSaveFileNameS,arrSaveFileName,sSaveFilePaths
    Set re = new RegExp
     = True
     = True
     = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sFileExt & ")))"
    Set RemoteFile = (s_Content)
    For Each RemoteFileurl in RemoteFile
        SaveFileType = Replace(Replace(RemoteFileurl,"/", "a"), ":", "a")
        arrSaveFileName = Right(SaveFileType,12)
        sSaveFilePaths=sSaveFilePath & "/"
        SaveFileName = sSaveFilePaths & arrSaveFileName
        Call SaveRemoteFile(SaveFileName, RemoteFileurl)
        s_Content = Replace(s_Content,RemoteFileurl,SaveFileName)
    Next
    ReplaceRemoteUrl = s_Content
End Function

'////////////////////////////////////////
'Method: Save remote files to local
'Parameter: LocalFileName ------ Local file name
'         RemoteFileUrl ----- Remote File URL
'Return value: True ----Success
'         False --Failed
Sub SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)
    Dim Ads, Retrieval, GetRemoteData
    On Error Resume Next
    Set Retrieval = ("")
    With Retrieval
        .Open "Get", s_RemoteFileUrl, False, "", ""
        .Send
        GetRemoteData = .ResponseBody
    End With
    Set Retrieval = Nothing
    Set Ads = ("")
    With Ads
        .Type = 1
        .Open
        .Write GetRemoteData
        .SaveToFile (s_LocalFileName), 2
        .Cancel()
        .Close()
    End With
    Set Ads=nothing
End Sub

'////////////////////////////////////////
'Function: Check whether the component has been installed
'Arguments: strClassString --- Component name
'Return value: True ----installed
'     False --Not installed
Function IsObjInstalled(s_ClassString)
    On Error Resume Next
    IsObjInstalled = False
    Err = 0
    Dim xTestObj
    Set xTestObj = (s_ClassString)
    If 0 = Err Then IsObjInstalled = True
    Set xTestObj = Nothing
    Err = 0
End Function
%>