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

本主题由 admin 于 2008-5-19 20:07 设置高亮

admin

副管理员

认证草根

Rank: 8 Rank: 8

236Z.com原创组

帖子: 2933
积分: 2646
威望: 6441
金币: 267 元

楼主大中小发表于 2008-5-19 20:07 只看该作者 ( 看帖回帖是一种美德，您的回帖是对楼主最大的支持。)

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

采集中或者在线添加文章中都可以用到此功能
俺自己在baidu上搜索的保存远程图片到本地的代码感觉比较难用点而且没有现成的比较全的代码俺也看不懂
俺从 SNA新闻采集系统 For 3.62 (程序制作:ansir)里提取了点函数用下比较简单好用5 D5 s; k  l  x0 Y' s6 E: q
以下是函数
程序代码4 ?& ~/ n& ^% n# h
<%
'==================================================
'函数名：CheckDir20 m, J0 y2 X. j5 C9 J) Z
'作用：检查文件夹是否存在
'参数：FolderPath ------文件夹地址* H6 w* y" _  N% c* W
'==================================================: G. R' w8 o8 ~3 V0 Q+ x
Function CheckDir2(byval FolderPath)( H& j8 p* k* ^+ Z7 P5 i3 |
dim fso5 K0 ?* p( Y, H% n% Q  Q
folderpath=Server.MapPath(".")&"\"&folderpath, K9 r; Q  ?* J( M
Set fso = Server.CreateObject("Scripting.FileSystemObject")9 k8 d9 G0 @) z, T( s# ?/ N( S
If fso.FolderExists(FolderPath) then
'存在
  CheckDir2 = True
Else/ R( O( w2 E" g7 b8 V6 G/ v
'不存在
  CheckDir2 = False
End if
Set fso = nothing& ]* r( E4 c! U2 Q, K
End Function
'==================================================$ o/ _) A$ n) L- D4 y
'函数名：MakeNewsDir23 P$ S9 r9 ]1 E  @0 _2 @0 L' I
'作用：创建新的文件夹
'参数：foldername ------文件夹名称3 e* ~& Z* K8 w: {5 y* l
'==================================================" y2 n8 S+ V  p5 ^
Function MakeNewsDir2(byval foldername)% d6 Z8 q8 W( D5 F5 _1 y; k
dim fso; u$ ~+ n9 n; g: S; P
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(".") &"\" &foldername)7 G2 @: l5 m$ _) |" a5 H0 v2 }
If fso.FolderExists(Server.MapPath(".") &"\" &foldername) Then
MakeNewsDir2 = True5 f8 J" k0 i" w) `! a
Else
MakeNewsDir2 = False
End If" K/ K* b! l* f" ]+ C8 X3 R
Set fso = nothing
End Function
'==================================================% l' b& @+ x. Y' n% K
'函数名：DefiniteUrl' ~2 W* `$ @+ F/ b5 i- `! j  z. |/ M
'作用：将相对地址转换为绝对地址
'参数：PrimitiveUrl ------要转换的相对地址
'参数：ConsultUrl ------当前网页地址
'==================================================
Function DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)/ F' [1 k4 S4 O' k1 b
Dim ConTemp,PriTemp,Pi,Ci,PriArray,ConArray- V  w' C& `. O5 q* [! u3 e+ i
If PrimitiveUrl="" or C or PrimitiveUrl="$False$" Then% W2 d" Q1 {( ^5 c. q3 @* D
DefiniteUrl="$False$"
Exit Function/ V) e9 X( g+ A" o- G% F; a
End If
If Left(ConsultUrl,7)<>"HTTP://" And Left(ConsultUrl,7)<>"http://" Then1 f& F9 N/ g/ ^& y, O- v% e
C & ConsultUrl/ w' W2 ~. _( H9 ]" s5 d) Y
End If2 X% Q' |8 J% d" j# U# ]6 P
ConsultUrl=Replace(ConsultUrl,"://",":\\")1 P/ s0 R, P3 [+ z0 _
If Right(ConsultUrl,1)<>"/" Then8 l" C7 T0 g6 g) \
If Instr(ConsultUrl,"/")>0 Then9 P" [  m" J/ n) D0 p
If Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 then
Else
ConsultUrl=ConsultUrl & "/"
End If4 d( n1 D: R% a, O! A- g  T1 ]7 }' ~
Else
ConsultUrl=ConsultUrl & "/"
End If
End If
ConArray=Split(ConsultUrl,"/")8 {# f5 X' j1 _1 ?
If Left(PrimitiveUrl,7) = "http://" then
DefiniteUrl=Replace(PrimitiveUrl,"://",":\\")
ElseIf Left(PrimitiveUrl,1) = "/" Then4 c% i/ ^9 f! h+ ~" g4 u
DefiniteUrl=ConArray(0) & PrimitiveUrl5 v" x0 j9 Q$ O; [) Q" h* O
ElseIf Left(PrimitiveUrl,2)="./" Then
DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
ElseIf Left(PrimitiveUrl,3)="../" then2 B: Y0 ]9 Q( a% E6 l8 ^# q: i$ a
Do While Left(PrimitiveUrl,3)="../"+ m% p' u/ Q. a# j4 x
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
Pi=Pi+1
Loop 9 F. f& M* ]% t' {3 Z# r
For Ci=0 to (Ubound(ConArray)-1-Pi)) u% y" V- N: m, F+ h, _9 P
If DefiniteUrl<>"" Then
DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)  X' N& Y+ u3 D0 A3 ]+ R  i
Else- K1 P& O) L5 b: z" f# B' G9 K
DefiniteUrl=ConArray(Ci)- f7 X6 a% s( O7 V% f
End If  A, l1 D# N2 w
Next
DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl
Else
If Instr(PrimitiveUrl,"/")>0 Then: {6 j. _' k7 A) ~# F1 i0 j
PriArray=Split(PrimitiveUrl,"/")$ H/ g7 m, f0 y- s  W0 e5 X
If Instr(PriArray(0),".")>0 Then9 H" b/ B; I; S
If Right(PrimitiveUrl,1)="/" Then& O% N2 f& e) y
DefiniteUrl="http:\\" & PrimitiveUrl# i5 i" B& c1 s, N, J7 K
Else
If Instr(PriArray(Ubound(PriArray)-1),".")>0 Then 4 X' K$ |" O& b! K) W) c+ O' L
DefiniteUrl="http:\\" & PrimitiveUrl5 I0 C/ d; ?0 x# I
Else
DefiniteUrl="http:\\" & PrimitiveUrl & "/"
End If
End If
Else
If Right(ConsultUrl,1)="/" Then
DefiniteUrl=ConsultUrl & PrimitiveUrl' X. q6 v* X# K/ T1 Z
Else  N$ o( x* i  G
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl0 ?0 g0 e' L& K, M5 \
End If+ L7 v% _' t# O- I
End If$ V$ e. z% L$ o! m+ D$ }0 r
Else
If Instr(PrimitiveUrl,".")>0 Then, U$ o4 @  O* F1 S6 a! S% I
If Right(ConsultUrl,1)="/" Then7 [) G) u; t1 o- E' K6 T
If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then; i) g$ O* m* u
DefiniteUrl="http:\\" & PrimitiveUrl & "/"4 }8 I# N8 f' X6 {
Else
DefiniteUrl=ConsultUrl & PrimitiveUrl
End If- ?1 t$ v, D5 T! H, O  `. E
Else/ w# @) h6 V! i+ J- ^% _6 @
If right(PrimitiveUrl,3)=".cn" or right(PrimitiveUrl,3)="com" or right(PrimitiveUrl,3)="net" or right(PrimitiveUrl,3)="org" Then" N+ S2 A! O, J
DefiniteUrl="http:\\" & PrimitiveUrl & "/"
Else" x  o$ h3 x2 A/ j+ A
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
End If7 w* D4 X% \! `
End If
Else
If Right(ConsultUrl,1)="/" Then
DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
Else/ X& h+ W3 T0 o) C! C  ?
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
End If
End If' i7 R6 y5 s9 m! _
End If: V- D4 D/ J8 C6 b
End If
If Left(DefiniteUrl,1)="/" then" n* O8 K3 A$ ]' ?# z# [
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
End if
If DefiniteUrl<>"" Then& j* F$ x6 U3 b6 {
DefiniteUrl=Replace(DefiniteUrl,"//","/")& h5 p% q3 L8 U/ u
DefiniteUrl=Replace(DefiniteUrl,":\\","://")
Else4 P5 W* q( S4 _! U
DefiniteUrl="$False$"
End If
End Function
'==================================================" r* F6 ]6 R; V; Y
'函数名：ReplaceSaveRemoteFile
'作用：替换、保存远程文件
'参数：ConStr ------ 要替换的字符串/ k" {; `; K$ r; I. e: R; E
'参数：StarStr ----- 前导
'参数：OverStr -----
'参数：IncluL ------ / a) M# T- S  d+ P: }
'参数：IncluR ------ ( Y6 W* c+ {" k; Z
'参数：SaveTf ------ 是否保存文件，False不保存，True保存  Q( l' v$ k* r1 {
'参数：SaveFilePath- 保存文件夹6 j& ?7 w; t* Y
'参数: TistUrl------ 当前网页地址1 N1 ^/ T/ {2 v4 L5 ]
'==================================================
Function ReplaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl); m7 j* n6 p/ s; i" C, o1 p! n
If C or C 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 = True1 A# @% V: w3 ?& l: }
ReF.Pattern = "("&StartStr&").+?("&OverStr&")"
Set Matches =ReF.Execute(ConStr) 6 i* R; C" E6 n0 X7 `0 b. m
For Each Match in Matches
If Instr(TempStr,Match.Value)=0 Then
If TempStr<>"" then
TempStr=TempStr & "$Array$" & Match.Value' y  g- s0 c( ]0 }! _0 A
Else
TempStr=Match.Value
End if4 G, L9 ~$ B/ N; B" j
End If! k8 v, c* T  h; Y: S- e$ j. @5 }$ R& ^
Next
Set Matches=nothing4 l% _/ v" N) f4 y. c
Set ReF=nothing
If TempStr="" or IsNull(TempStr)=True Then
ReplaceSaveRemoteFile=ConStr+ Z" u  c) t& F, a& r# _
Exit function7 U9 \* X" T" K- W+ r( d+ L
End if$ k/ J& x4 ~; A2 W4 l+ ]
If IncluL=False then
TempStr=Replace(TempStr,StartStr,"")* }$ c# N* S6 H
End if/ a5 }) O$ Y1 z4 L; `
If IncluR=False then
If Instr(OverStr,"|")>0 Then) g* }% j) o: S$ Y4 T- P6 q; Y
OverTypeArray=Split(OverStr,"|"), t$ ?' Z& ~' k0 g& c9 `
For Tempi=0 To Ubound(OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi),"")0 f$ r- Y  b" x9 \% v# H0 }
Next
Else. Y  N2 g8 O- G. w8 F- K8 b
TempStr=Replace(TempStr,OverStr,"")
End If + F7 Z- S8 O: Q. V, D9 n/ ]7 d
End if
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"'","")

