Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
End If
End If
Else
If Right(ConsultUrl,1)="/" Then
DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
End If
End If
End If
End If
If Left(DefiniteUrl,1)="/" then
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
End if
If DefiniteUrl<>"" Then
DefiniteUrl=Replace(DefiniteUrl,"//","/")
DefiniteUrl=Replace(DefiniteUrl,":","://")
Else
DefiniteUrl="$False$"
End If
End Function
'==================================================
'函数名：ReplaceSaveRemoteFile
'作 用：替换、保存远程图片
'参 数：ConStr ------ 要替换的字符串
'参 数：SaveTf ------ 是否保存文件，False不保存，True保存
'参 数: TistUrl------ 当前网页地址
'==================================================
Function ReplaceSaveRemoteFile(ConStr,InstallPath,strChannelDir,SaveTf,TistUrl)
If ConStr="$False$" or ConStr="" or InstallPath="" or strChannelDir="" Then
ReplaceSaveRemoteFile=ConStr
Exit Function
End If
Dim TempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
Set Re = New Regexp
Re.IgnoreCase = True
Re.Global = True
Re.Pattern ="<img.+?>"
Set Matches =Re.Execute(ConStr)
For Each Match in Matches
If TempStr<>"" then
TempStr=TempStr & "$Array$" & Match.Value
Else
TempStr=Match.Value
End if
Next
If TempStr<>"" Then
TempArray=Split(TempStr,"$Array$")
TempStr=""
For Tempi=0 To Ubound(TempArray)
Re.Pattern ="srcs*=s*.+?.(gifjpgbmpjpegpsdpngsvgdxfwmftiff)"
Set Matches =Re.Execute(TempArray(Tempi))
For Each Match in Matches
If TempStr<>"" then
TempStr=TempStr & "$Array$" & Match.Value
Else
TempStr=Match.Value
End if
Next
Next
End if
If TempStr<>"" Then
Re.Pattern ="srcs*=s*"
TempStr=Re.Replace(TempStr,"")
End If
Set Matches=nothing
Set Re=nothing
If TempStr="" or IsNull(TempStr)=True Then
ReplaceSaveRemoteFile=ConStr
Exit function
End if
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"'","")
TempStr=Replace(TempStr," ","")
Dim RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path
DtNow=Now()
'***********************************
If SaveTf=True then
SavePath=InstallPath&strChannelDir
If CheckDir(InstallPath & strChannelDir)=False Then
If Not CreateMultiFolder(InstallPath & strChannelDir) Then
response.Write InstallPath & strChannelDir&"目录创建失败"
SaveTf=False
End If
End If
End If
'去掉重复图片开始
TempArray=Split(TempStr,"$Array$")
TempStr=""
For Tempi=0 To Ubound(TempArray)
If Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 Then
TempStr=TempStr & "$Array$" & TempArray(Tempi)
