<%
Sub	WriteFile(f_savepath,f_content)   
  Dim st   
  Set st=Server.CreateObject("ADODB.Stream")   
  st.Type=2   
  st.Mode=3   
  st.Charset="gb2312"   
  st.Open()   
  st.WriteText   f_content
  st.SaveToFile  f_savepath,2   
  st.Close()   
  Set   st=Nothing   
End   Sub
 
function ReadFile (f_savepath)
 dim str
 set stm=server.CreateObject("adodb.stream")
 stm.Type=2 '以本模式读取
 stm.mode=3 
 stm.charset="gb2312"
 stm.open
 stm.loadfromfile f_savepath
 str=stm.readtext
 stm.Close
 set stm=nothing
 ReadFile=str
end function

sub MakeDir(f_path)
	Set fs=Server.CreateObject("Scripting.FileSystemObject")
	If (fs.FolderExists(f_path)) Then		'目录是否存在
		Else
		fs.CreateFolder(f_path)		'创建目录
	End If
	set fs=nothing
end sub

function CreateWaterMark(p_s,p_t)
	'Set Img = Server.CreateObject("Persits.Jpeg")
	'Img.Open server.MapPath("/images/mark.png")
	Set Jpeg = Server.CreateObject("Persits.Jpeg")
	Jpeg.Open p_s
	Jpeg.Canvas.DrawPng (Jpeg.Width-116-20), (Jpeg.Height-43-20), server.MapPath("/images/mark.png")
	Jpeg.Save p_t
	set Jpeg=nothing
end function

function CreateJumbnail(p_s,p_t,scale)
	dim rect_L
	On Error Resume Next
	Set Jpeg = Server.CreateObject("Persits.Jpeg")
	if err=0 then 
			'开始缩略图
			'Set Jpeg = Server.CreateObject("Persits.Jpeg")
			Jpeg.Open p_s
			' New width
			rect_L =scale
			If Jpeg.OriginalWidth > Jpeg.OriginalHeight Then
				Jpeg.Width = rect_L
				Jpeg.Height = Jpeg.OriginalHeight * rect_L / Jpeg.OriginalWidth
			Else
				 Jpeg.Height =rect_L
				 Jpeg.Width = Jpeg.OriginalWidth * rect_L / Jpeg.OriginalHeight
			End If
			Jpeg.Save p_t
			Set Jpeg = Nothing	
			'END缩略图		
	else
			response.write("<script>alert('不能使用水印组件:Asp Jpeg');</script>"&Chr(10))
	end if
end function
Function GetCode()
	Dim TestObj
	On Error Resume Next
	Set TestObj = Server.CreateObject("Adodb.Stream")
	Set TestObj = Nothing
	If Err Then
		Dim TempNum
		Randomize timer
		TempNum = cint(8999*Rnd+1000)
		Session("GetCode") = TempNum
		GetCode = Session("GetCode")		
	Else
		GetCode = "<img src=""/image.asp"" onclick=""this.src='/image.asp?time='+Math.random()"">"		
	End If
End Function