Dim RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum1 q0 o' Y0 L! N* c' p7 W" ~
If Right(SaveFilePath,1)="/" then! s! B( h5 @7 u* h, K  @
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1); @! W% M# ?& T! y3 u7 W( u: l7 T& Y
End If
If SaveTf=True then
If CheckDir2(SaveFilePath)=False Then( X0 v- i& m5 F8 b+ ~
If MakeNewsDir2(SaveFilePath)=False Then6 u0 c7 R( h& s
SaveTf=False! }1 O1 D9 C1 _: F- s, H- F3 j
End If+ `, o5 q4 X( m( J9 j! L1 ?! _
End If" Y8 l. R' v0 B" n! P2 ~0 }5 t
End If6 x- A2 u. O2 Z+ W) x* W2 {4 L
SaveFilePath=SaveFilePath & "/"! P4 y) O. v' n( t! }+ w8 H! F
4 s8 P3 _# }& E
'图片转换/保存
TempArray=Split(TempStr,"$Array$")# X$ s5 b) [- n+ `, Q
For Tempi=0 To Ubound(TempArray)# b0 q) I4 S0 x0 `% \, J* E1 s3 r
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)( A0 g3 C' y) K# W/ A% k. x
If RemoteFileurl<>"$False$" And SaveTf=True Then'保存图片
  ArrSaveFileName = Split(RemoteFileurl,".")
  SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'文件类型% Q3 ?: n' k' ]5 j( N
  RanNum=Int(900*Rnd)+100
  SaveFileName = SaveFilePath&year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&SaveFileType  ! c5 ]' G. g# w& l$ L, r
  Call SaveRemoteFile(SaveFileName,RemoteFileurl)9 V1 A( D9 @& F4 o; G; x
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
ElseIf RemoteFileurl<>"$False$" and SaveTf=False Then'不保存图片
SaveFileName=RemoteFileUrl
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
End If5 q! C" ?4 |" t7 O+ p- f, I
If RemoteFileUrl<>"$False$" Then$ P1 I, [  ?. y/ h. a8 ]6 o/ m
If UploadFiles="" then4 a7 K1 w3 L' u
UploadFiles=SaveFileName
Else2 G- M  v) G' h& x1 Q8 g; R% _
UploadFiles=UploadFiles & "|" & SaveFileName
End if
End If
Next / o, o& F6 F3 Z+ g
ReplaceSaveRemoteFile=ConStr
End function
'==================================================6 y3 S% S3 [# \- Z+ O8 p" W2 T
'过程名：SaveRemoteFile
'作用：保存远程的文件到本地
'参数：LocalFileName ------ 本地文件名
'参数：RemoteFileUrl ------ 远程文件URL9 b+ Y9 K! u" O1 o1 t  m+ C
'==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData5 T, N' ^+ S1 @% L
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP"). F; ?( X  x5 x/ U
With Retrieval4 |" h: F$ R; I3 K3 n
  .Open "Get", RemoteFileUrl, False, "", ""6 p5 F+ p6 _2 B; r8 w
  .Send6 C8 \$ t: B+ b  U
  GetRemoteData = .ResponseBody0 N% m. k. G' H: F" o
