音效素材网提供各类素材，打造精品素材网站！

站内导航 站长工具 投稿中心 手机访问

音效素材

热门搜索： 狗叫声 打雷 钟声 wordpress模板 图标素材
网页制作|编程语言|产品运营|平面设计|操作系统|数据库|服务器|
当前位置：首页 > 教程 > 编程语言 > ASP编程 > 创力采集程序用到的函数 推荐第1/3页

创力采集程序用到的函数 推荐第1/3页
日期：2021-09-05 21:44:04   来源：脚本之家

复制代码 代码如下:

<%
'==================================================
'过程名：Admin_ShowChannel_Name
'作  用：显示频道名称
'参  数：ChannelID ------频道ID
'==================================================
Sub Admin_ShowChannel_Name(ChannelID)
   Dim Sqlc,Rsc,TempStr
   ChannelID=Clng(ChannelID)
   Sqlc ="select top 1 ChannelName from Cl_Channel Where ChannelID=" & ChannelID   
   Set Rsc=server.CreateObject("adodb.recordset")
   OpenConn : Rsc.open Sqlc,Conn,1,1
   If Rsc.Eof and Rsc.Bof then
      TempStr="无指定频道"   
   Else   
      TempStr=Rsc("ChannelName")
   End if
   Rsc.Close : Set Rsc=Nothing
   response.write TempStr
End Sub

'==================================================
'过程名：Admin_ShowChannel_Option
'作  用：显示频道选项
'参  数：ChannelID ------频道ID
'==================================================
Sub Admin_ShowChannel_Option(ChannelID)
   Dim Sqlc,Rsc,ChannelName,TempStr
   ChannelID=Clng(ChannelID)
   Sqlc ="select ChannelID,ChannelName from Cl_Channel where ChannelID>0 and ChannelID<>6 and 
ChannelType<2 and ModuleID=1"
   Set Rsc=server.CreateObject("adodb.recordset")
   OpenConn : Rsc.Open Sqlc,Conn,1,1
   TempStr="<option value=""0"">请选择频道</option>"
   If Rsc.Eof and Rsc.Bof Then
      TempStr=TempStr & "<option value=""0"">请添加频道</option>"   
   Else
      Do while not Rsc.Eof   
         TempStr=TempStr & "<option value=" & """" & Rsc("ChannelID") & """" & "" 
         If ChannelID=Rsc("ChannelID") Then
            TempStr=TempStr & " Selected"
         End If
         TempStr=TempStr & ">" & Rsc("ChannelName")
         TempStr=TempStr & "</option>"  
      Rsc.Movenext   
      Loop   
   End if
   Rsc.Close   
   Set Rsc=Nothing   
   Response.Write TempStr   
End sub 


'==================================================
'过程名：Admin_ShowClass_Name
'作  用：显示栏目名称
'参  数：ChannelID ------频道ID
'参  数：ClassID ------栏目ID
'==================================================
Sub Admin_ShowClass_Name(ChannelID,ClassID)   
   Dim SqlC,RsC,TempStr
   ChannelID=Clng(ChannelID)
   ClassID=Clng(ClassID)
   Sqlc ="Select top 1 ClassName from Cl_Class Where ChannelID=" & ChannelID & " and ClassID=" & ClassID   
   Set RsC=server.CreateObject("adodb.recordset")   
   OpenConn : RsC.Open SqlC,Conn,1,1   
   If RsC.Eof And RsC.Bof Then   
      TempStr="无指定栏目"   
   Else   
      TempStr=RsC("ClassName")
   End if   
   RsC.Close : Set RsC=Nothing
   Response.Write TempStr   
End Sub  

'==================================================
'过程名：Admin_ShowSpecial_Name
'作  用：显示专题名称
'参  数：ChannelID ------频道ID
'参  数：SpecialID ------专题ID
'==================================================
Sub Admin_ShowSpecial_Name(ChannelID,SpecialID)   
   Dim Sqlc,Rsc,TempStr
   ChannelID=Clng(ChannelID)
   SpecialID=Clng(SpecialID)
   Sqlc ="select top 1 SpecialName from Cl_Special Where SpecialID=" & SpecialID   
   Set Rsc=server.CreateObject("adodb.recordset")   
   OpenConn : Rsc.open Sqlc,Conn,1,1   
   If Rsc.Eof and Rsc.Bof then   
      TempStr="无指定专题"   
   Else   
      TempStr=Rsc("SpecialName")
   End if   
   Rsc.Close : Set Rsc=Nothing
   Response.Write TempStr   