'**************************************************
'函数名：gotTopic
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'       strlen ----截取长度
'返回值：截取后的字符串
'**************************************************
function gotTopic(str,strlen)
	if str="" then
		gotTopic=""
		exit function
	end if
	dim l,t,c, i
	str=replace(replace(replace(replace(str,"&nbsp;"," "),"&quot;",chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	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
'===========================================================================
'函数：RemoveHTML(strHTML)
'功能：去除HTML标记
'参数：strHTML		--要去除HTML标记的字符串
'==========================================================================
Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 

objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
if strHTML<>"" then
	Set Matches = objRegExp.Execute(strHTML)
	For Each Match in Matches 
		strHtml=Replace(strHTML,Match.Value,"") 
	Next 
	RemoveHTML=strHTML 
else
	RemoveHTML=strHTML
end if
Set objRegExp = Nothing 
End Function 

'**************************************************
'函数名：strLength
'作  用：求字符串长度。汉字算两个字符，英文算一个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
	ON ERROR RESUME NEXT
	dim WINNT_CHINESE
	WINNT_CHINESE    = (len("中国")=2)
	if WINNT_CHINESE then
        dim l,t,c
        dim i
        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
        strLength=t
    else 
        strLength=len(str)
    end if
    if err.number<>0 then err.clear
end function


'*************************************************************
'函数作用：判断有效字符
'*************************************************************

Function hasValidStr(strings)
    CONST str="abcdefghijklmnopqrstuvwxyz1234567890" '将允许出现的字符集
    strings=Lcase(strings)
    For i = 1 to len(strings)
      get1Char=mid(strings,i,1) '取1个字符
      If instr(str,get1Char)=0 then
        hasValidStr=False '包含非法字符，返回False
        Exit Function
      Else
        hasValidStr=True '未发现非法字符，返回True
      End if
    Next
End Function
'*************************************************************
'函数作用：获取客户端IP
'*************************************************************
function GetIp()
	dim userip,retstr,i
	userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	if userip = "" then 
		userip = Request.ServerVariables("REMOTE_ADDR")
	end if
	if(userip<>"") then
		userip=split(userip,".")
		for i=0 to ubound(userip)
			retstr=retstr&Cint(userip(i))
			if(i<ubound(userip)) then
				retstr=retstr&"."
			end if
		next
	end if
	GetIp=retstr
end function
function tohtml(from)
	dim s
	s=from
	if s<> "" then
    	s = Replace(s,"&","&amp;")
    	s = Replace(s,"<","&lt;")
   	 	s = Replace(s,">","&gt;")
    	s = Replace(s,"\t","    ")
    	s = Replace(s,"\r\n","\n")
    	s = Replace(s,"\n","<br>")
    	s = Replace(s,"  "," &nbsp;")
   	 	s = Replace(s,"'","&#39;")
    	s = Replace(s,"\\","&#92;")
		s=replace(s," ","&nbsp;")
    	s=replace(s,chr(13)&chr(10),"<br>")
		tohtml=s
	else
		exit function
	end if
end function
'=======================================================================
'函数：alert(str)
'作用：弹出对话框信息
'参数：str      ---要弹出的信息
'参数：nexti    ---弹出后的动作0=无,1=返回,2=关闭
'=====================================================================

Function alertstr(str,nexti)
	dim nextStr
	select case(nexti)
			case(0)
				response.Write("<script>alert("""&str&""");</script>")
				response.End()
			case(1)
				response.Write("<script>alert("""&str&""");history.back();</script>")
				response.End()
			case(2)
				response.Write("<script>alert("""&str&""");window.close();</script>")
				response.End()
	end select	
end Function
'===================================================================
'                           时间转换函数
'===================================================================
function chan_file(shijian)
	s_year=year(shijian)
	if len(s_year)=2 then s_year="20"&s_year
	s_month=month(shijian)
	if s_month<10 then s_month="0"&s_month
	s_day=day(shijian)
	if s_day<10 then s_day="0"&s_day
	s_hour=hour(shijian)
	if s_hour<10 then s_hour="0"&s_hour
	s_minute=minute(shijian)
	if s_minute<10 then s_minute="0"&s_minute
	s_ss=second(shijian)
	if s_ss<10 then s_ss="0"&s_ss

	chan_file =s_year & s_month & s_day & s_hour & s_minute & s_ss
	
end function
'===================================================================
'                           时间转换函数2
'===================================================================
function chan_data(shijian)
	s_year=year(shijian)
	if len(s_year)=2 then s_year="20"&s_year
	s_month=month(shijian)
	if s_month<10 then s_month="0"&s_month
	s_day=day(shijian)
	if s_day<10 then s_day="0"&s_day
	s_hour=hour(shijian)
	chan_data =s_year & s_month 
	
end function
'===================================================================
'                           时间转换函数3
'===================================================================
function chan_day(shijian)	
	
	s_day=day(shijian)	
	chan_day=s_day 
	
end function

function tohtml2(from)
	dim s
	s=from
	if s<>"" then    
    s = Replace(s,"<","&lt;")
    s = Replace(s,">","&gt;")    
	end if
	tohtml2=s
end function
function htmlto(from)
	dim ss
	ss=from
	if ss<> "" then
    	ss=Replace(ss,"<br>",chr(10))
    	ss=Replace(ss,"&lt;br&gt;",chr(10))
		ss=replace(ss,"&nbsp;"," ")
		htmlto=ss
	else
		exit function
	end if
end function

function getProvinceOptions(province)
	dim ifselect,rs,sql
	sql="select ZID,ZName from t_province order by ZID asc"
	Set rs = conn.Execute(sql)
	if rs.eof then
		getProvinceOptions="<option value=""0"">暂时没有记录</option>"&Chr(13)
	else
		'getSpecialSelect="<option value=""0"">不属任何专题</option>"&Chr(13)
		while not rs.eof
			if(rs(1)=province) then
				ifselect=" selected"
			else
				ifselect=""
			end if
			getProvinceOptions=getProvinceOptions&"<option value="""&rs(1)&""" "&ifselect&">"&rs(1)&"</option>"&Chr(13)
			rs.movenext
		wend
	end if
	rs.close
	set rs=nothing
end function

function getProvinceTitle(zid)
	dim rs
	set rs=server.CreateObject("adodb.recordset") 
	rs.open "select ZName from t_province where ZID='"&zid&"'",conn,3,1
	if not rs.eof then
		getProvinceTitle=rs(0)
	else
		getProvinceTitle=""
	end if
	rs.close
	set rs=nothing
end function

function getIndustryTitle(cid)
	dim rs
	set rs=server.CreateObject("adodb.recordset") 
	rs.open "select title from catalogs where id="&cid&"",conn,3,1
	if not rs.eof then
		getIndustryTitle=rs(0)
	else
		getIndustryTitle=""
	end if
	rs.close
	set rs=nothing
end function

function getIndustryOptions(cid)
	dim rs,sql,first,ifselect,i
	set rs=server.CreateObject("adodb.recordset")
	sql="select id,title from catalogs where parentid="&PlugIn_IndustryId&" order by title asc"
	rs.open sql,conn,3,1
	if not rs.eof then
		first=rs.GetRows()
	else
		
	end if
	rs.close
	set rs=nothing
	if(isarray(first)) then
  	for i=0 to ubound(first,2)
			if(first(0,i)=cid) then
				ifselect=" selected"
			else
				ifselect=""
			end if
			response.Write("<option value="&first(0,i)&" "&ifselect&">"&first(1,i)&"</option>"&Chr(10))	    	
		next	
	end if
end function

function getInfo(recpage,max,pid,cid,province,city,key,infotype,ishot,istop,showdate)
	dim rs,ret,sql
	sql="select top "&recpage&" id,InfoTypeId,Photo,UserId,Title,Price,Province,City,PubDate,Hits,SavePath,Color from t_info where IsCheck=1"
	if(pid>0) then
		sql=sql&" and ParentId="&pid
	end if
	if(cid>0) then
		sql=sql&" and CatalogId="&cid
	end if
	if(infotype>0) then
		sql=sql&" and InfoTypeId="&infotype
	end if
	if(ishot>0) then
		sql=sql&" and IsHot="&ishot
	end if
	if(istop>0) then
		sql=sql&" and IsTop="&istop
	end if
	if(province>0) then
		sql=sql&" and Province="&province
	end if
	if(City>0) then
		sql=sql&" and City="&city
	end if
	if(key<>"") then
		sql=sql&" and UserName='"&key&"'"
	end if
	sql=sql&" order by PubDate desc,id desc"
	'response.Write(sql)
	set rs=server.CreateObject("adodb.recordset")
	rs.open sql,conn,3,1
	if not rs.eof then
		while not rs.eof
			ret=ret&"<li>"
			if(showdate=true) then
				ret=ret&"<span class=""right"">"&year(rs(8))&"-"&month(rs(8))&"-"&day(rs(8))&"</span>"
			end if
			if(rs(1)=2) then
				ret=ret&"<span class=""red"">[求]</span>"
			else
				ret=ret&"<span class=""green"">[供]</span>"
			end if
			ret=ret&"<a href=""show.asp?id="&rs(0)&""" title="""&rs(4)&""""
			if(rs(11)<>"") then
				ret=ret&" style=""color:"&rs(11)&""""
			end if
			ret=ret&">·"&left(rs(4),max)&"</a></li>"&Chr(10)
			rs.movenext
		wend
	else
		ret=ret&"暂时没有记录"
	end if
	rs.close
	set rs=nothing
	getInfo=ret
end function

function GetNews(classid,n,orders,key,max,isTime,isGetChilds,isCatalog,titlePrefix)
	dim newsHref,childIds,rowCount,rs,sql,TempArr,tpfix
	sql="select top "&n&" title,pagepath,moditime,title_color,isoutlink from news where checked=true"
	if(classid>0) then
		sql=sql&" and (news.classid="&classid
		if(isGetChilds>0) then
			sql=sql&" or news.parentid="&classid
		end if
		sql=sql&")"
	end if
	
	set rs=server.CreateObject("adodb.recordset")
	Select Case LCase(key)
		Case "top1"
			sql=sql&" and news.top1=1"
		Case "totop"
			sql=sql&" and news.totop=1"
		Case "tohot"
			sql=sql&" and news.tohot=1"
		Case "recommend"
			sql=sql&" and news.recommend=1"
		Case "imgnews"
			sql=sql&" and news.imgnews=1"
		Case Else				
	End Select
	sql=sql&" order by news."&orders&" desc"	
  	set rs=conn.execute(sql)
	if not rs.eof and not rs.bof then
  		TempArr=rs.GetRows()  
  		rs.close
		set rs=nothing    	
		for i=0 to ubound(TempArr,2)
			newsHref=TempArr(1,i)
			GetNews=GetNews&"<li>"&chr(13)
    		if(Cint(isTime=1)) then
				GetNews=GetNews&"<span class=""col_right"">"&FormatDate(TempArr(2,i),4)&"</span>"
			end if
			if(titlePrefix="auto") then
				tpfix=i+1
			else
				tpfix=titlePrefix
			end if
			GetNews=GetNews&tpfix&" <a href="&""""&newsHref&""""&" title="""&TempArr(0,i)&""" target="&""""&"_blank"&""""&"><span style=""color: "&TempArr(3,i)&""">"&gotTopic(TempArr(0,i),max)&"</span></a>"&chr(13)    		
			GetNews=GetNews&"</li>"&chr(13)
		next	
	else
		GetNews="暂时没有记录"
		rs.close
		set rs=nothing
	end if
end function

function GetFriendLink(rows,cols,linktype,ItColor1,ItColor2)
dim rs,sql,TempArr
	set rs=server.CreateObject("adodb.recordset")
	if(Cint(linktype)=0) then
		sql="select Title,LinkUrl from friendlink where Flag="&linktype
	elseif(Cint(linktype=1)) then
		sql="select Title,LinkUrl,Pic from friendlink where Flag="&linktype
	end if
  	set rs=conn.execute(sql)
	if not rs.eof then
  		TempArr=rs.GetRows()  
  		rs.close
		set rs=nothing   
		GetFriendLink=GetFriendLink&"<table class=""line22"" cellspacing=""0"" cellpadding=""0"" width=""100%"" border=""0"">"&Chr(10)
		for i=0 to rows-1' ubound(TempArr,2)按行循环

				if i mod 2=0 then
					GetFriendLink=GetFriendLink&"<tr bgcolor="""&ItColor1&""">"&Chr(10)
				else
					GetFriendLink=GetFriendLink&"<tr bgcolor="""&ItColor2&""">"&Chr(10)
				end if

			for j=0 to cols-1'按列循环
				GetFriendLink=GetFriendLink&"<td><div align=""center"">"&Chr(10)
				if(linktype=0) then
					if(i*cols+j<=ubound(TempArr,2)) then
						GetFriendLink=GetFriendLink&"<a href="""&TempArr(1,i*cols+j)&""" title="""&TempArr(0,i*cols+j)&""" target=""_blank"">"&TempArr(0,i*cols+j)&"</a>"&Chr(10)
					else
						GetFriendLink=GetFriendLink&"<a href="""&SiteUrl&""" target=""_blank"">友情链接</a>"&Chr(10)
					end if
				else
					if(i*cols+j<=ubound(TempArr,2)) then
						GetFriendLink=GetFriendLink&"<a href="""&TempArr(1,i*cols+j)&""" target=""_blank""><img src="""&TempArr(2,i*cols+j)&""" alt="""&TempArr(0,i*cols+j)&""" width=""88"" height=""31"" border=""0"" /></a>"&Chr(10)
					else
						GetFriendLink=GetFriendLink&"<a href="""&SiteUrl&""" target=""_blank"">友情链接</a>"&Chr(10)
					end if
				end if
				GetFriendLink=GetFriendLink&"</div></td>"&Chr(10)
			next
		GetFriendLink=GetFriendLink&"</tr>"&Chr(10)
		next
		GetFriendLink=GetFriendLink&"</table>"&Chr(10)	
	else
		rs.close
		set rs=nothing
	end if
end function

function GetRemProducts
	dim rs,p,ret
			set rs=conn.execute("select top 16 id,Title,Photo from t_info where IsCheck=1 and IsHot=1 order by id desc")
			while not rs.eof
				if(rs(2)<>"") then
					p=rs(2)
				else
					p="images/nopic.jpg"
				end if
				ret=ret&"<li>"
				ret=ret&"<a href=""show.asp?id="&rs(0)&""" target=""_blank""><img src="""&p&""" width=""106"" height=""80"" border=""0""></a>"
				ret=ret&"<h2><a href=""show.asp?id="&rs(0)&"""  target=""_blank"">"&left(rs(1),7)&"</a></h2>"
				ret=ret&"</li>"
				rs.movenext
			wend
			rs.close
			set rs=nothing
			GetRemProducts=ret
end function

function GetCatalogNav
	dim i,css,catas
	i=0
	set rs=server.CreateObject("adodb.recordset") 
	rs.open "select id,title,parentid from catalogs where parentid="&PlugIn_InfoId&" order by id asc",conn,3,1
	while not rs.eof
		catas=catas&"<div class=""col"">"&Chr(10)
		catas=catas&"<h2><a href=""list.asp?pid="&rs(0)&""" title="""&rs(1)&""">"&rs(1)&"</a></h2>"&Chr(10)
		''''''''''''''''''''
		set rs1=server.CreateObject("adodb.recordset") 
		rs1.open "select id,title from catalogs where parentid="&rs(0)&" order by title asc",conn,3,1
		while not rs1.eof
				catas=catas&"<div class=""row""><a href=""list.asp?pid="&rs(0)&"&cid="&rs1(0)&""" title="""&rs1(1)&""""&">"&rs1(1)&"</a></div>"&Chr(10)
			rs1.movenext
		wend
		rs1.close
		set rs1=nothing
		''''''''''''''''
		rs.movenext
		catas=catas&"</div>"&Chr(10)
	wend
	rs.close
	set rs=nothing
	GetCatalogNav=catas
end function
%>