getpartstrandbyteslen.asp

本房地产网站功能强大

<%
'/格式化时间/
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 = n &"-"& 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
	Elseif style = 8 then
		FormatTime = n &"-"& y &"-"& r
	End if
End Function

 Function strLen(str) 
  Dim i,l,t,c
   l=len(str) 
   t=l 
   For i=1 To l 
    c=asc(mid(str,i,1)) 
     If c<0 then c=c+65536 
      If c>255 Then 
        t=t+1 
      End If
   Next 
   strLen=t 
 End Function
 Function getStr(str,getLen)
  If str="" or isNull(str) Then
   getStr=""
  Else
  Dim getStrTempValue
   getStrTempValue=Left(str,getLen)
   For i=1 To strLen(str)
    If strLen(getStrTempValue)<getLen*2 Then
     getStrTempValue=left(str,len(getStrTempValue)+1)
    End If
	If strLen(getStrTempValue)=getLen*2 Then
	 Exit For
	End If
   Next
    getStr=getStrTempValue
  End If
 End Function
 function changechr(str) 
 changechr=replace(replace(replace(str,"asp","")," ",""),"eval","")
   changechr=replace(replace(replace(replace(changechr,"'",""),"truncate",""),"insert",""),"cmdshell","") 
    changechr=replace(replace(replace(replace(changechr,"select",""),"update",""),"delete%20from",""),chr(34),"&quot;") 
    changechr=ChkBadWords(changechr)    
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
'=================================================
'fy_DelFiles(strFiles)
'strdir           ----(要删除的文件)
'删除指定文件
'=================================================
Sub fy_DelFiles(strFiles)
		if strFiles="" then Exit Sub
		dim fso,arrFiles,i
		On Error Resume Next
		Err=0
		Set fso = CreateObject("Scripti"&"ng.File"&"SystemO"&"bject")
			if fso.FileExists(server.MapPath(strFiles)) then
				fso.DeleteFile(server.MapPath(strFiles))
				if 0=Err then
				response.write"<font color=blue>清除文件（"&strFiles&"）成功！</font><br>"
				else
				response.write"<font color=red>清除文件（"&strFiles&"）失败！</font><br>"
				end if
			end if
		Set fso = Nothing
		Err=0
	End Sub
	function GetIp()
	'如果客户端用了代理服务器，则应该用ServerVariables("HTTP_X_FORWARDED_FOR")方法
	getclientip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	If getclientip = "" Then
		'如果客户端没用代理，应该用Request.ServerVariables("REMOTE_ADDR")方法
		getclientip = Request.ServerVariables("REMOTE_ADDR")
	end if
	GetIp = getclientip
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 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
Sub OutMsg(strMsg,strUrl)
		response.write "<script language=""javascript"">alert('"&strMsg&"');location.href='"&strUrl&"';</script>"
		response.end
	End Sub
	' 根路径转为带域名全路径格式
	Function fyRootPath2DomainPath(url)
		Dim sHost, sPort
		sHost = Split(Request.ServerVariables("SERVER_PROTOCOL"), "/")(0) & "://" & Request.ServerVariables("HTTP_HOST")
		sPort = Request.ServerVariables("SERVER_PORT")
		If sPort <> "80" Then sHost = sHost & ":" & sPort
		RootPath2DomainPath = sHost & url
	End Function
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
Function ChkBadWords(Str)
		If IsNull(Str) Then Exit Function
		Dim i
		sBadWords=Split(BadWords,"|")
for i = 0 to ubound(sbadwords)
	if not (sbadwords(i)="" or sbadwords(i)=" ") then
		badwords_1 = split(sbadwords(i),"=")
		If ubound(badwords_1)=1 Then
			Str = Replace(Str,badwords_1(0),badwords_1(1))
		End If
	End If
next
ChkBadWords = Str
End Function
Function leftt(str,n)
If len(str)<=n/2 Then
LeftT=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
LeftT = TStr+".."
End If
End Function
'/判断会员是否超时/
Function IsTimeOutuser(vMember,vPassWord)
	Dim rdsMember1
	Dim sqlMember1
	OpenDataConn
	
	set rdsMember1 = Server.CreateObject("ADODB.Recordset")
	sqlMember1 = "Select * From company Where userid= '"& vMember &"' And pwd= '"& vPassWord &"'"
	rdsMember1.Open sqlMember1,Conn
	
	If Not rdsMember1.EOF Then
		IsTimeOutuser = False
	Else
		IsTimeOutuser = True
	End if
	
	rdsMember1.Close
	set rdsMember1 = nothing
End Function
'/判断管理员是否超时/

Function IsTimeOutadmin(vUserName,vUserPwd)
OpenDataConn
	dim rdsUser,sqlUser
	Set rdsUser = Server.CreateObject("ADODB.Recordset")
	sqlUser = "Select * From manager66 Where name='"& vUserName &"' And pwd='"&vUserPwd&"'"
	rdsUser.Open sqlUser,conn
	If Not rdsUser.EOF Then
		IsTimeOutadmin = False
	Else
		IsTimeOutadmin = True
	End if
	rdsUser.Close
	set rdsUser = nothing
End Function
'检查验证码是否正确
Function fy_CodeIsTrue()
		Dim CodeStr