function.asp

html生成静态页的小程序

<%
'是否是安全访问
Function IsSelfRefer()
	server_v1=Lcase(Request.ServerVariables("HTTP_REFERER"))
	server_v2=Lcase(Request.ServerVariables("SERVER_NAME"))
	If InStr(server_v1,server_v2)<1 Then
		IsSelfRefer = False'不是
		Else 
			IsSelfRefer = True'是
	End If
End Function

'页面出错
Private Sub Page_Err(Msg)
	Response.Write(Msg)
	Response.End()
End Sub

'格式化日期
Function FormatDate(sDate,sSplit)
	y = Cstr(Year(sDate))
	m = Cstr(Month(sDate))
	If Len(m)=1 Then m = "0" & m
	d = Cstr(Day(sDate))
	If Len(d)=1 Then d = "0" & d
	FormatDate = y & sSplit & m & sSplit & d
End Function

Function myCdbl(str)
	If str = "" Or Not IsNumeric(str) Then
		Call Page_Err("参数错误：要求为数字型。")
		Else
			myCdbl = Cdbl(str)
	End If
End Function

Function getNumber(Str)
	If Str = "" Or Not IsNumeric(Str) Then
		Call Page_Err("参数错误：要求为数字型。")
		Else
			getNumber = Str
	End If
End Function

