inc_function.asp

讲的是网络编程

<%
'┌─  风云ASP在线  ────────────────────────┐
'│                                                                 │
'│  作者：赵振波.	http://www.fyasp.com	    				    │
'│                                                                 │
'│   Q Q：185623333  										   	    │
'│                                                                 │
'│ Email：[e-mail]                                             │
'│                                                                 │
'│ 程序定做，系统开发，网站制作，提供高质量的网络产品、技术和服务！│
'│                                                                 │
'│【版权声明】                                                     │
'│                                                                 │
'│     本程序版权归坐看风云所有，未经授权擅自修改、复制或散布本程序│
'│                                                                 │
'│的部分或全部，将承受严厉的民事和刑事处罚，对已知的违反者将给予法 │
'│                                                                 │
'│律范围内的全面制裁。对非法使用此程序所造成的一切后果本人概不负责!│
'│                                                                 │
'└───────────────────  http://www.fyasp.com ──┘
%>
<%
'/判断用户是否超时/
Function IsTimeOut(vUserName,vUserPwd)
	dim rdsUser,sqlUser
	Set rdsUser = Server.CreateObject("ADODB.Recordset")
	sqlUser = "Select * From Sys_Account Where Account ='"& vUserName &"' And PassWord ='"& vUserPwd &"'"
	rdsUser.Open sqlUser,conn
	If Not rdsUser.EOF Then
		IsTimeOut = False
	Else
		IsTimeOut = True
	End if
	rdsUser.Close
	set rdsUser = nothing
End Function


'/获得信息分类的名称/
Function getClassName(nClassID)
	Dim rdsClassName
	Dim sqlClassName
	
	set rdsClassName = Server.CreateObject("ADODB.Recordset")
	sqlClassName = "Select * From Dat_Class Where ClsID = "& nClassID
	rdsClassName.Open sqlClassName,Conn
	if not rdsClassName.EOF then
		getClassName = rdsClassName("CnName")
	else
		getClassName = ""
	end if
	rdsClassName.Close
	set rdsClassName = nothing
End Function


'/格式化时间/
Function FormatTime(TestTime,style)
	Dim n,y,r,s,f,m
	n = Year(TestTime)
	y = Month(TestTime)
	r = Day(TestTime)
	s = Hour(TestTime)
	f = Minute(TestTime)
	m = Second(TestTime)
	if len(n) = 2 then n = "20" & n
	if len(y) = 1 then y = "0" & y
	if len(r) = 1 then r = "0" & r						
	if len(s) = 1 then s = "0" & s
	if len(f) = 1 then f = "0" & f
	if len(m) = 1 then m = "0" & m
	If style = 1 Then
		FormatTime = "<font color=""#FF0000"">"& n &"</font>年<font color=""#FF0000"">"& y &"</font>月<font color=""#FF0000"">"& r &"</font>日<font color=""#FF0000"">"& s &"</font>时"
	Elseif style = 2 Then
		FormatTime = r &"日 "& s & ":" & f & ":" & m
	Elseif style = 3 Then
		FormatTime = n &"年"& y &"月"& r &"日"
	Elseif style = 4 Then
		FormatTime = n & "/" & y & "/" & r
	Elseif style = 5 then
		FormatTime =  y &"-"& r &"&nbsp;" & s & ":" & f
	Elseif style = 6 then
		FormatTime = n &"年"& y &"月"& r &"日" & s &":"& f
	Elseif style = 7 then
		FormatTime =  n & y & r & s & f & m
	End if
End Function


'/删除一个贴子的附件/
Sub deleteArtAffix(nArtID)
	dim strDelAffix,sqlDelAffix,sqlDeleteFavor
	set strDelAffix = Server.CreateObject("ADODB.Recordset")
	sqlDelAffix = "Select * From ProjectContent Where ProjectID = "& nArtID
	strDelAffix.Open sqlDelAffix,Conn
	if not strDelAffix.EOF then
		if not IsNull(strDelAffix("Affix")) then
			Set Upload = Server.CreateObject("Persits.Upload.1")
			Upload.DeleteFile strUploadFilePath & strDelAffix("Affix")
			Set Upload = nothing
		end if
	end if
	strDelAffix.Close
	set strDelAffix = nothing
