|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
asp可以轻松地实现对页面内容的动态控制,根据不同的浏览者,显示不同的页面内容。而浏览者一点觉察不出来,就像为他专门制作的页面一样。使用各种各样的组件,asp可以完成无比强大的功能。ASP经由过程XMLHTTP猎取远程图片流数据,并保留到当地,把第一张收罗到的图片天生缩略图。
详细代码以下:
<%
==================================================
函数名:CheckDir2
作用:反省文件夹是不是存在
参数:FolderPath------文件夹地点
==================================================
FunctionCheckDir2(byvalFolderPath)
dimfso
folderpath=Server.MapPath(".")&""&folderpath
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Iffso.FolderExists(FolderPath)then
存在
CheckDir2=True
Else
不存在
CheckDir2=False
Endif
Setfso=nothing
EndFunction
==================================================
函数名:MakeNewsDir2
作用:创立新的文件夹
参数:foldername------文件夹称号
==================================================
FunctionMakeNewsDir2(byvalfoldername)
dimfso
Setfso=Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(".")&""&foldername)
Iffso.FolderExists(Server.MapPath(".")&""&foldername)Then
MakeNewsDir2=True
Else
MakeNewsDir2=False
EndIf
Setfso=nothing
EndFunction
==================================================
函数名:DefiniteUrl
作用:将绝对地点转换为相对地点
参数:PrimitiveUrl------要转换的绝对地点
参数:ConsultUrl------以后网页地点
==================================================
FunctionDefiniteUrl(ByvalPrimitiveUrl,ByvalConsultUrl)
DimConTemp,PriTemp,Pi,Ci,PriArray,ConArray
IfPrimitiveUrl=""orConsultUrl=""orPrimitiveUrl="$False$"Then
DefiniteUrl="$False$"
ExitFunction
EndIf
IfLeft(ConsultUrl,7)"HTTP://"AndLeft(ConsultUrl,7)"http://"Then
ConsultUrl="http://"&ConsultUrl
EndIf
ConsultUrl=Replace(ConsultUrl,"://",":")
IfRight(ConsultUrl,1)"/"Then
IfInstr(ConsultUrl,"/")>0Then
IfInstr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0then
Else
ConsultUrl=ConsultUrl&"/"
EndIf
Else
ConsultUrl=ConsultUrl&"/"
EndIf
EndIf
ConArray=Split(ConsultUrl,"/")
IfLeft(PrimitiveUrl,7)="http://"then
DefiniteUrl=Replace(PrimitiveUrl,"://",":")
ElseIfLeft(PrimitiveUrl,1)="/"Then
DefiniteUrl=ConArray(0)&PrimitiveUrl
ElseIfLeft(PrimitiveUrl,2)="./"Then
DefiniteUrl=ConArray(0)&Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
ElseIfLeft(PrimitiveUrl,3)="../"then
DoWhileLeft(PrimitiveUrl,3)="../"
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
Pi=Pi+1
Loop
ForCi=0to(Ubound(ConArray)-1-Pi)
IfDefiniteUrl""Then
DefiniteUrl=DefiniteUrl&"/"&ConArray(Ci)
Else
DefiniteUrl=ConArray(Ci)
EndIf
Next
DefiniteUrl=DefiniteUrl&"/"&PrimitiveUrl
Else
IfInstr(PrimitiveUrl,"/")>0Then
PriArray=Split(PrimitiveUrl,"/")
IfInstr(PriArray(0),".")>0Then
IfRight(PrimitiveUrl,1)="/"Then
DefiniteUrl="http:"&PrimitiveUrl
Else
IfInstr(PriArray(Ubound(PriArray)-1),".")>0Then
DefiniteUrl="http:"&PrimitiveUrl
Else
DefiniteUrl="http:"&PrimitiveUrl&"/"
EndIf
EndIf
Else
IfRight(ConsultUrl,1)="/"Then
DefiniteUrl=ConsultUrl&PrimitiveUrl
Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/"))&PrimitiveUrl
EndIf
EndIf
Else
IfInstr(PrimitiveUrl,".")>0Then
IfRight(ConsultUrl,1)="/"Then
Ifright(PrimitiveUrl,3)=".cn"orright(PrimitiveUrl,3)="com"orright(PrimitiveUrl,3)="net"orright(PrimitiveUrl,3)="org"Then
DefiniteUrl="http:"&PrimitiveUrl&"/"
Else
DefiniteUrl=ConsultUrl&PrimitiveUrl
EndIf
Else
Ifright(PrimitiveUrl,3)=".cn"orright(PrimitiveUrl,3)="com"orright(PrimitiveUrl,3)="net"orright(PrimitiveUrl,3)="org"Then
DefiniteUrl="http:"&PrimitiveUrl&"/"
Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/"))&"/"&PrimitiveUrl
EndIf
EndIf
Else
IfRight(ConsultUrl,1)="/"Then
DefiniteUrl=ConsultUrl&PrimitiveUrl&"/"
Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/"))&"/"&PrimitiveUrl&"/"
EndIf
EndIf
EndIf
EndIf
IfLeft(DefiniteUrl,1)="/"then
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
Endif
IfDefiniteUrl""Then
DefiniteUrl=Replace(DefiniteUrl,"//","/")
DefiniteUrl=Replace(DefiniteUrl,":","://")
Else
DefiniteUrl="$False$"
EndIf
EndFunction
==================================================
函数名:ReplaceSaveRemoteFile
作用:交换、保留远程文件
参数:ConStr------要交换的字符串
参数:StarStr-----前导
参数:OverStr-----
参数:IncluL------
参数:IncluR------
参数:SaveTf------是不是保留文件,False不保留,True保留
参数:SaveFilePath-保留文件夹
参数:TistUrl------以后网页地点
==================================================
FunctionReplaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
IfConStr="$False$"orConStr=""Then
ReplaceSaveRemoteFile="$False$"
ExitFunction
EndIf
DimTempStr,TempStr2,ReF,Matches,Match,Tempi,TempArray,TempArray2,OverTypeArray
SetReF=NewRegexp
ReF.IgnoreCase=True
ReF.Global=True
ReF.Pattern="("&StartStr&").+?("&OverStr&")"
SetMatches=ReF.Execute(ConStr)
ForEachMatchinMatches
IfInstr(TempStr,Match.Value)=0Then
IfTempStr""then
TempStr=TempStr&"$Array$"&Match.Value
Else
TempStr=Match.Value
Endif
EndIf
Next
SetMatches=nothing
SetReF=nothing
IfTempStr=""orIsNull(TempStr)=TrueThen
ReplaceSaveRemoteFile=ConStr
Exitfunction
Endif
IfIncluL=Falsethen
TempStr=Replace(TempStr,StartStr,"")
Endif
IfIncluR=Falsethen
IfInstr(OverStr,"|")>0Then
OverTypeArray=Split(OverStr,"|")
ForTempi=0ToUbound(OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi),"")
Next
Else
TempStr=Replace(TempStr,OverStr,"")
EndIf
Endif
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"","")
DimRemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
IfRight(SaveFilePath,1)="/"then
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1)
EndIf
IfSaveTf=Truethen
IfCheckDir2(SaveFilePath)=FalseThen
IfMakeNewsDir2(SaveFilePath)=FalseThen
SaveTf=False
EndIf
EndIf
EndIf
SaveFilePath=SaveFilePath&"/"
图片转换/保留
TempArray=Split(TempStr,"$Array$")
ForTempi=0ToUbound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
IfRemoteFileurl"$False$"AndSaveTf=TrueThen保留图片
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
CallSaveRemoteFile(SaveFileName,RemoteFileurl)
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
ElseIfRemoteFileurl"$False$"andSaveTf=FalseThen不保留图片
SaveFileName=RemoteFileUrl
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
EndIf
IfRemoteFileUrl"$False$"Then
IfUploadFiles=""then
UploadFiles=SaveFileName
Else
UploadFiles=UploadFiles&"|"&SaveFileName
Endif
EndIf
Next
ReplaceSaveRemoteFile=ConStr
Endfunction
==================================================
历程名:SaveRemoteFile
作用:保留远程的文件到当地
参数:LocalFileName------当地文件名
参数:RemoteFileUrl------远程文件URL
==================================================
subSaveRemoteFile(LocalFileName,RemoteFileUrl)
dimAds,Retrieval,GetRemoteData
SetRetrieval=Server.CreateObject("Microsoft.XMLHTTP")
WithRetrieval
.Open"Get",RemoteFileUrl,False,"",""
.Send
GetRemoteData=.ResponseBody
EndWith
SetRetrieval=Nothing
SetAds=Server.CreateObject("Adodb.Stream")
WithAds
.Type=1
.Open
.WriteGetRemoteData
.SaveToFileserver.MapPath(LocalFileName),2
.Cancel()
.Close()
EndWith
SetAds=nothing
endsub
==================================================
历程名:GetImg
作用:获得文章中第一张图片
参数:str------文章内容
参数:strpath------保留图片的路径
==================================================
FunctionGetImg(str,strpath)
setobjregEx=newRegExp
objregEx.IgnoreCase=true
objregEx.Global=true
zzstr=""&strpath&"(.+?).(jpg|gif|png|bmp)"
objregEx.Pattern=zzstr
setmatches=objregEx.execute(str)
foreachmatchinmatches
retstr=retstr&"|"&Match.Value
next
ifretstr""then
Imglist=split(retstr,"|")
Imgone=replace(Imglist(1),strpath,"")
GetImg=Imgone
else
GetImg=""
endif
endfunction
%>
例:
程序代码
<formid="form1"name="form1"method="post"action="?action=test">
<textareaname="body"cols="50"rows="5"id="body">
")
response.Write("<br>旧事中的第一张图片的缩略图是:")
response.Write("<imgsrc="&Smallimg&">")
response.Write("<br>新的旧事内容(图片为当地):<br>")
Response.Write(Content)
Response.End()
endif
%>
楼上说交互性不好,太牵强了吧。在微软提供的一套框架中,利用asp做网站,开发效率高,使用人数少,减少不必要的开销。交互性是互动方式,是有开发人员决定的。 |
|