<%
Option Explicit
dim conn,rs,sql,myConn
dim admin163car,bbs163car,flyasia
session.timeout = 60
set rs = server.CreateObject("ADODB.RECORDSET")
Const webtitle = "汽车e族 汽车热线·中国 中国最火爆的汽车论坛 车迷及发烧友谈车论市的好地方"
Const ConnString="PROVIDER=SQLOLEDB;DATA SOURCE=192.168.81.99,2695;database=163car-3;User Id=163-car;PASSWORD=wL8%kMR^yn#8Na*I6;"
Const admin_title="中国汽车热线网"
sub OpenConn
set conn = server.CreateObject("ADODB.CONNECTION")
conn.Open ConnString
end sub
sub CloseDB
if rs.State=1 then rs.Close
set rs=nothing
if conn.State=1 then conn.Close
set conn=nothing
end sub
'获得session信息
'session结构为：user_id(company_id)+user_kind(企业是1，个人是2)+user_name+user_nick(company)+password
'num为整数，目前为0～4
function GetSessionInfo(num)
dim AryInfo,cookies_userinfo
'session结构user_id+user_kind+user_name+user_nick(company)+pwd+bbs_user_id
cookies_userinfo=request.Cookies("user_info")
if session("user_info")="" then
session("user_info")=cookies_userinfo
end if
AryInfo=split(session("user_info"),"|")
if IsNumeric(num) and (num>=0) and (num<=Ubound(AryInfo)) then
GetSessionInfo=AryInfo(int(num))
else
GetSessionInfo=""
end if
end function
%>
<%
'''分页过程开始'''''''''''''''''''''''''''''''''''''''''''''''''
'分页函数：fenye（）
'传入参数：总记录数（recordcount)、当前页（nowpage）、每页记录数（pagesize）、其它要传递参数字符串（poststr）
'此函数需要外接form，form的action应该等同于本函数中的urlstr变量
'
Sub subPageList(recordcount,nowpage,pagesize,poststr,formname)
dim urlstr,pagecount,fp,lp,fpstr,lpstr,i
Dim poststr_array,poststr_s_array
urlstr=Request.ServerVariables("script_name")
''''''javascript检查输入的函数''''''''''''''''''''''''''''''''''''''''''''''''''''''
response.Write ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
response.write ""
End Sub
'''分页过程结束''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetResult(urlStr,postStr)
Dim xmlHttp
Dim retStr
Set xmlHttp = Server.CreateObject("Msxml2.XMLHTTP") '创建对象
On Error Resume Next '错误处理
xmlHttp.Open "POST", urlStr, False '用 "POST" 方法异步打开连接
'发送表单数据
xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlHttp.Send(postStr) '向服务器发送 HTTP 请求
If Err.Number = 0 Then '如果成功
retStr = xmlHttp.responseText '等待从服务器接受数据
Else
retStr = "地址未发现" '错误信息
End If
Set xmlHttp = nothing '释放对象
GetResult = retStr '返回 response 给调用者
End Function
'过滤字符串中的特殊字符
function Filtrate(str)
dim re
if str="" then
re=""
else
re=trim(str)
re=server.HTMLEncode(re)
re=replace(re,"'","''")
re=replace(re,"%","％")
re=replace(re,"<","[")
re=replace(re,"select","selects")
re=replace(re,"sp_","sp__")
re=replace(re,"xp_","xp__")
re=replace(re,"+","＋")
re=replace(re,"--","－－")
re=replace(re,"exec","execs")
re=replace(re,"declare","declares")
re=replace(re,"dEcLaRe","dEcLaRes")
re=replace(re,"cast","casts")
re=Replace(re, "script", "scripts")
re=Replace(re, "SCRIPT", "SCRIPTs")
re=Replace(re, "Script", "Scripts")
re=Replace(re, "object", "objects")
re=Replace(re, "OBJECT", "OBJECTs")
re=Replace(re, "Object", "Objects")
re=Replace(re, "applet", "applets")
re=Replace(re, "APPLET", "APPLETs")
re=Replace(re, "Applet", "Applets")
re=Replace(re, "execute", "executesss")
re=Replace(re, "exec", "execss")
re=Replace(re, "join", "joins")
re=Replace(re, "union", "unions")
re=Replace(re, "where", "wheres")
re=Replace(re, "insert", "inserts")
re=Replace(re, "delete", "deletes")
re=Replace(re, "update", "updates")
re=Replace(re, "like", "likes")
re=Replace(re, "drop", "drops")
re=Replace(re, "create", "creates")
re=Replace(re, "rename", "renames")
re=Replace(re, "count", "counts")
re=Replace(re, "chr", "chrs")
re=Replace(re, "mid", "mids")
re=Replace(re, "truncate", "truncates")
re=Replace(re, "nchar", "nchars")
re=Replace(re, "char", "chars")
re=Replace(re, "alter", "alters")
re=Replace(re, "cast", "casts")
re=Replace(re, "exists", "existss")
end if
Filtrate=re
end function
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
'If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
'If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
'If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
'If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
'If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & "" & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "." & m & "." & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
Case 6
Format_Time = y &"-" & m & "-" & d
End Select
End Function
Function GetFileExt(FileName)
If FileName<>"" Then
GetFileExt = Mid (FileName,InStrRev (FileName, ".")+1)
Else
GetFileExt = ""
End If
End Function
%>
<% Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
'If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
'If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
'If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
'If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
'If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & "" & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "." & m & "." & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
Case 6
Format_Time = y &"-" & m & "-" & d
End Select
End Function
Sub getFileSize(filename)
set fso=server.CreateObject("Scripting.FileSystemObject")
if err.number<>0 then
response.write "服务器不支持FSO"
on error goto 0
response.end
else
on error goto 0
if fso.fileExists(server.Mappath(filename)) then
set ofile=fso.getFile(server.Mappath(filename))
If ofile.size>1024*1024 Then
response.write Round(( ofile.size/(1024*1024)),2) &" M"
ElseIf ofile.size>1024 Then
response.write Round(( ofile.size/1024),2) &" k"
Else
response.write ofile.size &" byte"
End if
set ofile=nothing
else
response.write "文件不存在"
end if
set fso=nothing
end If
End Sub
Function downloadFile(strFile)
strFilename = server.MapPath(strFile)
Response.Buffer = True
Response.Clear
Set s = Server.CreateObject("ADODB.Stream")
s.Open
s.Type = 1
on error resume next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FileExists(strFilename) then
Response.Write("
Error:
文件不存在
")
Response.End
end if
Set f = fso.GetFile(strFilename)
intFilelength = f.size
s.LoadFromFile(strFilename)
if err then
Response.Write("
Error:
" & err.Description & "
")
Response.End
end if
Response.AddHeader "Content-Disposition", "attachment; filename=" &f.name
Response.AddHeader "Content-Length", intFilelength
Response.CharSet = "UTF-8"
Response.ContentType = "application/octet-stream"
Response.BinaryWrite s.Read
Response.Flush
s.Close
Set s = Nothing
End Function
'****************************************************************
'判断字符串的长度
'****************************************************************
Function LenGBK(str)
dim aa,c
aa=len(str)
Dim i:i=1
While i<=aa
c=asc(mid(str,i,1))
if c<0 Then
c=65536
End if
if c>255 Then
LenGBK=LenGBK+2'中文
Else
LenGBK=LenGBK+1
End If
i=i+1
Wend
End Function
'****************************************************************
'得到字符串的长度
'****************************************************************
Function GetTitle(str,strlen)
Dim strLenGBK:strLenGBK=CInt(strlen)*2
Dim i:i=1
If LenGBK(str)>strLenGBK Then
Do while i<= Len(str)
GetTitle=GetTitle&mid(str,i,1)
If (LenGBK(GetTitle)>=strLenGBK) Then
Exit do
End If
i=i+1
Loop
GetTitle=GetTitle&".."
Else
GetTitle=str
End if
End Function
Function Getname(str,strlen)
Dim strLenGBK:strLenGBK=CInt(strlen)*2
Dim i:i=1
If LenGBK(str)>strLenGBK Then
Do while i<= Len(str)
Getname=Getname&mid(str,i,1)
If (LenGBK(Getname)>=strLenGBK) Then
Exit do
End If
i=i+1
Loop
Getname=Getname
Else
Getname=str
End if
End Function
'***********************************
'[函数名称]:LastNextPage(intPageCount,intPage)
'[功能描述]:后台分页函数
'[入口参数]:intPageCount:总共页数,intPage当前页数
'[函数作者]:geminiblue
'[修改时间]:2007-6-12
'***********************************
Sub LastNextPage(intPageCount,intPage)
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "intPage", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
sTemp="
" & vbCrLf
sTemp=sTemp&"" & vbCrLf
sTemp=sTemp&"
" & vbCrLf
Response.write sTemp
End Sub
'***********************************
'[函数名称]:BriefLastNextPage(intPageCount,intPage)
'[功能描述]:前台分页函数
'[入口参数]:intPageCount:总共页数,intPage当前页数
'[函数作者]:geminiblue
'[修改时间]:2007-6-12
'***********************************
Sub BriefLastNextPage(intPageCount,intPage)
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
'tempquery=Request.ServerVariables("QUERY_STRING")
'Response.write tempquery
'Response.End()
'If instr(tempquery,"Rep")>0 Then
' tempquery=replace(tempquery,"Rep='1'&","")
'end if
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "intPage", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
sTemp="
" & vbCrLf
sTemp=sTemp&"" & vbCrLf
sTemp=sTemp&"
" & vbCrLf
Response.write sTemp
End Sub
'***********************************
'[函数名称]:DataLastNextPage(intPageCount,intPage)
'[功能描述]:前台分页函数
'[入口参数]:intPageCount:总共页数,intPage当前页数
'[函数作者]:geminiblue
'[修改时间]:2007-6-12
'***********************************
Sub DataLastNextPage(intPageCount,intPage)
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "intPage", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
If intPage<=1 Then
sTemp=sTemp&"[上一页] " & vbCrLf
else
sTemp=sTemp&"[上一页] " & vbCrLf
end if
'Response.write intPageCount
Response.write sTemp
TempI=intPageCount
If TempI>9 Then TempI=9
TempFor=TempI+intPage
If TempFor>intPageCount Then TempFor=intPageCount
'Rep=Request("Rep")
dis=intPageCount-intPage
If intPage>4 And dis>6 Then
StartTo=intPage-4
EndTo=TempFor-4
Elseif dis<=6 And intPageCount> 6 then
StartTo=intPageCount-6
EndTo=intPageCount
ElseIf dis<=6 And intPageCount<=6 Then
StartTo=1
EndTo=intPageCount
else
StartTo=1
EndTo=10
End If
For i=StartTo to EndTo
'If TempI+intPage>=intPageCount Then exit for
If i=intPage Then
Response.write ""&i&" "
Else
Response.write ""&i&" "
End IF
Next
if intPage>=intPageCount then
tTemp=tTemp&"[下一页] " & vbCrLf
else
tTemp=tTemp&"[下一页] " & vbCrLf
end if
Response.write tTemp
End Sub
Function Cur_Url() '获取当前页面URL的函数
Dim Domain_Name,Page_Name,Quary_Name
Domain_Name = LCase(Request.ServerVariables("Server_Name"))
Page_Name = LCase(Request.ServerVariables("Script_Name"))
Quary_Name = LCase(Request.ServerVariables("Quary_String"))
If Quary_Name = "" Then
Quary_Name = LCase(Request.QueryString)
End If
If Quary_Name ="" Then
Cur_Url = "http://"&Domain_Name&Page_Name
Else
Cur_Url="http://"&Domain_Name&Page_Name&"?"&Quary_Name
End If
End Function
Public Function GetTextFromHtml(strHtml)
Dim strPatrn
strpatrn="<.*?>"
Dim regEx
Set regEx = New RegExp
regEx.Pattern = strPatrn
regEx.IgnoreCase = True
regEx.Global = True
GetTextFromHtml = regEx.Replace(strHtml,"")
End Function
'chexbox全选函数
'function CheckAll(form)
' {
' for (var i=0;i "
response.Write "function go_onClick(obj,pagecount){"
response.Write " var nowpage = obj.value;"
response.Write " var reg = /[^0-9]$/ ;"
response.Write " if(nowpage ==''){"
response.Write " obj.focus();"
response.Write " alert('警告：页码不能为空！ \n 请输入页码！');"
response.Write " return false;}"
response.Write " if(reg.test(nowpage)){"
response.Write " alert('警告：页码只能是数字！\n 请输入正确的页码');"
response.Write " obj.focus();"
response.Write " return false;}"
response.Write " if(nowpage <1 || nowpage>pagecount){"
response.Write " alert('警告：输入的页码超出范围 [1-'+pagecount+']! \n 请输入正确的页码.');"
response.Write " obj.focus();"
response.Write " return false;}"
response.write " window.location.href = '" &urlstr & "?nowpage='+nowpage+'"&poststr&"';"
response.Write " return true;}"
response.Write ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
response.write "
"
response.write "
"
End Sub
'''分页过程结束''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''部落分页过程开始'''''''''''''''''''''''''''''''''''''''''''''''''
'分页函数：subTribePageList（）
'传入参数：总记录数（recordcount)、当前页（nowpage）、每页记录数（pagesize）、其它要传递参数字符串（poststr）、风格className
'此函数需要外接form，form的action应该等同于本函数中的urlstr变量
'
Sub subTribePageList(recordcount,nowpage,pagesize,poststr,hrefClassName,className)
dim urlstr,pagecount,fp,lp,fpstr,lpstr,i
urlstr=Request.ServerVariables("script_name")
response.write "
"
response.write "
"
if recordcount=0 then
response.write("目前没有记录！")
end if
if recordcount mod pagesize=0 then
pagecount=recordcount/pagesize
else
pagecount=int(recordcount/pagesize)+1
end if
if CInt(nowpage)<1 or nowpage=0 then
nowpage=1
end if
if CInt(nowpage) > CInt(pagecount) then
nowpage=pagecount
end if
response.write "共"&recordcount&"个 "&nowpage&"/"&pagecount&"页 "
fp=nowpage-3
if fp<1 then
fp=1
end if
lp=nowpage+3
if lp>pagecount then
lp=pagecount
end if
''''''''''''''''''''''
if cint(nowpage)>1 then
fpstr=fpstr+"上一页 "
end if
''''''''''''''''''''
if cint(nowpage)下一页 "
end if
''''''''''''''''''''''''
if cint(nowpage)>=1 then
response.write "[ "
end if
for i=fp to lp
if CInt(nowpage) = i then
response.write ""&i&" "
else
response.write ""&i & " "
end if
next
if cint(nowpage)>=1 then
response.write "] "
end if
response.write (fpstr)
response.write (lpstr)
response.write "
"
End Sub
'''部落分页过程结束''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function getclass(num)
select case num
case 1:getclass="A"
case 2:getclass="B"
case 3:getclass="C"
case 4:getclass="D"
case 5:getclass="E"
case 6:getclass="F"
case 7:getclass="G"
case 8:getclass="H"
case 9:getclass="I"
case 10:getclass="J"
case 11:getclass="K"
case 12:getclass="L"
case 13:getclass="M"
case 14:getclass="N"
case 15:getclass="O"
case 16:getclass="P"
case 17:getclass="Q"
case 18:getclass="R"
case 19:getclass="S"
case 20:getclass="T"
case 21:getclass="U"
case 22:getclass="V"
case 23:getclass="W"
case 24:getclass="X"
case 25:getclass="Y"
case 26:getclass="Z"
end select
end function
function Getcar_Parameter(num)
select case num
case 1:Getcar_Parameter="有"
case 2:Getcar_Parameter="无"
case 3:Getcar_Parameter="选择装备"
end select
END function
'获得访问者IP，如果是代理上网，则获得代理IP
function GetIp()
Dim dailiip,realip
dailiip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
if dailiip = "" then
realip = request.servervariables("remote_addr")
else
realip = dailiip
end if
GetIp = realip
end function
'获得访问者的地理位置
function GetIpAddress(ip)
Dim ipArray,ipnum,ip1,ip2,ip3,ip4
Dim SqlStr,RsLocal,re
re = ""
ipArray = split(ip,".",-1,1)
ip1 = ipArray(0)
ip2 = ipArray(1)
ip3 = ipArray(2)
ip4 = ipArray(3)
ipnum = CInt(ip1)*256*256*256+CInt(ip2)*256*256+CInt(ip3)*256+CInt(ip4)-1
if IsNumeric(ip1)=0 or IsNumeric(ip2)=0 or IsNumeric(ip3)=0 or IsNumeric(ip4)=0 then
re = "未知区域"
else
SqlStr = "select top 1 address from allip where start_ip<="&ipnum&" and end_ip>="&ipnum&" order by id desc"
set RsLocal = conn.execute(SqlStr)
if RsLocal.eof then
re = "未知区域"
else
re = RsLocal("address")
end if
RsLocal.Close
set RsLocal = nothing
end if
GetIpAddress = re
end function
'Rem 判断用户来源
function address_dispbbs(sip)
dim str1,str2,str3,str4
dim num
dim country,province,city,isp
dim irs
if isnumeric(left(sip,2)) then
if sip="127.0.0.1" then sip="192.168.0.1"
str1=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str2=left(sip,instr(sip,".")-1)
sip=mid(sip,instr(sip,".")+1)
str3=left(sip,instr(sip,".")-1)
str4=mid(sip,instr(sip,".")+1)
if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then
else
num=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
sql="select Top 1 country,province,city,isp from [bbstest]..address1 where ip1 <="&num&" and ip2 >="&num&" order by ip2 asc"
set irs=server.createobject("adodb.recordset")
irs.open sql,conn,1,1
if irs.eof and irs.bof then
country="亚洲"
city=""
address_dispbbs="未知"
else
country=irs(0)
province=irs(1)
city=irs(2)
isp=irs(3)
address_dispbbs=country&province&city
end if
irs.close
set irs=nothing
end if
'address=country&province&city&isp
else
address_dispbbs="未知"
end if
end function
'获得访问者的省份
function GetIpProvince(ip)
Dim IpAddress
Dim SqlStr,RsLocal,re
re = ""
IpAddress = GetIpAddress(ip)
SqlStr = "select province_name from province where charindex('"&left(IpAddress,2)&"',province_name)>0"
SqlStr = "P_RecordPageList '"&replace(SqlStr,"'","''")&"',200,1,'',''"
set RsLocal = conn.execute(SqlStr)
if RsLocal.eof then
re = "国外"
else
re = RsLocal("province_name")
end if
RsLocal.Close
set RsLocal = nothing
GetIpProvince = re
end function
function GetSessionInfo(num)
dim AryInfo,cookies_userinfo
'session结构user_id+user_kind+user_name+user_nick(company)+pwd+bbs_user_id
cookies_userinfo=request.Cookies("user_info")
if session("user_info")="" then
session("user_info")=cookies_userinfo
end if
AryInfo=split(session("user_info"),"|")
if IsNumeric(num) and (num>=0) and (num<=Ubound(AryInfo)) then
GetSessionInfo=AryInfo(int(num))
else
GetSessionInfo=""
end if
end function
function getjg(num)
select case num
case 1:getjg="8以下"
case 2:getjg="8-12"
case 3:getjg="12-20"
case 4:getjg="20-40"
case 5:getjg="40以上"
end select
end function
function getinfoclass(num)
select case num
case 1:getinfoclass="050101"
case 2:getinfoclass="050102"
case 3:getinfoclass="0505"
end select
end function
Function GetFileExt(FileName)
If FileName<>"" Then
GetFileExt = Mid (FileName,InStrRev (FileName, ".")+1)
Else
GetFileExt = ""
End If
End Function
%>
汽车论坛|车迷实拍 自驾游|汽车BBS－163car中国汽车网