End Sub

'/字符串转换函数/
function Htmlencode2(strMsgString)
	strMsgString = replace(strMsgString, ">", "&gt;")
	strMsgString = replace(strMsgString, "<", "&lt;")
	strMsgString = replace(strMsgString, chr(34), "&quot;")
	'strMsgString = replace(strMsgString, "&", "&amp;")
	strMsgString = replace(strMsgString, chr(32), "&nbsp;")
	strMsgString = replace(strMsgString, chr(9), "	")
	strMsgString = replace(strMsgString, chr(13), "<br>")
	strMsgString = replace(strMsgString, "[br]", "<br>")

	Htmlencode2 = strMsgString
end function

'/在一个表中判断用户输入的一个字段的值是否已存在/
Function SearchFieldValue(vTableName,vFieldName,vFieldValue)
	Dim rdsField
	Dim sqlField
	
	set rdsField = Server.CreateObject("ADODB.Recordset")
	sqlField = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	rdsField.Open sqlField,Conn
	if not rdsField.EOF then
		SearchFieldValue = True
	else
		SearchFieldValue = False
	end if
	rdsField.Close
	set rdsField = nothing
end Function
Function bbHTMLDecode(reString) '转换HTML代码
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = Replace(Str, "&amp;", "&")
		Str = Replace(Str, "&gt;", ">")
		Str = Replace(Str, "&lt;", "<")
		Str = Replace(Str, "&nbsp;", CHR(32))
	    Str = Replace(Str, "&nbsp;", CHR(9))
		Str = Replace(Str, "&#160;&#160;&#160;&#160;", CHR(9))
		Str = Replace(Str, "&quot;", CHR(34))
		Str = Replace(Str, "&#39;", CHR(39))
		Str = Replace(Str, "", CHR(13))
		Str = Replace(Str, "<br>", CHR(10))
		Str = Replace(Str, "<BR>", CHR(10))
		bbHTMLDecode = Str
	End If
