<!--#include file="conn.asp"-->
<!--#include file="config.asp"-->
<%
response.Cookies("global").Expires=Date+365

'//关闭数据库
sub connClose()
conn.close:set conn=nothing
end sub

'函数：操作提示
function ErrMsg(tmp)
connClose()
p3t "<script>alert('对不起，"&tmp&"！');</script>"
p3t_end
end function

'//

dim w_taoke_nick,w_taoke_key,w_taoke_secret,w_netbar_isopen,w_netbar_content
sub getConfig()
	set rs_c=conn.execute("select * from p3t_config where w_id=1")
	if not rs_c.eof then
	w_taoke_nick=rs_c("w_taoke_nick")
	w_taoke_key=rs_c("w_taoke_key")
	w_taoke_secret=rs_c("w_taoke_secret")
	w_netbar_isopen=rs_c("w_netbar_isopen")
	w_netbar_content=rs_c("w_netbar_content")
	else
	Response.Write("程序配置文件丢失！")
	Response.end
	end if
	set rs_c=nothing
end sub

'//限制文本内容
function leftStr(content,leftNum)
dim tmp
	if len(content)>leftNum then
		tmp=left(content,leftNum)&".."
	else
		tmp=content
	end if
leftStr=tmp
end function

'//自定义sql
function connExecute(sql,num)
dim tmp
	set rs_sql=conn.execute(sql)
	if not rs_sql.eof then
		tmp=rs_sql(num)
	else
		tmp=""
	end if
	set rs_sql=nothing
connExecute=tmp
end function

'//输出
function p3t(txt):response.Write(txt):end function
'//停止
function p3t_end():response.end:end function

'//分页
function getPages(Rs,NowPage,PageSize,PageList,LinkFile)
dim tmp,SizeNum
	SizeNum=5
	if LinkFile<>"?" then LinkFile=LinkFile&"&"
	tmp=tmp & "<span id='page'>"&NowPage&"/"&Rs.PageCount&"页</span>"
	if NowPage>1 then 
		tmp=tmp&" <a href='"&LinkFile&"page=1' target='_self'>首页</a> <a href='"&LinkFile&"page="&NowPage-1&"' target='_self'>上一页</a>"
	else
		tmp=tmp&" <a href='javascript:;' target='_self'>首页</a> <a href='javascript:;' target='_self'>上一页</a>"
	end if
	For PageList=NowPage-SizeNum To NowPage+SizeNum-1
		If PageList=NowPage Then 
			tmp=tmp&" <a style='color:red;'>"&PageList&"</a>"
		Elseif PageList>=1 and PageList<=Rs.PageCount then
			tmp=tmp&" <a href='"&LinkFile&"page="&PageList&"'>"&PageList&"</a>"
		end If 
	Next
	if NowPage<Rs.PageCount then 
		tmp=tmp&" <a href='"&LinkFile&"page="&NowPage+1&"' target='_self'>下一页</a> <a href='"&LinkFile&"page="&Rs.PageCount&"' target='_self'>尾页</a>"
	else
		tmp=tmp&" <a href='javascript:;' target='_self'>下一页</a> <a href='javascript:;' target='_self'>尾页</a>"
	end if
getPages=tmp
end function


'//日期格式化
Public Function FormatDate(DateAndTime, para)
On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = CStr(Year(DateAndTime))
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1"
'显示格式：09年07月06日 13:44 
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
'显示格式：2009-07-06
strDateTime = y & "-" & m & "-" & d
Case "3"
'显示格式：2009-07-06 13:45
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi
Case "4"
'显示格式：2009年07月06日
strDateTime = y & "年" & m & "月" & d & "日"
Case "5"
'显示格式：07-06 13:45
strDateTime = m & "-" & d & " " & h & ":" & mi
Case "6"
'显示格式：07/06
strDateTime = m & "/" & d
Case "7"
'显示格式：07月06日
strDateTime = m & "月" & d & "日"
Case "8"
'显示格式：2009年07月
strDateTime = y & "年" & m & "月"
Case "9"
'显示格式：2009-07
strDateTime = y & "-" & m
Case "10"
'显示格式：2009/07
strDateTime = y & "/" & m
Case "11"
'显示格式：09年07月06日 13:45
strDateTime = right(y,2) & "年" &m & "月" & d & "日 " & h & ":" & mi
Case "12"
'显示格式：09-07-06
strDateTime = right(y,2) & "-" &m & "-" & d
Case "13"
'显示格式：07-06
strDateTime = m & "-" & d
Case "14"
'显示格式：13:45
strDateTime = h & ":" & m
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function

'正则替换(表达式,字符串,结果|$1)
Function replaceExp(patrn,strng,result)
Dim regEx,Matches
Set regEx=New RegExp
regEx.Pattern=patrn
regEx.IgnoreCase=True
regEx.Global=True
Matches=regEx.replace(strng,result)
replaceExp=Matches
End Function 

