ASP保存远程图片到本地 同时取得第一张图片并创建缩略图的代码

答案：采集中 或者 在线添加文章中 都可以用到此功能 
俺自己在baidu上搜索的保存远程图片到本地的代码 感觉比较难用点 而且没有现成的比较全的代码 俺也看不懂 
俺从 SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取了点函数 用下 比较简单好用 
以下是函数 
程序代码 
[复制此代码]CODE:

<% 
'================================================== 
'函数名：CheckDir2 
'作 用：检查文件夹是否存在 
'参 数：FolderPath ------文件夹地址 
'================================================== 
Function CheckDir2(byval FolderPath) 
dim fso 
folderpath=Server.MapPath(".")&"\"&folderpath 
Set fso = Server.CreateObject("Scripting.FileSystemObject") 
If fso.FolderExists(FolderPath) then 
'存在 
CheckDir2 = True 
Else 
'不存在 
CheckDir2 = False 
End if 
Set fso = nothing 
End Function 
'================================================== 
'函数名：MakeNewsDir2 
'作 用：创建新的文件夹 
'参 数：foldername ------文件夹名称 
'================================================== 
Function MakeNewsDir2(byval foldername) 
dim fso 
Set fso = Server.CreateObject("Scripting.FileSystemObject") 
fso.CreateFolder(Server.MapPath(".") &"\" &foldername) 
If fso.FolderExists(Server.MapPath(".") &"\" &foldername) Then 
MakeNewsDir2 = True 
Else 
MakeNewsDir2 = False 
End If 
Set fso = nothing 
End Function 
'================================================== 
'函数名：DefiniteUrl 
'作 用：将相对地址转换为绝对地址 
'参 数：PrimitiveUrl ------要转换的相对地址 
'参 数：ConsultUrl ------当前网页地址 
'================================================== 
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl) 
Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray 
If PrimitiveUrl="" or ConsultUrl="" or PrimitiveUrl="$False$" Then 
DefiniteUrl="$False$" 
Exit Function 
End If 
If Left(ConsultUrl,7)<>"HTTP://" And Left(ConsultUrl,7)<>"http://" Then 
ConsultUrl= "http://" & ConsultUrl 
End If 
ConsultUrl=Replace(ConsultUrl,"://",":\\") 
If Right(ConsultUrl,1)<>"/" Then 
If Instr(ConsultUrl,"/")>0 Then 
If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then 
Else 
ConsultUrl=ConsultUrl & "/" 
End If 
Else 
ConsultUrl=ConsultUrl & "/" 
End If 
End If 
ConArray=Split(ConsultUrl,"/") 
If Left(PrimitiveUrl,7) = "http://" then 
DefiniteUrl=Replace(PrimitiveUrl,"://",":\\") 
ElseIf Left(PrimitiveUrl,1) = "/" Then 
DefiniteUrl=ConArray(0) & PrimitiveUrl 
ElseIf Left(PrimitiveUrl,2)="./" Then 
DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1) 
ElseIf Left(PrimitiveUrl,3)="../" then 
Do While Left(PrimitiveUrl,3)="../" 
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3) 
Pi=Pi+1 
Loop 
For Ci=0 to (Ubound(ConArray)-1-Pi) 
If DefiniteUrl<>"" Then 
DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci) 
Else 
DefiniteUrl=ConArray(Ci) 
End If 
Next 
DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl 
Else 
If Instr(PrimitiveUrl,"/")>0 Then 
PriArray=Split(PrimitiveUrl,"/") 
If Instr(PriArray(0),".")>0 Then 
If Right(PrimitiveUrl,1)="/" Then 
DefiniteUrl="http:\\" & PrimitiveUrl 
Else 
If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 
DefiniteUrl="http:\\" & PrimitiveUrl 
Else 
DefiniteUrl="http:\\" & 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 
Else 
If Instr(PrimitiveUrl,".")>0 Then 
If Right(ConsultUrl,1)="/" Then 
If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then 
DefiniteUrl="http:\\" & PrimitiveUrl & "/" 
Else 
DefiniteUrl=ConsultUrl & PrimitiveUrl 
End If 
Else 
If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then 
DefiniteUrl="http:\\" & PrimitiveUrl & "/" 
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 ------ 要替换的字符串 
'参 数：StarStr ----- 前导 
'参 数：OverStr ----- 
'参 数：IncluL ------ 
'参 数：IncluR ------ 
'参 数：SaveTf ------ 是否保存文件，False不保存，True保存 
'参 数：SaveFilePath- 保存文件夹 
'参 数: TistUrl------ 当前网页地址 
'================================================== 
Function ReplaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl) 
If ConStr="$False$" or ConStr="" Then 
ReplaceSaveRemoteFile="$False$" 
Exit Function 
End If 
Dim TempStr,TempStr2,ReF,Matches,Match,Tempi,TempArray,TempArray2,OverTypeArray 
Set ReF = New Regexp 
ReF.IgnoreCase = True 
ReF.Global = True 
ReF.Pattern = "("&StartStr&").+?("&OverStr&")" 
Set Matches =ReF.Execute(ConStr) 
For Each Match in Matches 
If Instr(TempStr,Match.Value)=0 Then 
If TempStr<>"" then 
TempStr=TempStr & "$Array$" & Match.Value 
Else 
TempStr=Match.Value 
End if 
End If 
Next 
Set Matches=nothing 
Set ReF=nothing 
If TempStr="" or IsNull(TempStr)=True Then 
ReplaceSaveRemoteFile=ConStr 
Exit function 
End if 
If IncluL=False then 
TempStr=Replace(TempStr,StartStr,"") 
End if 
If IncluR=False then 
If Instr(OverStr,"|")>0 Then 
OverTypeArray=Split(OverStr,"|") 
For Tempi=0 To Ubound(OverTypeArray) 
TempStr=Replace(TempStr,OverTypeArray(Tempi),"") 
Next 
Else 
TempStr=Replace(TempStr,OverStr,"") 
End If 
End if 
TempStr=Replace(TempStr,"""","") 
TempStr=Replace(TempStr,"'","") 
Dim RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum 
If Right(SaveFilePath,1)="/" then 
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1) 
End If 
If SaveTf=True then 
If CheckDir2(SaveFilePath)=False Then 
If MakeNewsDir2(SaveFilePath)=False Then 
SaveTf=False 
End If 
End If 
End If 
SaveFilePath=SaveFilePath & "/" 
'图片转换/保存 
TempArray=Split(TempStr,"$Array$") 
For Tempi=0 To Ubound(TempArray) 
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl) 
If RemoteFileurl<>"$False$" And SaveTf=True Then'保存图片 
ArrSaveFileName = Split(RemoteFileurl,".") 
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'文件类型 
RanNum=Int(900*Rnd)+100 
SaveFileName = SaveFilePath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&SaveFileType 
Call SaveRemoteFile(SaveFileName,RemoteFileurl) 
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName) 
ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片 
SaveFileName=RemoteFileUrl 
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName) 
End If 
If RemoteFileUrl<>"$False$" Then 
If UploadFiles="" then 
UploadFiles=SaveFileName 
Else 
UploadFiles=UploadFiles & "|" & SaveFileName 
End if 
End If 
Next 
Repl

上一个：js table排序类代码
下一个：asp伪继承初探_实例代码