创力采集程序用到的函数 推荐第1/3页

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 ------要转换的类型
''=======================================