Function GetURL(URL)
Set http=Server.CreateObject("Micro"&"soft.XML"&"HTTP")
 On Error Resume Next
 http.Open "GET",URL,False 
 http.send()
 if Err then
 Err.Clear
 Response.Write("没有找到网页!")
 Response.End()
 End if
 getHTTPPage=bytesToBSTR(Http.responseBody,"utf-8")
set http=nothing 
GetURL=getHTTPPage
End Function

function PostURL(URL,data)
Set xo = Server.CreateObject("Ms"&"xml2.XML"&"HTTP") '创建对象
xo.open "POST",url,False
xo.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xo.Send(data) '发送数据 
getHTTPPage=bytesToBSTR(xo.responseBody,"utf-8")
Set xo = Nothing
PostURL=getHTTPPage
end function

Function BytesToBstr(body,Cset)
dim objstream 
set objstream = Server.CreateObject("adodb.stream") 
objstream.Type = 1 
objstream.Mode =3 
objstream.Open 
objstream.Write body 
objstream.Position = 0 
objstream.Type = 2 
objstream.Charset = Cset 
BytesToBstr = objstream.ReadText 
objstream.Close 
set objstream = nothing 
End Function

'截取字符串,1.包括起始和终止字符，2.不包括  
Function strCut(strContent,StartStr,EndStr,CutType)  
Dim strHtml,S1,S2  
strHtml = strContent  
On Error Resume Next  
Select Case CutType  
Case 1  
S1 = InStr(strHtml,StartStr)  
S2 = InStr(S1,strHtml,EndStr)+Len(EndStr)  
Case 2  
S1 = InStr(strHtml,StartStr)+Len(StartStr)  
S2 = InStr(S1,strHtml,EndStr)  
End Select  
If Err Then  
strCute = "<p align='center'>没有找到需要的内容。</p>"  
Err.Clear  
Exit Function  
Else  
strCut = Mid(strHtml,S1,S2-S1)  
End If  
End Function 

Function UrlEncode_GBToUtf8(szInput)
    Dim wch, uch, szRet
    Dim x
    Dim nAsc, nAsc2, nAsc3
    If szInput = "" Then
        UrlEncode_GBToUtf8= szInput
        Exit Function
    End If
    For x = 1 To Len(szInput)
        wch = Mid(szInput, x, 1)
        nAsc = AscW(wch)
        If nAsc < 0 Then nAsc = nAsc + 65536
        If wch = "+" then
            szRet = szRet & "%2B"
        ElseIf wch = "%" then
            szRet = szRet & "%25"
        ElseIf (nAsc And &HFF80) = 0 Then
            szRet = szRet & wch
        Else
            If (nAsc And &HF000) = 0 Then
                uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            Else
                uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
                Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
                Hex(nAsc And &H3F Or &H80)
                szRet = szRet & uch
            End If
        End If
    Next
    UrlEncode_GBToUtf8 = szRet
End Function


Function UrlDecode_GBToUtf8(ByVal str)
    Dim B,ub    ''中文字的Unicode码(2字节)
    Dim UtfB    ''Utf-8单个字节
    Dim UtfB1, UtfB2, UtfB3 ''Utf-8码的三个字节
    Dim i, n, s
    n=0
    ub=0
    For i = 1 To Len(str)
        B=Mid(str, i, 1)
        Select Case B
            Case "+"
                s=s & " "
            Case "%"
                ub=Mid(str, i + 1, 2)
                UtfB = CInt("&H" & ub)
                If UtfB<128 Then
                    i=i+2
                    s=s & ChrW(UtfB)
                Else
                    UtfB1=(UtfB And &H0F) * &H1000    ''取第1个Utf-8字节的二进制后4位
                    UtfB2=(CInt("&H" & Mid(str, i + 4, 2)) And &H3F) * &H40        ''取第2个Utf-8字节的二进制后6位
                    UtfB3=CInt("&H" & Mid(str, i + 7, 2)) And &H3F        ''取第3个Utf-8字节的二进制后6位
                    s=s & ChrW(UtfB1 Or UtfB2 Or UtfB3)
                    i=i+8
                End If
            Case Else    ''Ascii码
                s=s & B
        End Select
    Next
    UrlDecode_GBToUtf8 = s
End Function

sub Chkhttp()
server_vv=len(Request.ServerVariables("SERVER_NAME"))
server_v1=left(Cstr(Request.ServerVariables("HTTP_REFERER")),server_vv)
server_v2=left(Cstr("http://"&Request.ServerVariables("SERVER_NAME")),server_vv)
if server_v1<>server_v2 or server_v1="" or server_v1="" then
response.Charset="gb2312"
response.write("<script>alert('错误：禁止从站点外部提交数据！')</script>")
response.end
end if
end sub
%>