End With3 q; g4 p) M" `% k
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")1 F8 v+ p" c- f  A7 b
With Ads
  .Type = 1
  .Open1 L- G" e$ Z* w5 h" N, p( b
  .Write GetRemoteData8 h% T9 U" @( Y( Q- Q  F- ?
  .SaveToFile server.MapPath(LocalFileName),2  @) N) F2 U/ x1 \
  .Cancel()
  .Close()
End With
Set Ads=nothing9 u. L) X1 h! O
end sub

'==================================================
'过程名：GetImg5 D# K; C: L" o: Y2 F# b% t7 i
'作用：取得文章中第一张图片
'参数：str ------ 文章内容
'参数：strpath ------ 保存图片的路径% e# s$ K: X! I1 F0 l( ?
'==================================================/ ]; u% ]: k. k# G0 ]* Y- g, ^
Function GetImg(str,strpath)
set objregEx = new RegExp/ S2 ^' `8 S: `2 }; o( L
objregEx.IgnoreCase = true
objregEx.Global = true1 V% j5 e  ^6 h* O
zzstr=""&strpath&"(.+?)\.(jpg|gif|png|bmp)"
objregEx.Pattern = zzstr! d- n# a& G# A! ?9 c
set matches = objregEx.execute(str)
for each match in matches* [$ r) b: }, B  p$ H" s1 Z$ _) i- O% b
retstr = retstr &"|"& Match.Value
next' J4 l" x) g" T
if retstr<>"" then
Imglist=split(retstr,"|")
Imgone=replace(Imglist(1),strpath,"")9 y" Z2 H4 n% I8 p; O5 i" R6 U
GetImg=Imgone
else
GetImg=""
end if
end function! `/ ~9 I. R+ y* ], J2 [! n
%>+ m0 |* q  U3 Y' P  {
) b2 |. [) H6 B( d1 P7 f
以下是例子' j* P* w( w+ \* R! ?
程序代码1 t; d' G  q& g9 y/ G5 {  f
<form id="form1" name="form1" method="post" action="?action=test">& }; G% [% }/ q/ `: l5 V& n
<textarea name="body" cols="50" rows="5" id="body">  P- k0 k" L' t0 v  F
<img height="180" src="http://cimg2.163.com/cnews/2006/8/21/200608210738371d0a8.jpg" width="240" border="0" />
<img class="left"src="http://news.163.com/img/netease_logo.gif" width="114" />
<img height="60" src="http://cimg2.163.com/cnews/2006/8/18/2006081811465369976.jpg" width="120" border="0" />$ b0 ~' Z7 ^0 N  l4 M& j; K( f
<img height="60" alt="中国维和人数大国之首" src="http://cimg2.163.com/cnews/2006/8/18/200608181506554fd8f.jpg" width="120" border="0" />
</textarea>
<input type="submit" name="Submit" value="提交" />- [( E3 V! M, u1 r  N
</form>
<%
if request.QueryString("action")="test" then6 g$ Q( r6 U  M# ^  ^& ~
'图片开始的字符串
FilesStartStr="src="6 g2 Q8 o& v0 X3 ~# ]) c# n
'图片结束的字符串- _, @5 W; }; A/ C/ O4 q
FilesOverStr="gif|jpg|bmp"5 m9 S/ ?; v  m* |9 N" b
'保存图片的文件夹; M0 _: D' K/ z( W1 ~) Z3 S" N
FilesPath="qq"3 o  g/ c# s6 w/ ]* U
'取得保存图片的网站URL 自动判断是绝对还是相对路径该例子中图片是绝对地址所以NEWURL等于没用如果是../images/123.gif这样的就需要指定NEWURL了8 x% h1 G* q) F1 Q0 A9 O$ ^1 ?* t
NewsUrl="http://news.163.com"
'取得文章内容
Content =Request.Form("body")8 r. {6 F  F3 W4 |  D8 U: x! T4 o
'开始保存图片7 K4 C4 M! j, c7 `3 \. @* z4 w
Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'对新闻中的第一张图片创建缩略图
if GetImg(Content,FilesPath)<>"" then & ]! w1 Z# w% T& W! M5 x/ `! V
  Imgsrc=GetImg(Content,FilesPath)
  Imgsrc=replace(Imgsrc,FilesPath,"")
  Set Jpeg = Server.CreateObject("Persits.Jpeg")
  Path = Server.MapPath(""&FilesPath&"") & "\"&Imgsrc&""
  Jpeg.Open Path
'如果图片宽小于等于120 高小于等于90 则不创建缩略图" B* w' T, U/ K2 V2 p3 y
  if Jpeg.OriginalWidth<=120 and Jpeg.Height<=90 then. E# ^) B8 C+ u( x' A! }
Jpeg.Width = Jpeg.OriginalWidth/ h5 S( H- d7 o& b9 q
Jpeg.Height = Jpeg.OriginalHeight
Smallimg=FilesPath&""&GetImg(Content,FilesPath)
  else/ e' @% A7 G# L+ S
'图片宽度高度/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath(""&FilesPath&"") & "\small_"&Imgsrc&""
Smallimg=""&FilesPath&"/small_"&Imgsrc&""
  end if
end if; C$ Q4 ~/ }- c8 P# l2 V
'显示结果
response.Write("新闻中的第一张图片是:")* U8 |/ Z% i/ e% h' e2 G
response.Write("<img src="&FilesPath&"/"&GetImg(Content,FilesPath)&">")
response.Write("<br>新闻中的第一张图片的缩略图是:")
response.Write("<img src="&Smallimg&">")8 r2 Z& N6 c; k: q6 T+ V
response.Write("<br>新的新闻内容（图片为本地）:<br>")
Response.Write(Content)
Response.End()3 I; H2 S( M: W. s2 k/ t
end if
%>
演示地址：http://www.52la.cn/caiji/save.asp

TOP

‹‹ 上一主题 | 下一主题 ››

传奇世界私服	中电网通,品牌双线空间特价	传奇私服	最新城市通带.cs程序100一套	92日付手机广告联盟注册7元
流量-容易！赚钱-容易!ES交换链	魔域私服	和你分享草根站长的故事	中国最大传奇私服发布	魔域私服
批量提交网站一次到30个搜索	好私服\|及时雨	钓侣日付广告联盟80元1000点击	传奇私服 \|传奇私服	变态魔域

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

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

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

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