End Sub  

'==================================================
'过程名：Admin_ShowItem_Name
'作  用：显示项目名称
'参  数：ItemID ------项目ID
'==================================================
Sub Admin_ShowItem_Name(ItemID)   
   Dim Sqlc,Rsc,TempStr
   ItemID=Clng(ItemID)
   Sqlc ="select top 1 ItemName from Item Where ItemID=" & ItemID   
   Set Rsc=server.CreateObject("adodb.recordset")   
   Rsc.open Sqlc,ConnItem,1,1   
   If Rsc.Eof and Rsc.Bof then   
      TempStr="无指定项目"   
   Else   
      TempStr=Rsc("ItemName")
   End if   
   Rsc.Close : Set Rsc=Nothing
   Response.Write TempStr   
End Sub  

'==================================================
'过程名：Admin_ShowItem_Option
'作  用：显示项目选项
'参  数：ItemID ------项目ID
'==================================================
Sub Admin_ShowItem_Option(ItemID)   
   Dim SqlI,RsI,TempStr
   ItemID=Clng(ItemID)
   SqlI ="select ItemID,ItemName from Item order by ItemID desc"   
   Set RsI=server.CreateObject("adodb.recordset")   
   RsI.Open SqlI,ConnItem,1,1
   TempStr="<select Name=""ItemID"" ID=""ItemID"">"   
   If RsI.Eof and RsI.Bof Then
      TempStr=TempStr & "<option value=""0"">请添加项目</option>"   
   Else   
      TempStr=TempStr & "<option value=""0"">请选择项目</option>"
      Do while not RsI.Eof   
         TempStr=TempStr & "<option value=" & """" & RsI("ItemID") & """" & "" 
         If ItemID=RsI("ItemID") Then
            TempStr=TempStr & " Selected"
         End If
         TempStr=TempStr & ">" & RsI("ItemName")
         TempStr=TempStr & "</option>"  
      RsI.Movenext   
      Loop   
   End if
   RsI.Close   
   Set RsI=Nothing   
   TempStr=TempStr & "</select>"
   Response.Write TempStr   
End sub   

'==================================================
'函数名：GetHttpPage
'作  用：获取网页源码
'参  数：HttpUrl ------网页地址
'==================================================
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl)=True Or Len(HttpUrl)<18 Or HttpUrl="$False$" Then
      GetHttpPage="$False$"
      Exit Function
   End If
   Dim Http
   On Error Resume Next
   Set Http=server.createobject("MSXML2.XMLHTTP")
   Http.open "GET",HttpUrl,False
   Http.Send()
   If Http.Readystate<>4 then
      Set Http=Nothing 
      GetHttpPage="$False$"
      Exit function
   End if
   GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
   Set Http=Nothing
   If Err.number<>0 then Err.Clear
End Function

'==================================================
'函数名：BytesToBstr
'作  用：将获取的源码转换为中文
'参  数：Body ------要转换的变量
'参  数：Cset ------要转换的类型
'==================================================
Function BytesToBstr(Body,Cset)
   Dim Objstream
   On Error Resume Next
   Set Objstream = Server.CreateObject("Adodb." & "Str" & "eam")
   objstream.Type = 1
   objstream.Mode =3
   objstream.Open
   objstream.Write body
   objstream.Position = 0
   objstream.Type = 2
   objstream.Charset = Cset
   BytesToBstr = objstream.ReadText 
   objstream.Close
   set objstream = Nothing
End Function

'==================================================
'函数名：PostHttpPage
'作  用：登录
'==================================================
Function PostHttpPage(RefererUrl,PostUrl,PostData) 
    Dim xmlHttp 
    Dim RetStr
    On Error Resume Next
    Set xmlHttp = CreateObject("Msxml2.XMLHTTP")  
    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.Send PostData 
    If Err.Number <> 0 Then
        Set xmlHttp=Nothing
        PostHttpPage = "$False$"
        Exit Function
    End If
    PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")
    Set xmlHttp = Nothing
