ASP教程之一个带收罗远程文章内容,保留图片,天生...
对用户来说可预见费用、节约费用，可以做到花少钱办大事。由于省去了购买软件和硬件等的前期费用，用户可以租用较高级的应用软件。ASP的收费是根据软件的类型、客制化程度、用户数量、服务期限来定的，对客户来说这笔费用是可以预见的。方便于客户应用软件的升级。本文供应了一套完全的ASP收罗功效函数,包括提取地点的原字符,保留远程的文件到当地摹拟登录,猎取网页源码等功效函数,阿里西西站长保举保藏!==================================================函数名：GetHttpPage
作用：猎取网页源码
参数：HttpUrl------网页地点
==================================================
FunctionGetHttpPage(HttpUrl)
IfIsNull(HttpUrl)=TrueOrLen(HttpUrl)<18OrHttpUrl="$False$"Then
GetHttpPage="$False$"
ExitFunction
EndIf
DimHttp
SetHttp=server.createobject("MSX"&"ML2.XM"&"LHT"&"TP")
Http.open"GET",HttpUrl,False
Http.Send()
IfHttp.Readystate4then
SetHttp=Nothing
GetHttpPage="$False$"
Exitfunction
Endif
GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
GetHTTPPage=replace(replace(GetHTTPPage,vbCr,""),vbLf,"")
SetHttp=Nothing
IfErr.number0then
Err.Clear
EndIf
EndFunction
==================================================
函数名：BytesToBstr
作用：将猎取的源码转换为中文
参数：Body------要转换的变量
参数：Cset------要转换的范例
==================================================
FunctionBytesToBstr(Body,Cset)
DimObjstream
SetObjstream=Server.CreateObject("ad"&"odb.str"&"eam")
objstream.Type=1
objstream.Mode=3
objstream.Open
objstream.Writebody
objstream.Position=0
objstream.Type=2
objstream.Charset=Cset
BytesToBstr=objstream.ReadText
objstream.Close
setobjstream=nothing
EndFunction
==================================================
函数名：PostHttpPage
作用：登录
==================================================
FunctionPostHttpPage(RefererUrl,PostUrl,PostData)
DimxmlHttp
DimRetStr
SetxmlHttp=CreateObject("Msx"&"ml2.XM"&"LHT"&"TP")
xmlHttp.Open"POST",PostUrl,False
XmlHTTP.setRequestHeader"Content-Length",Len(PostData)
xmlHttp.setRequestHeader"Content-Type","application/x-www-form-urlencoded"
xmlHttp.setRequestHeader"Referer",RefererUrl
xmlHttp.SendPostData
IfErr.Number0Then
SetxmlHttp=Nothing
PostHttpPage="$False$"
ExitFunction
EndIf
PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")
SetxmlHttp=nothing
EndFunction
==================================================
函数名：UrlEncoding
作用：转换编码
==================================================
FunctionUrlEncoding(DataStr)
DimStrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrReturn=""
ForSi=1ToLen(DataStr)
ThisChr=Mid(DataStr,Si,1)
IfAbs(Asc(ThisChr))<&HFFThen
StrReturn=StrReturn&ThisChr
Else
InnerCode=Asc(ThisChr)
IfInnerCode<0Then
InnerCode=InnerCode+&H10000
EndIf
Hight8=(InnerCodeAnd&HFF00)&HFF
Low8=InnerCodeAnd&HFF
StrReturn=StrReturn&"%"&Hex(Hight8)&"%"&Hex(Low8)
EndIf
Next
UrlEncoding=StrReturn
EndFunction
==================================================
函数名：GetBody
作用：截取字符串
参数：ConStr------将要截取的字符串
参数：StartStr------入手下手字符串
参数：OverStr------停止字符串
参数：IncluL------是不是包括StartStr
参数：IncluR------是不是包括OverStr
==================================================
FunctionGetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
IfConStr="$False$"orConStr=""orIsNull(ConStr)=TrueOrStartStr=""orIsNull(StartStr)=TrueOrOverStr=""orIsNull(OverStr)=TrueThen
GetBody="$False$"
ExitFunction
EndIf
DimConStrTemp
DimStart,Over
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start=InStrB(1,ConStrTemp,StartStr,vbBinaryCompare)
IfStart<=0then
GetBody="$False$"
ExitFunction
Else
IfIncluL=FalseThen
Start=Start+LenB(StartStr)
EndIf
EndIf
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
IfOver<=0OrOver<=Startthen
GetBody="$False$"
ExitFunction
Else
IfIncluR=TrueThen
Over=Over+LenB(OverStr)
EndIf
EndIf
GetBody=MidB(ConStr,Start,Over-Start)
EndFunction
<p>
==================================================
函数名：GetArray
作用：提取链接地点，以$Array$分开
参数：ConStr------提取地点的原字符
参数：StartStr------入手下手字符串
参数：OverStr------停止字符串
参数：IncluL------是不是包括StartStr
参数：IncluR------是不是包括OverStr
==================================================
FunctionGetArray(ByvalConStr,StartStr,OverStr,IncluL,IncluR)
IfConStr="$False$"orConStr=""OrIsNull(ConStr)=TrueorStartStr=""OrOverStr=""orIsNull(StartStr)=TrueOrIsNull(OverStr)=TrueThen
GetArray="$False$"
ExitFunction
EndIf
DimTempStr,TempStr2,objRegExp,Matches,Match
TempStr=""
SetobjRegExp=NewRegexp
objRegExp.IgnoreCase=True
objRegExp.Global=True
objRegExp.Pattern="("&StartStr&").+?("&OverStr&")"
SetMatches=objRegExp.Execute(ConStr)
ForEachMatchinMatches
TempStr=TempStr&"$Array$"&Match.Value
Next
SetMatches=nothing
IfTempStr=""Then
GetArray="$False$"
ExitFunction
EndIf
TempStr=Right(TempStr,Len(TempStr)-7)
IfIncluL=Falsethen
objRegExp.Pattern=StartStr
TempStr=objRegExp.Replace(TempStr,"")
Endif
IfIncluR=Falsethen
objRegExp.Pattern=OverStr
TempStr=objRegExp.Replace(TempStr,"")
Endif
SetobjRegExp=nothing
SetMatches=nothing
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"","")
TempStr=Replace(TempStr,"","")
TempStr=Replace(TempStr,"(","")
TempStr=Replace(TempStr,")","")
IfTempStr=""then
GetArray="$False$"
Else
GetArray=TempStr
Endif
EndFunction
==================================================
函数名：DefiniteUrl
作用：将绝对地点转换为相对地点
参数：PrimitiveUrl------要转换的绝对地点
参数：ConsultUrl------以后网页地点
==================================================
FunctionDefiniteUrl(ByvalPrimitiveUrl,ByvalConsultUrl)
DimConTemp,PriTemp,Pi,Ci,PriArray,ConArray
IfPrimitiveUrl=""orConsultUrl=""orPrimitiveUrl="$False$"orConsultUrl="$False$"Then
DefiniteUrl="$False$"
ExitFunction
EndIf
IfLeft(Lcase(ConsultUrl),7)"http://"Then
ConsultUrl="http://"&ConsultUrl
EndIf
ConsultUrl=Replace(ConsultUrl,"","/")
ConsultUrl=Replace(ConsultUrl,"://",":")
PrimitiveUrl=Replace(PrimitiveUrl,"","/")
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(LCase(PrimitiveUrl),7)="http://"then
DefiniteUrl=Replace(PrimitiveUrl,"://",":")
ElseIfLeft(PrimitiveUrl,1)="/"Then
DefiniteUrl=ConArray(0)&PrimitiveUrl
ElseIfLeft(PrimitiveUrl,2)="./"Then
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-2)
IfRight(ConsultUrl,1)="/"Then
DefiniteUrl=ConsultUrl&PrimitiveUrl
Else
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/"))&PrimitiveUrl
EndIf
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(LCase(PrimitiveUrl),3)=".cn"orright(LCase(PrimitiveUrl),3)="com"orright(LCase(PrimitiveUrl),3)="net"orright(LCase(PrimitiveUrl),3)="org"Then
DefiniteUrl="http:"&PrimitiveUrl&"/"
Else
DefiniteUrl=ConsultUrl&PrimitiveUrl
EndIf
Else
Ifright(LCase(PrimitiveUrl),3)=".cn"orright(LCase(PrimitiveUrl),3)="com"orright(LCase(PrimitiveUrl),3)="net"orright(LCase(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------要交换的字符串
参数：SaveTf------是不是保留文件，False不保留，True保留
参数:TistUrl------以后网页地点
==================================================
FunctionReplaceSaveRemoteFile(ConStr,InstallPath,strChannelDir,SaveTf,TistUrl)
IfConStr="$False$"orConStr=""orInstallPath=""orstrChannelDir=""Then
ReplaceSaveRemoteFile=ConStr
ExitFunction
EndIf
DimTempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
SetRe=NewRegexp
Re.IgnoreCase=True
Re.Global=True
Re.Pattern="<img.+?>"
SetMatches=Re.Execute(ConStr)
ForEachMatchinMatches
IfTempStr""then
TempStr=TempStr&"$Array$"&Match.Value
Else
TempStr=Match.Value
Endif
Next
IfTempStr""Then
TempArray=Split(TempStr,"$Array$")
TempStr=""
ForTempi=0ToUbound(TempArray)
Re.Pattern="srcs*=s*.+?.(gifjpgbmpjpegpsdpngsvgdxfwmftiff)"
SetMatches=Re.Execute(TempArray(Tempi))
ForEachMatchinMatches
IfTempStr""then
TempStr=TempStr&"$Array$"&Match.Value
Else
TempStr=Match.Value
Endif
Next
Next
Endif
IfTempStr""Then
Re.Pattern="srcs*=s*"
TempStr=Re.Replace(TempStr,"")
EndIf
SetMatches=nothing
SetRe=nothing
IfTempStr=""orIsNull(TempStr)=TrueThen
ReplaceSaveRemoteFile=ConStr
Exitfunction
Endif
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"","")
TempStr=Replace(TempStr,"","")
DimRemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path
DtNow=Now()
***********************************
IfSaveTf=Truethen
SavePath=InstallPath&strChannelDir
IfCheckDir(InstallPath&strChannelDir)=FalseThen
IfNotCreateMultiFolder(InstallPath&strChannelDir)Then
response.WriteInstallPath&strChannelDir&"目次创立掉败"
SaveTf=False
EndIf
EndIf
EndIf
往失落反复图片入手下手
TempArray=Split(TempStr,"$Array$")
TempStr=""
ForTempi=0ToUbound(TempArray)
IfInstr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1Then
TempStr=TempStr&"$Array$"&TempArray(Tempi)
EndIf
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,"$Array$")
往失落反复图片停止
response.Write"<br>发明图片:<br>"&Replace(TempStr,"$Array$","<br>")
转换绝对图片地点开始
TempStr=""
ForTempi=0ToUbound(TempArray)
TempStr=TempStr&"$Array$"&DefiniteUrl(TempArray(Tempi),TistUrl)
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),"")
TempArray2=Split(TempStr,"$Array$")
TempStr=""
转换绝对图片地点结束
图片交换/保留
SetRe=NewRegexp
Re.IgnoreCase=True
Re.Global=True
ForTempi=0ToUbound(TempArray2)
********************************
RemoteFileUrl=TempArray2(Tempi)
IfRemoteFileUrl"$False$"AndSaveTf=TrueThen保留图片
ArrSaveFileName=Split(RemoteFileurl,".")
strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))文件范例
IfstrFileType="asp"orstrFileType="asa"orstrFileType="aspx"orstrFileType="cer"orstrFileType="cdx"orstrFileType="exe"orstrFileType="rar"orstrFileType="zip"then
UploadFiles=""
ReplaceSaveRemoteFile=ConStr
ExitFunction
EndIf
Randomize
RanNum=Int(900*Rnd)+100
strFileName=year(DtNow)&right("0"&month(DtNow),2)&right("0"&day(DtNow),2)&right("0"&hour(DtNow),2)&right("0"&minute(DtNow),2)&right("0"&second(DtNow),2)&ranNum&"."&strFileType
Re.Pattern=TempArray(Tempi)
response.Write"<br>保留到当地地点:"&InstallPath&strChannelDir&strFileName
IfSaveRemoteFile(InstallPath&strChannelDir&strFileName,RemoteFileUrl,RemoteFileUrl)=TrueThen
response.Write"<fontcolor=blue>乐成</font><br>"
PathTemp=InstallPath&strChannelDir&strFileName
ConStr=Re.Replace(ConStr,PathTemp)
Re.Pattern=InstallPath&strChannelDir
UploadFiles=UploadFiles&""&InstallPath&strChannelDir&strFileName
Else
PathTemp=RemoteFileUrl
ConStr=Re.Replace(ConStr,PathTemp)
EndIf
ElseIfRemoteFileurl"$False$"andSaveTf=FalseThen不保留图片
Re.Pattern=TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
EndIf
********************************
Next
SetRe=nothing
ReplaceSaveRemoteFile=ConStr
Endfunction
==================================================
函数名：ReplaceSwfFile
作用：剖析动画路径
参数：ConStr------要交换的字符串
参数:TistUrl------以后网页地点
==================================================
FunctionReplaceSwfFile(ConStr,TistUrl)
IfConStr="$False$"orConStr=""orTistUrl=""orTistUrl="$False$"Then
ReplaceSwfFile=ConStr
ExitFunction
EndIf
DimTempStr,TempStr2,TempStr3,Re,Matches,Match,Tempi,TempArray,TempArray2
SetRe=NewRegexp
Re.IgnoreCase=True
Re.Global=True
Re.Pattern="<object.+?[^>]>"
SetMatches=Re.Execute(ConStr)
ForEachMatchinMatches
IfTempStr""then
TempStr=TempStr&"$Array$"&Match.Value
Else
TempStr=Match.Value
Endif
Next
IfTempStr""Then
TempArray=Split(TempStr,"$Array$")
TempStr=""
ForTempi=0ToUbound(TempArray)
Re.Pattern="values*=s*.+?.swf"
SetMatches=Re.Execute(TempArray(Tempi))
ForEachMatchinMatches
IfTempStr""then
TempStr=TempStr&"$Array$"&Match.Value
Else
TempStr=Match.Value
Endif
Next
Next
Endif
IfTempStr""Then
Re.Pattern="values*=s*"
TempStr=Re.Replace(TempStr,"")
EndIf
IfTempStr=""orIsNull(TempStr)=TrueThen
ReplaceSwfFile=ConStr
Exitfunction
Endif
TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"","")
TempStr=Replace(TempStr,"","")
SetMatches=nothing
SetRe=nothing
往失落反复文件入手下手
TempArray=Split(TempStr,"$Array$")
TempStr=""
ForTempi=0ToUbound(TempArray)
IfInstr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1Then
TempStr=TempStr&"$Array$"&TempArray(Tempi)
EndIf
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,"$Array$")
往失落反复文件停止
转换绝对地点入手下手
TempStr=""
ForTempi=0ToUbound(TempArray)
TempStr=TempStr&"$Array$"&DefiniteUrl(TempArray(Tempi),TistUrl)
Next
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),"")
TempArray2=Split(TempStr,"$Array$")
TempStr=""
转换绝对地点停止
交换
SetRe=NewRegexp
Re.IgnoreCase=True
Re.Global=True
ForTempi=0ToUbound(TempArray2)
RemoteFileUrl=TempArray2(Tempi)
Re.Pattern=TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
Next
SetRe=nothing
ReplaceSwfFile=ConStr
Endfunction
==================================================
历程名：SaveRemoteFile
作用：保留远程的文件到当地
参数：LocalFileName------当地文件名
参数：RemoteFileUrl------远程文件URL
参数：Referer------远程挪用文件（凑合防收罗的，用内容页地点，没有防的留空）
==================================================
FunctionSaveRemoteFile(LocalFileName,RemoteFileUrl,Referer)
SaveRemoteFile=True
dimAds,Retrieval,GetRemoteData
SetRetrieval=Server.CreateObject("Microsoft.XMLHTTP")
WithRetrieval
.Open"Get",RemoteFileUrl,False,"",""
ifReferer""then.setRequestHeader"Referer",Referer
.Send
If.Readystate4then
SaveRemoteFile=False
ExitFunction
EndIf
GetRemoteData=.ResponseBody
EndWith
SetRetrieval=Nothing
SetAds=Server.CreateObject("Adodb.Stream")
WithAds
.Type=1
.Open
.WriteGetRemoteData
.SaveToFileserver.MapPath(LocalFileName),2
.Cancel()
.Close()
EndWith
SetAds=nothing
endFunction
==================================================
函数名：GetPaing
作用：猎取分页
==================================================
FunctionGetPaing(ByvalConStr,StartStr,OverStr,IncluL,IncluR)
IfConStr="$False$"orConStr=""OrStartStr=""OrOverStr=""orIsNull(ConStr)=TrueorIsNull(StartStr)=TrueOrIsNull(OverStr)=TrueThen
GetPaing="$False$"
ExitFunction
EndIf
DimStart,Over,ConTemp,TempStr
TempStr=LCase(ConStr)
StartStr=LCase(StartStr)
OverStr=LCase(OverStr)
Over=Instr(1,TempStr,OverStr)
IfOver<=0Then
GetPaing="$False$"
ExitFunction
Else
IfIncluR=TrueThen
Over=Over+Len(OverStr)
EndIf
EndIf
TempStr=Mid(TempStr,1,Over)
Start=InstrRev(TempStr,StartStr)
IfIncluL=FalseThen
Start=Start+Len(StartStr)
EndIf
IfStart<=0OrStart>=OverThen
GetPaing="$False$"
ExitFunction
EndIf
ConTemp=Mid(ConStr,Start,Over-Start)
ConTemp=Trim(ConTemp)
ConTemp=Replace(ConTemp,"","")
ConTemp=Replace(ConTemp,",","")
ConTemp=Replace(ConTemp,"","")
ConTemp=Replace(ConTemp,"""","")
ConTemp=Replace(ConTemp,">","")
ConTemp=Replace(ConTemp,"<","")
ConTemp=Replace(ConTemp,"","")
GetPaing=ConTemp
EndFunction
*************************************************
函数名：gotTopic
作用：截字符串，汉字一个算两个字符，英文算一个字符
参数：str----原字符串
strlen----截取长度
前往值：截取后的字符串
*************************************************
functiongotTopic(str,strlen)
ifstr=""then
gotTopic=""
exitfunction
endif
diml,t,c,i
str=replace(replace(replace(replace(str,"",""),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
fori=1tol
c=Abs(Asc(Mid(str,i,1)))
ifc>255then
t=t+2
else
t=t+1
endif
ift>=strlenthen
gotTopic=left(str,i)&"…"
exitfor
else
gotTopic=str
endif
next
gotTopic=replace(replace(replace(replace(gotTopic,"",""),chr(34),"""),">",">"),"<","<")
endfunction
***********************************************
函数名：JoinChar
作用：向地点中到场?或&
参数：strUrl----网址
前往值：加了?或&的网址
***********************************************
functionJoinChar(strUrl)
ifstrUrl=""then
JoinChar=""
exitfunction
endif
ifInStr(strUrl,"?")<len(strUrl)then
ifInStr(strUrl,"?")>1then
ifInStr(strUrl,"&")<len(strUrl)then
JoinChar=strUrl&"&"
else
JoinChar=strUrl
endif
else
JoinChar=strUrl&"?"
endif
else
JoinChar=strUrl
endif
endfunction
**************************************************
函数名：CreateKeyWord
作用：由给定的字符串生成关头字
参数：Constr---要天生关头字的原字符串
前往值：天生的关头字
**************************************************
FunctionCreateKeyWord(byvalConstr,Num)
IfConstr=""orIsNull(Constr)=TrueorConstr="$False$"Then
CreateKeyWord="$False$"
ExitFunction
EndIf
IfNum=""orIsNumeric(Num)=FalseThen
Num=2
EndIf
Constr=Replace(Constr,CHR(32),"")
Constr=Replace(Constr,CHR(9),"")
Constr=Replace(Constr,"","")
Constr=Replace(Constr,"","")
Constr=Replace(Constr,"(","")
Constr=Replace(Constr,")","")
Constr=Replace(Constr,"<","")
Constr=Replace(Constr,">","")
Constr=Replace(Constr,"""","")
Constr=Replace(Constr,"?","")
Constr=Replace(Constr,"*","")
Constr=Replace(Constr,"","")
Constr=Replace(Constr,",","")
Constr=Replace(Constr,".","")
Constr=Replace(Constr,"/","")
Constr=Replace(Constr,"","")
Constr=Replace(Constr,"-","")
Constr=Replace(Constr,"@","")
Constr=Replace(Constr,"#","")
Constr=Replace(Constr,"$","")
Constr=Replace(Constr,"%","")
Constr=Replace(Constr,"&","")
Constr=Replace(Constr,"+","")
Constr=Replace(Constr,":","")
Constr=Replace(Constr,"：","")
Constr=Replace(Constr,"‘","")
Constr=Replace(Constr,"“","")
Constr=Replace(Constr,"”","")
Dimi,ConstrTemp
Fori=1ToLen(Constr)
ConstrTemp=ConstrTemp&""&Mid(Constr,i,Num)
Next
IfLen(ConstrTemp)<254Then
ConstrTemp=ConstrTemp&""
Else
ConstrTemp=Left(ConstrTemp,254)&""
EndIf
CreateKeyWord=ConstrTemp
EndFunction
==================================================
函数名：CheckUrl
作用：反省Url
参数：strUrl------要反省Url
==================================================
FunctionCheckUrl(strUrl)
DimRe
SetRe=newRegExp
Re.IgnoreCase=true
Re.Global=True
Re.Pattern="http://(+.)++(/*)?"
IfRe.test(strUrl)=TrueThen
CheckUrl=strUrl
Else
CheckUrl="$False$"
EndIf
SetRs=Nothing
EndFunction
==================================================
函数名：ScriptHtml
作用：过滤html标志
参数：ConStr------要过滤的字符串
==================================================
FunctionScriptHtml(ByvalConStr,TagName,FType)
DimRe
SetRe=newRegExp
Re.IgnoreCase=true
Re.Global=True
SelectCaseFType
Case1
Re.Pattern="<"&TagName&"([^>])*>"
ConStr=Re.Replace(ConStr,"")
Case2
Re.Pattern="<"&TagName&"([^>])*>.*?</"&TagName&"([^>])*>"
ConStr=Re.Replace(ConStr,"")
Case3
Re.Pattern="<"&TagName&"([^>])*>"
ConStr=Re.Replace(ConStr,"")
Re.Pattern="</"&TagName&"([^>])*>"
ConStr=Re.Replace(ConStr,"")
EndSelect
ScriptHtml=ConStr
SetRe=Nothing
EndFunction
==================================================
函数名：RemoveHTML
作用：完整往除html标志
参数：strHTML------要过滤的字符串
==================================================
FunctionRemoveHTML(strHTML)
DimobjRegExp,Match,Matches
SetobjRegExp=NewRegexp
objRegExp.IgnoreCase=True
objRegExp.Global=True
取闭合的
objRegExp.Pattern="<.+?>"
举行婚配
SetMatches=objRegExp.Execute(strHTML)
遍历婚配汇合，并交换失落婚配的项目
ForEachMatchinMatches
strHtml=Replace(strHTML,Match.Value,"")
Next
RemoveHTML=strHTML
SetobjRegExp=Nothing
EndFunction
==================================================
函数名：CheckDir
作用：反省文件夹是不是存在
参数：FolderPath------文件夹路径
==================================================
FunctionCheckDir(byvalFolderPath)
dimfso
Setfso=Server.CreateObject("Scripting.FileSystemObject")
Iffso.FolderExists(Server.MapPath(folderpath))then
存在
CheckDir=True
Else
不存在
CheckDir=False
Endif
Setfso=nothing
EndFunction
==================================================
函数名：MakeNewsDir
作用：创立文件夹
参数：foldername------文件夹名
==================================================
FunctionMakeNewsDir(byvalfoldername)
dimfso
Setfso=Server.CreateObject("Scri"&"pti"&"ng.Fil"&"eSyst"&"emOb"&"ject")
fso.CreateFolder(Server.MapPath(foldername))
Iffso.FolderExists(Server.MapPath(foldername))Then
MakeNewsDir=True
Else
MakeNewsDir=False
EndIf
Setfso=nothing
EndFunction
==================================================
函数名：DelDir
作用：创立文件夹
参数：foldername------文件夹名
==================================================
FunctionDelDir(byvalfoldername)
dimfso
Setfso=Server.CreateObject("Scri"&"pti"&"ng.Fil"&"eSyst"&"emOb"&"ject")
Iffso.FolderExists(Server.MapPath(foldername))Then判别文件夹是不是存在
fso.DeleteFolder(Server.MapPath(foldername))删除文件夹
EndIf
Setfso=nothing
EndFunction
**************************************************
函数名：IsObjInstalled
作用：反省组件是不是已安装
参数：strClassString----组件名
前往值：True----已安装
False----没有安装
**************************************************
FunctionIsObjInstalled(strClassString)
IsObjInstalled=False
Err=0
DimxTestObj
SetxTestObj=Server.CreateObject(strClassString)
If0=ErrThenIsObjInstalled=True
SetxTestObj=Nothing
Err=0
EndFunction
<p>**************************************************
函数名：strLength
作用：求字符串长度。汉字算两个字符，英文算一个字符。
参数：str----请求长度的字符串
前往值：字符串长度
**************************************************
functionstrLength(str)
ONERRORRESUMENEXT
dimWINNT_CHINESE
WINNT_CHINESE=(len("中国")=2)
ifWINNT_CHINESEthen
diml,t,c
dimi
l=len(str)
t=l
fori=1tol
c=asc(mid(str,i,1))
ifc<0thenc=c+65536
ifc>255then
t=t+1
endif
&nbsasp可以轻松地实现对页面内容的动态控制，根据不同的浏览者，显示不同的页面内容。而浏览者一点觉察不出来，就像为他专门制作的页面一样。使用各种各样的组件，asp可以完成无比强大的功能。 我们必须明确一个大方向，不要只是停留在因为学而去学,我们应有方向应有目标. Request:从字面上讲就是“请求”，因此这个是处理客户端提交的东东的,例如Resuest.Form，Request.QueryString,或者干脆Request("变量名") 以上是语言本身的弱点，在功能方面ASP同样存在问题，第一是功能太弱，一些底层操作只能通过组件来完成，在这点上是远远比不上PHP/JSP，其次就是缺乏完善的纠错/调试功能，这点上ASP/PHP/JSP差不多。 完全不知道到底自己学的是什么。最后，除了教程里面说的几个例子，还是什么都不会。 运用ASP可将VBscript、javascript等脚本语言嵌入到HTML中，便可快速完成网站的应用程序，无需编译，可在服务器端直接执行。容易编写，使用普通的文本编辑器编写，如记事本就可以完成。由脚本在服务器上而不是客户端运行，ASP所使用的脚本语言都在服务端上运行。 虽然ASP也有很多网络教程。但是这些都不系统。都是半路出家，只是从一个例子告诉你怎么用。不会深入讨论，更不会将没有出现在例子里的方法都一一列举出来。 尽管MS自己讲C#内核中更多的象VC，但实际上我还是认为它和Java更象一些吧。首先它是面向对象的编程语言，而不是一种脚本，所以它具有面向对象编程语言的一切特性，比如封装性、继承性、多态性等等，这就解决了刚才谈到的ASP的那些弱点。 多看多学多思。多看一些关于ASP的书籍，一方面可以扩展知识面一方面可以鉴借别人是如何掌握、运用ASP的;多学善于关注别人，向同学老师多多学习，不论知识的大小;多思则是要将学到的知识灵活运用。
页:
[1]