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

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

'================================================== 

'函数名：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,"|") 
上一个：ASP随机图片显示代码
下一个：ASP rs.getrows方法获取记录数
更多图片编程知识:

.Net 4.0 Parallel 编程（七）Task中的数据共享（上）

ASP.NET验证控件之RequiredFieldValidator

ASP.NET MVC Razor视图引擎攻略

一步步打造自己的分页控件--4

《.NET4.0 面向对象编程漫谈》读书笔记 ——第7章 程序集

步步为营 .NET 设计模式学习笔记 十九、Chain of Responsibility(职责链模式)