End Function
function dvHTMLEncode(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> ")

    dvHTMLEncode = fString
end if
End Function
Function RtnReplaceInt(iCheck,iDefault) 
	If Trim(iCheck)="" Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	If IsNumeric(iCheck)=false Then
		RtnReplaceInt = iDefault
		Exit Function
	End If

	RtnReplaceInt = iCheck
End Function
'/在一个表中判断用户输入的一个字段是否与其它字段重名，除了他本身以外/
Function SearchEditFieldValue(vTableName,vFieldname,vFieldValue,vIDName,intIDValue)
	Dim rdsField1
	Dim sqlField1
	
	set rdsField1 = Server.CreateObject("ADODB.Recordset")
	sqlField1 = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
	rdsField1.Open sqlField1,Conn
	if not rdsField1.EOF then
		do while not rdsField1.EOF
			if int(intIDValue) <> rdsField1(vIDName) then
				SearchEditFieldValue = 1
				exit Function
			end if
			rdsField1.MoveNext
		loop
		SearchEditFieldValue = 0
	end if
	rdsField1.Close
	set rdsField1 = nothing
End Function

'/获得一个目录的父目录编号/
Function getRootID(nClassID)
	Dim rdsRootID
	Dim sqlRootID
	
	set rdsRootID = Server.CreateObject("ADODB.Recordset")
	sqlRootID = "Select * From Dat_Class Where ClsID = "& nClassID
	rdsRootID.Open sqlRootID,Conn
	if not rdsRootID.EOF then
		getRootID = rdsRootID("RootID")
	else
		getRootID = 0
	end if
	rdsRootID.Close
	set rdsRootID = nothing
End Function


'/删除一个目录下的子目录及产品/
Function DeleteClass(nClsID)
	Dim sqlDelClsPro
	Dim sqlDelClass
	Dim sqlDelClsClass
	
	if getRootID(nClsID) = 0 then
		'sqlDelClsPro = "Delete From Dat_Products Where RootID = "& nClsID
		sqlDelClass = "Delete From Dat_Class Where ClsID = "& nClsID
		sqlDelClsClass = "Delete From Dat_Class Where RootID = "& nClsID
		Conn.Execute sqlDelClsClass
	else
		'sqlDelClsPro = "Delete From Dat_Products Where ClsID = "& nClsID
		sqlDelClass = "Delete From Dat_Class Where ClsID = "& nClsID
	end if
	'Conn.Execute sqlDelClsPro
	Conn.Execute sqlDelClass
End Function

'/取得当前文件名称/
Function getFileName()
	dim strScrName,MarkStr,DelStr,LastStr
	
	strScrName = Request.ServerVariables("SCRIPT_NAME")
	MarkStr = "/"
	Do While Instr(strScrName,MarkStr) > 0
		DelStr = Instr(1,strScrName,MarkStr)
		LastStr = mid(strScrName,1,DelStr - 1)
		strScrName = mid(strScrName,DelStr + 1,Len(strScrName) - DelStr)
	Loop
	getFileName = strScrName
End Function

'/取字符串函数/
Function OutStr(SourceString,MarkStr,Num)
	SourceStr = SourceString
	If Len(SourceStr) = 0 Then
	 OutStr = "无"
	Else
		Dim StrCount,DelStr,LastStr
		If Mid(SourceStr,Len(SourceStr),1) <> MarkStr Then
			SourceStr = SourceStr + MarkStr
		End if
		StrCount = 1
		Do While Len(SourceStr) > 0
			DelStr = Instr(1,SourceStr,MarkStr)
			LastStr = Mid(SourceStr,1,DelStr - 1)
			SourceStr = Mid(SourceStr,DelStr + 1,Len(SourceStr) - DelStr)
			If StrCount = Num Then
				If LastStr <> "" Then
					OutStr = LastStr
				End if
				Exit Do
			End if
			StrCount = StrCount + 1
		Loop
	End if
End Function

'/根据产品ID获得产品编号/
Function getProductNumber(intProductKey)
	Dim rdsProductNumber
	Dim sqlProductNumber
	
	set rdsProductNumber = Server.CreateObject("ADODB.Recordset")
	sqlProductNumber = "Select * From Dat_Products Where ProductKey = "& intProductKey
	rdsProductNumber.Open sqlProductNumber,Conn
	if not rdsProductNumber.EOF then
		getProductNumber = rdsProductNumber("Number")
	else
		getProductNumber = ""
	end if
	rdsProductNumber.Close
	set rdsProductNumber = nothing
End Function

'/根据产品ID获得产品名称/
Function getProductName(nintProductKey)
	Dim rdsProductName
	Dim sqlProductName
	
	set rdsProductName = Server.CreateObject("ADODB.Recordset")
	sqlProductName = "Select * From Dat_Products Where ProductKey = "& nintProductKey
	rdsProductName.Open sqlProductName,Conn
	if not rdsProductName.EOF then
		getProductName = rdsProductName("EnName")
	else
		getProductName = ""
	end if
	rdsProductName.Close
	set rdsProductName = nothing
End Function

'/出错提示函数/
Sub ShowMessage()
	if strMsgTitle = "" then strMsgTitle = "异常出错"
	if strMsg = "" then strMsg = "未知错误"
%>
  <br>
  <table border="0" width="60%" cellspacing="0" cellpadding="0" align="center">
	<tr>
	  <td width="100%" class="booktable">
		<table border="0" width="100%" cellspacing="1">
		  <tr>
		    <td width="100%" align="center" class="bottom" height="30"><%=strMsgTitle%></td>
		  </tr>
		  <tr>
		    <td width="100%" align="center" height="68" class="banma2" style="line-height:200%"><%=strMsg%></td>
		  </tr>
	<%if strError then%>
          <tr>
            <td width="100%" align="center" height="25" class="banma2"><input onclick="parent.location.href='Javascript:history.back()'" type="button" value="返 回" class="face" id=button1 name=button1></td>
          </tr>
	<%else%>
			<meta HTTP-EQUIV="refresh" Content="2;url=<%=strGoFile%>">
	<%end if%>
        </table>
      </td>
    </tr>
  </table>
  <br>
<%End Sub%>