|
复制代码 代码如下: <% ================================================== 过程名Admin_ShowChannel_Name 作用显示频道名称 参数ChannelID频道ID ================================================== SubAdmin_ShowChannel_Name(ChannelID) DimSqlcRscTempStr ChannelID=Clng(ChannelID) Sqlc=selecttopChannelNamefromCl_ChannelWhereChannelID=&ChannelID SetRsc=serverCreateObject(adodbrecordset) OpenConn:RscopenSqlcConn IfRscEofandRscBofthen TempStr=无指定频道 Else TempStr=Rsc(ChannelName) Endif RscClose:SetRsc=Nothing responsewriteTempStr EndSub ================================================== 过程名Admin_ShowChannel_Option 作用显示频道选项 参数ChannelID频道ID ================================================== SubAdmin_ShowChannel_Option(ChannelID) DimSqlcRscChannelNameTempStr ChannelID=Clng(ChannelID) Sqlc=selectChannelIDChannelNamefromCl_ChannelwhereChannelID>andChannelID<>and ChannelType<andModuleID= SetRsc=serverCreateObject(adodbrecordset) OpenConn:RscOpenSqlcConn TempStr=<optionvalue=>请选择频道</option> IfRscEofandRscBofThen TempStr=TempStr&<optionvalue=>请添加频道</option> Else DowhilenotRscEof TempStr=TempStr&<optionvalue=&&Rsc(ChannelID)&& IfChannelID=Rsc(ChannelID)Then TempStr=TempStr&Selected EndIf TempStr=TempStr&>&Rsc(ChannelName) TempStr=TempStr&</option> RscMovenext Loop Endif RscClose SetRsc=Nothing ResponseWriteTempStr Endsub ================================================== 过程名Admin_ShowClass_Name 作用显示栏目名称 参数ChannelID频道ID 参数ClassID栏目ID ================================================== SubAdmin_ShowClass_Name(ChannelIDClassID) DimSqlCRsCTempStr ChannelID=Clng(ChannelID) ClassID=Clng(ClassID) Sqlc=SelecttopClassNamefromCl_ClassWhereChannelID=&ChannelID&andClassID=&ClassID SetRsC=serverCreateObject(adodbrecordset) OpenConn:RsCOpenSqlCConn IfRsCEofAndRsCBofThen TempStr=无指定栏目 Else TempStr=RsC(ClassName) Endif RsCClose:SetRsC=Nothing ResponseWriteTempStr EndSub ================================================== 过程名Admin_ShowSpecial_Name 作用显示专题名称 参数ChannelID频道ID 参数SpecialID专题ID ================================================== SubAdmin_ShowSpecial_Name(ChannelIDSpecialID) DimSqlcRscTempStr ChannelID=Clng(ChannelID) SpecialID=Clng(SpecialID) Sqlc=selecttopSpecialNamefromCl_SpecialWhereSpecialID=&SpecialID SetRsc=serverCreateObject(adodbrecordset) OpenConn:RscopenSqlcConn IfRscEofandRscBofthen TempStr=无指定专题 Else TempStr=Rsc(SpecialName) Endif RscClose:SetRsc=Nothing ResponseWriteTempStr EndSub ================================================== 过程名Admin_ShowItem_Name 作用显示项目名称 参数ItemID项目ID ================================================== SubAdmin_ShowItem_Name(ItemID) DimSqlcRscTempStr ItemID=Clng(ItemID) Sqlc=selecttopItemNamefromItemWhereItemID=&ItemID SetRsc=serverCreateObject(adodbrecordset) RscopenSqlcConnItem IfRscEofandRscBofthen TempStr=无指定项目 Else TempStr=Rsc(ItemName) Endif RscClose:SetRsc=Nothing ResponseWriteTempStr EndSub ================================================== 过程名Admin_ShowItem_Option 作用显示项目选项 参数ItemID项目ID ================================================== SubAdmin_ShowItem_Option(ItemID) DimSqlIRsITempStr ItemID=Clng(ItemID) SqlI=selectItemIDItemNamefromItemorderbyItemIDdesc SetRsI=serverCreateObject(adodbrecordset) RsIOpenSqlIConnItem TempStr=<selectName=ItemIDID=ItemID> IfRsIEofandRsIBofThen TempStr=TempStr&<optionvalue=>请添加项目</option> Else TempStr=TempStr&<optionvalue=>请选择项目</option> DowhilenotRsIEof TempStr=TempStr&<optionvalue=&&RsI(ItemID)&& IfItemID=RsI(ItemID)Then TempStr=TempStr&Selected EndIf TempStr=TempStr&>&RsI(ItemName) TempStr=TempStr&</option> RsIMovenext Loop Endif RsIClose SetRsI=Nothing TempStr=TempStr&</select> ResponseWriteTempStr Endsub ================================================== 函数名GetHttpPage 作用获取网页源码 参数HttpUrl网页地址 ================================================== FunctionGetHttpPage(HttpUrl) IfIsNull(HttpUrl)=TrueOrLen(HttpUrl)<OrHttpUrl=$False$Then GetHttpPage=$False$ ExitFunction EndIf DimHttp OnErrorResumeNext SetHttp=servercreateobject(MSXMLXMLHTTP) HttpopenGETHttpUrlFalse HttpSend() IfHttpReadystate<>then SetHttp=Nothing GetHttpPage=$False$ Exitfunction Endif GetHTTPPage=bytesToBSTR(HttpresponseBodyGB) SetHttp=Nothing IfErrnumber<>thenErrClear EndFunction ================================================== 函数名BytesToBstr 作用将获取的源码转换为中文 参数Body要转换的变量 参数Cset要转换的类型 ================================================== FunctionBytesToBstr(BodyCset) DimObjstream OnErrorResumeNext SetObjstream=ServerCreateObject(Adodb&Str&eam) objstreamType= objstreamMode= objstreamOpen objstreamWritebody objstreamPosition= objstreamType= objstreamCharset=Cset BytesToBstr=objstreamReadText objstreamClose setobjstream=Nothing EndFunction ================================================== 函数名PostHttpPage 作用登录 ================================================== FunctionPostHttpPage(RefererUrlPostUrlPostData) DimxmlHttp DimRetStr OnErrorResumeNext SetxmlHttp=CreateObject(MsxmlXMLHTTP) xmlHttpOpenPOSTPostUrlFalse XmlHTTPsetRequestHeaderContentLengthLen(PostData) xmlHttpsetRequestHeaderContentTypeapplication/xwwwformurlencoded xmlHttpsetRequestHeaderRefererRefererUrl xmlHttpSendPostData IfErrNumber<>Then SetxmlHttp=Nothing PostHttpPage=$False$ ExitFunction EndIf PostHttpPage=bytesToBSTR(xmlHttpresponseBodyGB) SetxmlHttp=Nothing EndFunction ================================================== 函数名UrlEncoding 作用转换编码 ================================================== FunctionUrlEncoding(DataStr) DimStrReturnSiThisChrInnerCodeHightLow StrReturn= ForSi=ToLen(DataStr) ThisChr=Mid(DataStrSi) IfAbs(Asc(ThisChr))<&HFFThen StrReturn=StrReturn&ThisChr Else InnerCode=Asc(ThisChr) IfInnerCode<Then InnerCode=InnerCode+&H EndIf Hight=(InnerCodeAnd&HFF)\&HFF Low=InnerCodeAnd&HFF StrReturn=StrReturn&%&Hex(Hight)&%&Hex(Low) EndIf Next UrlEncoding=StrReturn EndFunction ================================================== 函数名GetBody 作用截取字符串 参数ConStr将要截取的字符串 参数StartStr开始字符串 参数OverStr结束字符串 参数IncluL是否包含StartStr 参数IncluR是否包含OverStr ================================================== FunctionGetBody(ConStrStartStrOverStrIncluLIncluR) IfConStr=$False$orConStr=orIsNull(ConStr)=TrueOrStartStr=orIsNull(StartStr)=TrueOr OverStr=orIsNull(OverStr)=TrueThen GetBody=$False$ ExitFunction EndIf DimConStrTemp DimStartOver ConStrTemp=Lcase(ConStr) StartStr=Lcase(StartStr) OverStr=Lcase(OverStr) Start=InStrB(ConStrTempStartStrvbBinaryCompare) IfStart<=then GetBody=$False$ ExitFunction Else IfIncluL=FalseThen Start=Start+LenB(StartStr) EndIf EndIf Over=InStrB(StartConStrTempOverStrvbBinaryCompare) IfOver<=OrOver<=Startthen GetBody=$False$ ExitFunction Else IfIncluR=TrueThen Over=Over+LenB(OverStr) EndIf EndIf GetBody=MidB(ConStrStartOverStart) EndFunction ================================================== 函数名GetArray 作用提取链接地址以$Array$分隔 参数ConStr提取地址的原字符 参数StartStr开始字符串 参数OverStr结束字符串 参数IncluL是否包含StartStr 参数IncluR是否包含OverStr ================================================== FunctionGetArray(ByvalConStrStartStrOverStrIncluLIncluR) IfConStr=$False$orConStr=OrIsNull(ConStr)=TrueorStartStr=OrOverStr=orIsNull (StartStr)=TrueOrIsNull(OverStr)=TrueThen GetArray=$False$ ExitFunction EndIf DimTempStrTempStrobjRegExpMatchesMatch TempStr= SetobjRegExp=NewRegexp objRegExpIgnoreCase=True objRegExpGlobal=True objRegExpPattern=(&StartStr&)+?(&OverStr&) SetMatches=objRegExpExecute(ConStr) ForEachMatchinMatches TempStr=TempStr&$Array$&MatchValue Next SetMatches=Nothing IfTempStr=Then GetArray=$False$ ExitFunction EndIf TempStr=Right(TempStrLen(TempStr)) IfIncluL=Falsethen objRegExpPattern=StartStr TempStr=objRegExpReplace(TempStr) Endif IfIncluR=Falsethen objRegExpPattern=OverStr TempStr=objRegExpReplace(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 |
