<%
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=""/getcode.asp"" onclick=""this.src='/getcode.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	
	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*2 then
			gotTopic=left(str,i)+".."
			exit for		
		end if
	next
	if(t<strlen*2) then
		gotTopic=str
	end if
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=""
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 CheckDir(FolderPath)
	dim fso
	Set fso= Server.CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(FolderPath) then
	'存在
		CheckDir = True
	Else
	'不存在
		CheckDir = False
	End if
	Set fso = nothing
End Function

'-------------根据指定名称生成目录---------
Function MakeNewsDir(foldername)
	dim fso,f
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateFolder(foldername)
    MakeNewsDir = True
	Set fso = nothing
End Function


'**************************************************
'函数名：SendMail
'作  用：用Jmail组件发送邮件
'参  数：MailtoAddress  ----收信人地址
'        MailtoName    -----收信人姓名
'        Subject       -----主题
'        MailBody      -----信件内容
'        FromName      -----发信人姓名
'        MailFrom      -----发信人地址
'        Priority      -----信件优先级
'**************************************************
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
	on error resume next
	Dim JMail
	Set JMail=Server.CreateObject("JMail.Message")
	if err then
		SendMail= "<br><li>没有安装JMail组件</li>"
		err.clear
		exit function
	end if
	JMail.Charset="gb2312"          '邮件编码
	JMail.silent=true
	JMail.ContentType = "text/html"     '邮件正文格式
	'JMail.ServerAddress=MailServer     '用来发送邮件的SMTP服务器
   	'如果服务器需要SMTP身份验证则还需指定以下参数
	JMail.MailServerUserName = MailServerUserName    '登录用户名
   	JMail.MailServerPassWord = MailServerPassword        '登录密码
  	JMail.MailDomain = MailDomain       '域名（如果用“name@domain.com”这样的用户名登录时，请指明domain.com
	JMail.AddRecipient MailtoAddress,MailtoName     '收信人
	JMail.Subject=Subject         '主题
	JMail.HMTLBody=MailBody       '邮件正文（HTML格式）
	JMail.Body=MailBody          '邮件正文（纯文本格式）
	JMail.FromName=FromName         '发信人姓名
	JMail.From = MailFrom         '发信人Email
	JMail.Priority=Priority              '邮件等级，1为加急，3为普通，5为低级
	JMail.Send(MailServer)
	SendMail =JMail.ErrorMessage
	JMail.Close
	Set JMail=nothing
end function
'*************************************************************
'函数作用：判断非法字符
'*************************************************************
Public Function IsValidStr(Str)
	IsValidStr = True
	If IsNull(Str) Then Exit Function
	Dim ForbidStr, i
	ForbidStr = ":|=|%|&|$|#|@|+|-|*|/|\|<|>|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)&"|"&Chr(10)&"|"&Chr(13)
	ForbidStr = Split(ForbidStr, "|")
	For i = 0 To UBound(ForbidStr)
		If InStr(Str, ForbidStr(i)) > 0 Then
			IsValidStr = False
			Exit Function
		End If
	Next
	IsValidStr = True
End Function
'*************************************************************
'函数作用：判断密码非法字符
'*************************************************************
Public Function IsValidPassword(Str)
	IsValidPassword = True
	If IsNull(Str) Then Exit Function
	Dim ForbidStr, i
	ForbidStr = "=|%|&|;|,|"& Chr(32) &"|"& Chr(34) &"|"& Chr(39) &"|"& Chr(9)&"|"&Chr(10)&"|"&Chr(13)
	ForbidStr = Split(ForbidStr, "|")
	For i = 0 To UBound(ForbidStr)
		If InStr(Str, ForbidStr(i)) > 0 Then
			IsValidPassword = False
			Exit Function
		End If
	Next
	IsValidPassword = True
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
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'是否外部提交
''''''''''''''''''''''''''''''''''''''''''''''''''''
Function isSelfRefer() 
	Dim sHttp_Referer, sServer_Name 
	sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER")) 
	sServer_Name = CStr(Request.ServerVariables("SERVER_NAME")) 
	If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then 
		IsSelfRefer = True 
	Else 
		IsSelfRefer = False 
	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 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
'
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 chan_file(shijian)
	dim s_year,s_month,s_day,s_hour,s_minute,s_ss
	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)
	dim s_year,s_month,s_day,s_hour
	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)	
	dim s_day
	s_day=day(shijian)	
	chan_day=s_day 
	
end function
function GetIp()
	dim userip
	userip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	if userip = "" then 
		userip = Request.ServerVariables("REMOTE_ADDR")
	end if
	GetIp=userip
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(id)
	dim rs
	set rs=server.CreateObject("adodb.recordset") 
	rs.open "select title from t_industry where id="&id,conn,3,1
	if not rs.eof then
		getIndustryTitle=rs(0)
	else
		getIndustryTitle=""
	end if
	rs.close
	set rs=nothing
end function

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

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