End Function 

'==================================================
'函数名：UrlEncoding
'作  用：转换编码
'==================================================
Function UrlEncoding(DataStr)
    Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
    StrReturn = ""
    For Si = 1 To Len(DataStr)
        ThisChr = Mid(DataStr,Si,1)
        If Abs(Asc(ThisChr)) < &HFF Then
            StrReturn = StrReturn & ThisChr
        Else
            InnerCode = Asc(ThisChr)
            If InnerCode < 0 Then
               InnerCode = InnerCode + &H10000
            End If
            Hight8 = (InnerCode  And &HFF00)\ &HFF
            Low8 = InnerCode And &HFF
            StrReturn = StrReturn & "%" & Hex(Hight8) &  "%" & Hex(Low8)
        End If
    Next
    UrlEncoding = StrReturn
End Function

'==================================================
'函数名：GetBody
'作  用：截取字符串
'参  数：ConStr ------将要截取的字符串
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or 
OverStr="" or IsNull(OverStr)=True Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
   GetBody=MidB(ConStr,Start,Over-Start)
End Function

'==================================================
'函数名：GetArray
'作  用：提取链接地址，以$Array$分隔
'参  数：ConStr ------提取地址的原字符
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" Or IsNull(ConStr)=True or StartStr="" Or OverStr="" or  IsNull
(StartStr)=True Or IsNull(OverStr)=True Then
      GetArray="$False$"
      Exit Function
   End If
   Dim TempStr,TempStr2,objRegExp,Matches,Match
   TempStr=""
   Set objRegExp = New Regexp 
   objRegExp.IgnoreCase = True 
   objRegExp.Global = True
   objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"
   Set Matches =objRegExp.Execute(ConStr) 
   For Each Match in Matches
      TempStr=TempStr & "$Array$" & Match.Value
   Next 
   Set Matches=Nothing

   If TempStr="" Then
      GetArray="$False$"
      Exit Function
   End If
   TempStr=Right(TempStr,Len(TempStr)-7)
   If IncluL=False then
      objRegExp.Pattern =StartStr
      TempStr=objRegExp.Replace(TempStr,"")
   End if
   If IncluR=False then
      objRegExp.Pattern =OverStr
      TempStr=objRegExp.Replace(TempStr,"")
   End if
   Set objRegExp=Nothing
   Set Matches=Nothing

   TempStr=Replace(TempStr,"""","")
   TempStr=Replace(TempStr,"'","")
   TempStr=Replace(TempStr," ","")
   TempStr=Replace(TempStr,"(","")
   TempStr=Replace(TempStr,")","")

   If TempStr="" then
      GetArray="$False$"
   Else
      GetArray=TempStr
   End if
End Function
123下一页阅读全文
    推荐
    上一篇：ASP的天空小偷
    下一篇：ASP开发中数据库文件调用的捷径

    您感兴趣的教程

    在docker中安装mysql详解

    本篇文章主要介绍了在docker中安装mysql详解，小编觉得挺不错的，现在分享给大家，也给大家做个参考。一起跟随小编...

    详解 安装 docker mysql

    win10中文输入法仅在桌面显示怎么办?

    win10中文输入法仅在桌面显示怎么办?

    win10系统使用搜狗，QQ输入法只有在显示桌面的时候才出来，在使用其他程序输入框里面却只能输入字母数字，win10中...

    win10 中文输入法

    一分钟掌握linux系统目录结构

    这篇文章主要介绍了linux系统目录结构，通过结构图和多张表格了解linux系统目录结构，感兴趣的小伙伴们可以参考一...

    结构 目录 系统 linux

    PHP程序员玩转Linux系列 Linux和Windows安装

    这篇文章主要为大家详细介绍了PHP程序员玩转Linux系列文章，Linux和Windows安装nginx教程，具有一定的参考价值，感兴趣...

    玩转 程序员 安装 系列 PHP

    win10怎么安装杜比音效Doby V4.1 win10安装杜

    第四代杜比®家庭影院®技术包含了一整套协同工作的技术，让PC 发出清晰的环绕声同时第四代杜比家庭影院技术...

    win10杜比音效

    纯CSS实现iOS风格打开关闭选择框功能

    这篇文章主要介绍了纯CSS实现iOS风格打开关闭选择框,本文通过实例代码给大家介绍的非常详细，对大家的学习或工作...

    css ios c

    Win7如何给C盘扩容 Win7系统电脑C盘扩容的办法

    Win7如何给C盘扩容 Win7系统电脑C盘扩容的

    Win7给电脑C盘扩容的办法大家知道吗？当系统分区C盘空间不足时，就需要给它扩容了，如果不管，C盘没有足够的空间...

    Win7 C盘 扩容

    百度推广竞品词的投放策略

    SEM是基于关键词搜索的营销活动。作为推广人员，我们所做的工作，就是打理成千上万的关键词，关注它们的质量度...

    百度推广 竞品词

    Visual Studio Code(vscode) git的使用教程

    这篇文章主要介绍了详解Visual Studio Code(vscode) git的使用，小编觉得挺不错的，现在分享给大家，也给大家做个参考。...

    教程 Studio Visual Code git

    七牛云储存创始人分享七牛的创立故事与

    这篇文章主要介绍了七牛云储存创始人分享七牛的创立故事与对Go语言的应用,七牛选用Go语言这门新兴的编程语言进行...

    七牛 Go语言

    Win10预览版Mobile 10547即将发布 9月19日上午

    微软副总裁Gabriel Aul的Twitter透露了 Win10 Mobile预览版10536即将发布，他表示该版本已进入内部慢速版阶段，发布时间目...

    Win10 预览版

    HTML标签meta总结,HTML5 head meta 属性整理

    移动前端开发中添加一些webkit专属的HTML5头部标签，帮助浏览器更好解析HTML代码，更好地将移动web前端页面表现出来...

    移动端html5模拟长按事件的实现方法

    这篇文章主要介绍了移动端html5模拟长按事件的实现方法的相关资料,小编觉得挺不错的，现在分享给大家，也给大家...

    移动端 html5 长按

    HTML常用meta大全(推荐)

    这篇文章主要介绍了HTML常用meta大全(推荐)，文中通过示例代码介绍的非常详细，对大家的学习或者工作具有一定的参...

    cdr怎么把图片转换成位图? cdr图片转换为位图的教程

    cdr怎么把图片转换成位图? cdr图片转换为

    cdr怎么把图片转换成位图？cdr中插入的图片想要转换成位图，该怎么转换呢？下面我们就来看看cdr图片转换为位图的...

    cdr 图片 位图

    win10系统怎么录屏?win10系统自带录屏详细教程

    win10系统怎么录屏?win10系统自带录屏详细

    当我们是使用win10系统的时候，想要录制电脑上的画面，这时候有人会想到下个第三方软件，其实可以用电脑上的自带...

    win10 系统自带录屏 详细教程

    + 更多教程 +
    精选教程
    教程标签
    fso wsh application 服务器端 文件的选择 ASP开发 注意事项 AspJpeg 破解版 百度小偷 asp真实IP 函数名称 函数功能 MDB ASP发送 XML 分页代码 ASP语法注释 vbs Asp生成HTML 最好 先锋海盗类 统计在线人数 dxy ASP在SQL Server msxml3.dll 800c0005 防止刷新 存储过程分页 类 substr 最终版 叶子asp分页类 让 交互 蓝色空间 天气小偷 UrlDeCode ASP高亮类

    关于我们

    音效素材网整合国内外优质的资源，内容涉及js效果代码，平面设计教程，网页设计教程，cms建站，网页模版等领域，提供最新的行业资讯，设计教程和素材参考学习。

    版权声明

    声明：本站发布的资源均来自互联网，仅供交流学习之用，请勿作商业用途，所有资源版权归原作者所有。如果有侵犯到您的权益，请联系本站删除，谢谢合作！

    音效素材网(YinXiaoSuCai.CN)

    Copyright © 1999-2022 音效素材网 版权所有   京ICP备11032199号-4  关于我们 | 广告合作 | 版权声明 | 联系我们 | 友情链接 | RSS订阅 |
    ASP编程JSP编程PHP编程.NET编程python编程