Private Sub MessageBox(Msg,gotoUrl)
	Response.Write("<script language=""javascript"">")
	Response.Write("alert(""" & Msg & """);")
	If gotoUrl="" Then
		Response.Write("history.back();")
		Else
			Response.Write("document.URL='" & gotoUrl & "';")
	End If
	Response.Write("</script>")
	Response.End()
End Sub

'自定义Left
Function LeftX(Str,N)
	Dim i,j,ch,StrTmp
	j = 0
	StrTmp = ""
	For i = 1 To Len(Str)
		ch = Mid(Str,i,1)
		StrTmp = StrTmp & ch
		If Asc(ch)<0 Then
			j = j + 2
			Else
				j = j + 1
		End If
		If j >= N Then Exit For
	Next
	LeftX = StrTmp
End Function

'输出字符串
Function OutStr(Str)
  strer=Str
  if strer="" or isnull(strer) then
    OutStr="":exit function
  end if
  strer=replace(strer,"<","&lt;")
  strer=replace(strer,">","&gt;")
  strer=replace(strer,CHR(13) & Chr(10),"<br>")    '换行
  strer=replace(strer,CHR(32),"&nbsp;")    '空格
  strer=replace(strer,CHR(9),"&nbsp;")    'table
  strer=replace(strer,CHR(39),"&#39;")    '单引号
  strer=replace(strer,CHR(34),"&quot;")    '双引号
  OutStr = strer
End Function

'过滤html标签
Function filterhtml(fstring)
    if isnull(fstring) or trim(fstring)="" then
        filterhtml=""
        exit function
    end if
    set  re = new  regexp
    re.ignorecase=true
    re.global=true
    re.pattern="<(.+?)>"
    fstring = re.replace(fstring, "")
    set   re=nothing
	filterhtml = fstring
End Function

'执行SQL，返一行一列的值
Function ExecSqlReturnOneValue(Sql)
	Set opRs = Server.CreateObject("Adodb.RecordSet")
	opRs.Open Sql,Conn,0,1
	If  opRs.Eof And opRs.Bof Then 
		ExecSqlReturnOneValue = ""
		Else
			ExecSqlReturnOneValue = opRs(0)
	End If
	opRs.Close
	Set opRs = Nothing
End Function

'格式化日期
Function Format_Time(s_Time,n_Flag)
	Dim y, m, d, h, mi, s
	Format_Time = ""
	If IsDate(s_Time) = False Then Exit Function
	y = cstr(year(s_Time))
	m = cstr(month(s_Time))
	If len(m) = 1 Then m = "0" & m
	d = cstr(day(s_Time))
	If len(d) = 1 Then d = "0" & d
	h = cstr(hour(s_Time))
	If len(h) = 1 Then h = "0" & h
	mi = cstr(minute(s_Time))
	If len(mi) = 1 Then mi = "0" & mi
	s = cstr(second(s_Time))
	If len(s) = 1 Then s = "0" & s
	Select Case n_Flag
	Case 1
		' yyyy-mm-dd hh:mm:ss
		Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	Case 2
		' yyyy-mm-dd
		Format_Time = y & "-" & m & "-" & d
	Case 3
		' hh:mm:ss
		Format_Time = h & ":" & mi & ":" & s
	Case 4
		' yyyy年mm月dd日
		Format_Time = y & "年" & m & "月" & d & "日"
	Case 5
		' yyyymmdd
		Format_Time = y & m & d
	End Select
End Function

Function CmdSafeLikeSqlStr(Str)
	Str = Replace(Str,"'","''")
	Str = Replace(Str,"[","[[]")
	Str = Replace(Str,"%","[%]")
	Str = Replace(Str,"_","[_]")
	CmdSafeLikeSqlStr = Str
End Function

Function ReplaceTest(str,patrn, replStr)
  Dim regEx, str1 
  str1 = str
  Set regEx = New RegExp
  regEx.Pattern = patrn
  regEx.IgnoreCase = True
  regEx.global=true
  ReplaceTest = regEx.Replace(str1, replStr)
End Function

Function GetPageUrlPath()
	SERVER_NAME = Request.ServerVariables("SERVER_NAME")
	SERVER_PORT = Request.ServerVariables("SERVER_PORT")
	PATH_INFO = Request.ServerVariables("PATH_INFO")
	PATH_TMP = Split(PATH_INFO,"/")
	PATH_INFO = Replace(PATH_INFO,PATH_TMP(Ubound(PATH_TMP)),"")
	URL = "http://" & SERVER_NAME
	If SERVER_PORT<>80 Then URL = URL & ":" & SERVER_PORT
	URL = URL & PATH_INFO
	GetPageUrlPath = URL
End Function

Function GetAdSense(ID)
	Sql="select Code from Ok3w_AdSense where ID=" & ID
	Set oRs = Conn.Execute(Sql)
	If oRs.Eof And oRs.Bof Then
		GetAdSense = "广告不存在，ID=" & ID
		Else
			GetAdSense = oRs("Code")
	End If
	oRs.Close
	Set oRs = Nothing
End Function

'频道名称
Function GetChannelName(ChannelId)
	If ChannelId="" Then
		GetChannelName = "--------"
		Exit Function
	End If
	Sql = "select ChannelName from Ok3w_Channel where ChannelId=" & ChannelId
	GetChannelName = ExecSqlReturnOneValue(Sql)
End Function

'栏目名称
Function GetClassName(ClassId)
	If ClassId="0" Then
		GetClassName = "--------"
		Exit Function
	End If
	Sql = "select SortName from Ok3w_Class where ID=" & ClassId
	GetClassName = ExecSqlReturnOneValue(Sql)
End Function

Function GetCommentsCount(TypeID,TableID)
	Sql="select count(ID) from Ok3w_Guest where IsPass=1 and TypeID=" & TypeID & " and TableID=" & TableID
	GetCommentsCount = ExecSqlReturnOneValue(Sql)
End Function

'分类ID下拉列表选择菜单
Private Sub InitClassSelectOption(ChannelId,ParentID,ChkID)
	Dim opRs,cTmp,cLen,cCount
	Set opRs = Server.CreateObject("Adodb.RecordSet")
	Sql = "select ID,SortName,SortPath from Ok3w_Class where ChannelId=" & ChannelId & " and ParentID=" & ParentID & " order by OrderID"
	opRs.Open Sql,Conn,0,1
	Do While Not opRs.Eof
		Response.Write("<option value=""" & opRs("ID") & """")
		If ChkID = opRs("ID") Then Response.Write(" selected=""selected""")
		Response.Write(">")
		cTmp = Split(opRs("SortPath"),",")
		cLen = Ubound(cTmp) - 2
		For cCount=1 To cLen
			Response.Write("│&nbsp;")
		Next
		Response.Write("├" & opRs("SortName") & "</option>")
		
		Call InitClassSelectOption(ChannelId,opRs("ID"),ChkID)
		opRs.MoveNext
	Loop
	opRs.Close
	Set opRs = Nothing
End Sub

Private Sub OutThisPageContent(aID,Content,PagePath)
	thisPage = Request.QueryString("thisPage")
	If thisPage<>"" Then thisPage = myCdbl(thisPage)
	
	If thisPage="" Then thisPage=1
	thisPage = Cint(thisPage)
	Content_Tmp = Split(Content,"[Ok3w_NextPage]")
	Page_Count = Ubound(Content_Tmp)+1
	If thisPage> Page_Count Then thisPage = Page_Count
	
	Response.Write(ReplaceTest(Content_Tmp(thisPage-1),"<img ","<img onload=""ImageZoom(this,560,700)"" "))
	
	If Page_Count>1 Then
		Response.Write("<div class=""thisPageNav"">")
		For iPage=1 To Page_Count
			If iPage = 1 Then
				URL = PagePath & "/" & aID & ".html"
				Else
					URL = PagePath & "/" & aID & "_" & iPage & ".html"
			End If
			If iPage = thisPage Then
				Response.Write("<a href=""" & URL & """><strong>第" & iPage & "页</strong></a> ")
				Else
					Response.Write("<a href=""" & URL & """>第" & iPage & "页</a> ")
			End If
		Next
		Response.Write("</div>")
	End If
End Sub
%>