function.asp

很漂亮的一个网络公司的源码

<%
Private Const TableName="UserInfo"
Private Const PageSizeNum = 15
Dim recordcountNum,pagecountNum

Dim CountNum

Dim page

Dim ReteID,ReteShow

RateID = Array(0,1,2,3,4,5,6,7,8,9)
RateShow = Array("未知","1000元至2000元","2000元至3000元","3000元至4000元","4000元至5000元","5000元至6000元","6000元至7000元","7000元至9000元","10000万元以上","20000万以上")

Private Sub ShowRate(ByVal TypeID,ByVal OldRate)
Dim CountID,CountShow
	If IsArray(RateID) And IsArray(RateShow) Then
		CountID = Ubound(RateID)
		CountShow = Ubound(RateShow)
		If CountID = CountShow Then
			If TypeID = 0 Then
				For ForI = 0 To CountID
					If OldRate = RateID(Fori) Then
						Response.Write "<option Value = """ & RateID(Fori) & """ selected>" & RateShow(Fori) & "</option>" & vbcrlf
					Else
						Response.Write "<option Value = """ & RateID(Fori) & """>" & RateShow(Fori) & "</option>" & vbcrlf
					End If
				Next
			Else
				For ForI = 0 To CountID				
					If OldRate = RateID(Fori) Then
						Response.Write "<option Value = """ & RateID(Fori) & """ selected>" & RateShow(Fori) & "</option>" & vbcrlf
					Else
						Response.Write "<option Value = """ & RateID(Fori) & """>" & RateShow(Fori) & "</option>" & vbcrlf
					End If
				Next
			End If
		Else
			Response.Write "数组维数错误----函数名称：Function-ShowRate"
		End If
	End If
End Sub



Private Function FilterSQL(strValue)
'函数名称: FilterSQL
'功能描述: 过滤字符串中的单引号
'作	  者：WangFeng
'使用方法：FilterSQL(strValue)
	FilterSQL=Replace(strValue,"'","''")
End Function
Private Function IsSubmit()
'函数名称: IsSubmit
'功能描述: 判断页面是否提交
'作	  者：WangFeng
'使用方法:如果是提交则返回 True 否则返回 False
'		 If IsSubmit Then
'  		 ...
'		 else
'		 ...
'		 End if
	IsSubmit=Request.ServerVariables("request_method")="POST"
End Function
Private Sub MessageBox(strValue,IsBack)
	With Response
		.Write "<script>" & vbcrlf
		.Write "alert('" & strValue & "');" & vbcrlf
		Select Case IsBack
		Case -10
				.Write "top.location.href='products.Asp'" & vbcrlf		
			Case 0
				.Write "top.location.href='Temp.Asp'" & vbcrlf		
			Case 1
				.Write "history.back();" & vbcrlf
			Case 2
				.Write "top.location.href='../Index.asp'" & vbcrlf
			Case 100 
				.write "window.close();" & vbcrlf
				.write "if (self.opener!=null)" & vbcrlf
				.write "self.opener.location.reload();" & vbcrlf
			Case 101
				.Write "top.location.href='login.asp';"  & vbcrlf
			Case 102
				.Write "location.href='ProductType.asp';"  & vbcrlf
			Case 104
				.Write "location.href='Productmanage.asp';" & vbcrlf
			Case 105
				.Write "location.href='liuyanmanage.asp';" & vbcrlf
			Case 103
				.Write "history.back();" & vbcrlf
			Case 1001
				.Write "location.href='UserManage.asp';" & vbcrlf
			Case 1005
				.Write "location.href='kfmanage.asp';" & vbcrlf
			Case else
				.Write "location.href='newsmanage.asp';" & vbcrlf
		End select
		.Write "</script>" & vbcrlf
	End with
	Response.End
End Sub

Private Sub ListProductType(TypeID)
'列出所有产品类型
		Call OpenData()
		Dim strSQL,ProductName
		Dim objRs
			Response.Write "adskjlfjkasdjfk"
			strSQL="Select TypeID, TypeName from ProductType"
			Set objRs = Conn.Execute(strSQL)
			With objRs
				If .Eof And .Bof Then
					Response.Write "<option value=0>暂无产品类别，请添加</option>"
				Else
					If Len(Trim(TypeID))> 0  Then						
						Do While Not .Eof
						If TypeID=.Fields(0).Value Then
							Response.Write "<option value=""" & .Fields(0).Value & """ selected >" & .Fields(1).Value & "</option>"
						Else
							Response.Write "<option value=" & .Fields(0).Value & ">" & .Fields(1).Value & "</option>"
						End If
						.MoveNext						
						Loop
					Else
						Do While Not .Eof
						Response.Write "<option value=" & .Fields(0).Value & ">" & .Fields(1).Value & "</option>"
						.MoveNext
						Loop
					End if
				End if
			End With
			Set objRs = Nothing
		Call CloseDataBase()
End Sub

Private function CheckAdmin()
	If Session("IsAdmin") = "" then
		response.write "<script>top.location.href='login.asp'</script>"
		Response.End
	Else
		CheckAdmin=True
	End if	
End Function

Function XCHTMLEncode(fString)
	If Not isnull(fString) then
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
		fString = Replace(fString, CHR(32), "&nbsp;")
		fString = Replace(fString, CHR(9), "&nbsp;")
		fString = Replace(fString, CHR(34), "&quot;")
		fString = Replace(fString, CHR(39), "&#39;")
		fString = Replace(fString, CHR(13), "")
		fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
		fString = Replace(fString, CHR(10), "<BR> ")
		XCHTMLEncode = fString
	End if
End function

Function gotTopic(str,strlen)
Dim l,t,c
	l=len(str)
	t=0
	If IsNull(str) Then Exit Function
	For i=1 to l
		c=Abs(Asc(Mid(str,i,1)))
		If c>255 Then
			t=t+2
		Else
			t=t+1
		End if
		If t >= strlen Then
			gotTopic=left(str,i)&""
			exit for
		Else
			gotTopic=str&""
		End if
	Next
End function

Private Function GetLongDate(Value)
'把时间转换为长日期格式格式 与 FormatDateTime函数相似
    Dim strYear, strMonth, strDate
    strYear = Year(Value)
    strMonth = Month(Value)
    strDate = Day(Value)
    GetLongDate = strYear & " 年 " & strMonth & " 月 " & strDate & "日"
End Function

Private Function GetFields(Value)
	If IsNull(Value) Then
		GetFields=""
	Else
		GetFields= Value 
	End If
End Function

%>