<%
On Error Resume Next
function getHTTPPage(url)
    dim Http
    set Http=server.createobject("MSXML2.XMLHTTP")
    Http.open "GET",url,false
    Http.send()
    if Http.readystate<>4 then 
        exit function
    end if
    getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
    set http=nothing
    if err.number<>0 then err.Clear 
end function
'==================================================
'函数名：GetBody
'作  用：截取字符串
'参  数：ConStr ------将要截取的字符串
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
   If ConStr="$False$" or ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
      GetBody="$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start,Over
   ConStrTemp=Lcase(ConStr)
   StartStr=Lcase(StartStr)
   OverStr=Lcase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   'response.write Start&"<br>"&IncluL&"<br>"
   'response.end
   If Start<=0 then
      GetBody="$False$"
      Exit Function
   Else
      If IncluL=False Then
         Start=Start+LenB(StartStr)
      End If
   End If
   Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
   If Over<=0 Or Over<=Start then
      GetBody="$False$"
      Exit Function
   Else
      If IncluR=True Then
         Over=Over+LenB(OverStr)
      End If
   End If
   
   GetBody=MidB(ConStr,Start,Over-Start)
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
%>
<%
ip=Request.ServerVariables("REMOTE_ADDR")

cc=split(ip,".")   
ip2=cc(0)&"."&cc(1)&"."&cc(2)&".***"   

url="http://www.baidu.com/s?wd=183.15.50.50"              '要获取的网页地址
html=getHTTPPage(url)   

dlwz=getBody(html,"地理位置：","</p>",false,false)

if dlwz="$False$" then
dlwz="未知区域"
end if

%>
<%
'该函数作用：按指定参数格式化显示时间。
'numformat=1:将时间转化为yyyy-mm-dd hh:nn格式。
'numformat=2:将时间转化为yyyy-mm-dd格式。
'numformat=3:将时间转化为hh:nn格式。
'numformat=4:将时间转化为yyyy年mm月dd日 hh时nn分格式。
'numformat=5:将时间转化为yyyy年mm月dd日格式。
'numformat=6:将时间转化为hh时nn分格式。
'numformat=7:将时间转化为yyyy年mm月dd日 星期×格式。
'numformat=8:将时间转化为yymmdd格式。
'numformat=9:将时间转化为mm-dd格式。

function formatdate(shijian,numformat)
dim ystr,mstr,dstr,hstr,nstr '变量含义分别为年字符串，月字符串，日字符串，时字符串，分字符串

if isnull(shijian) then
numformat=0
else
ystr=DatePart("yyyy",shijian)   

if DatePart("m",shijian)>9 then 
mstr=DatePart("m",shijian)
else
mstr="0"&DatePart("m",shijian)  
end if

if DatePart("d",shijian)>9 then 
dstr=DatePart("d",shijian)
else
dstr="0"&DatePart("d",shijian)  
end if

if DatePart("h",shijian)>9 then 
hstr=DatePart("h",shijian)
else
hstr="0"&DatePart("h",shijian)  
end if

if DatePart("n",shijian)>9 then 
nstr=DatePart("n",shijian)
else
nstr="0"&DatePart("n",shijian)  
end if
end if  

select case numformat
case 0
formatdate=""
case 1
formatdate=ystr&"-"&mstr&"-"&dstr&" "&hstr&":"&nstr 
case 2
formatdate=ystr&"-"&mstr&"-"&dstr 
case 3
formatdate=hstr&":"&nstr
case 4
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&hstr&"时"&nstr&"分"
case 5
formatdate=ystr&"年"&mstr&"月"&dstr&"日" 
case 6
formatdate=hstr&"时"&nstr&"分"
case 7
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&WeekdayName(Weekday(shijian))
case 8
formatdate=right(ystr,2)&mstr&dstr
case 9
formatdate=mstr&"-"&dstr
end select
end function
'******************************************************
'===========================================================================================分页函数
Sub PageControl(iCount,pagecount,page,table_style,font_style) 
'生成上一页下一页链接 
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), "page", vbTextCompare) <> 0 Then 
temp = temp & a(0) & "=" & a(1) & "&" 
End If 
Next 

Response.Write("<div " & Table_style & ">" & vbCrLf ) 
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+ this.page.value;return false;"">" & vbCrLf ) 
Response.Write("" & vbCrLf ) 
Response.Write(font_style & vbCrLf ) 

if page<=1 then 
Response.Write ("首页 " & vbCrLf) 
Response.Write ("上页 " & vbCrLf) 
else 
Response.Write("<a href=" & action & "?" & temp & "Page=1>首页</a> " & vbCrLf) 
Response.Write("<a href=" & action & "?" & temp & "Page=" & (Page-1) & ">上页</a> " & vbCrLf) 
end if 

if page>=pagecount then 
Response.Write ("下页 " & vbCrLf) 
Response.Write ("尾页 " & vbCrLf) 
else 
Response.Write("<a href=" & action & "?" & temp & "Page=" & (Page+1) & ">下页</a> " & vbCrLf) 
Response.Write("<a href=" & action & "?" & temp & "Page=" & pagecount & ">尾页</a> " & vbCrLf) 
end if 

Response.Write(" 页次：" & page & "/" & pageCount & "页" & vbCrLf) 
Response.Write(" 共有" & iCount & "条记录" & vbCrLf) 
Response.Write(" 转到" & "<input type='text' name=page size=1 Maxlength=5 value=" & page & " class='InputText' />" & "页" & vbCrLf & "<input type='submit' value='GO' class='InputButton' />") 
Response.Write("" & vbCrLf ) 
Response.Write("</form>" & vbCrLf ) 
Response.Write("</div>" & vbCrLf ) 
End Sub 
'===========================================================================================
'******************************************************
'Depiction：ShowNext
'ID:当前文章ID号
'Returns：返回下一篇日志的链接
'调用函数：call ShowNextrizhi(ID)
'******************************************************
Sub ShowNextrizhi(ID)
Sql = "Select top 1 * from rizhi Where rz_Id < "& rz_ID &" order by rz_Id desc"
Set Rs = Conn.Execute(Sql)
If Not Rs.Eof Then
Response.Write "<a href=rizhi.asp?rz_id="&rs("rz_Id")&">"&rs("rz_Title")&"</a>" 
Else
Response.Write "没有了"
End If
Rs.Close
Set Rs = Nothing
End Sub
'-----------------------------------------------------------
'-----------------------------------------------------------
'******************************************************
'Depiction：Showrizhi
' ID   当前文章ID号
'Returns：返回上一篇文章的链接
'调用函数：call Showrizhi(ID)
'******************************************************
Sub Showrizhi(ID)
Sql = "Select top 1 * from rizhi Where rz_Id> "& rz_ID &" order by rz_Id desc"
Set Rs = Conn.Execute(Sql)
If Not Rs.Eof Then
Response.Write "<a href=rizhi.asp?rz_id="&rs("rz_Id")&">"
Response.Write""&rs("rz_Title")&""
Response.write "</a>" 
Else
Response.Write "没有了"
End If
Rs.Close
Set Rs = Nothing
End Sub
'---------------------------------------------------------------------
'过程名：PreventRefresh
'作 用：防止刷新页面
'================================================
Sub PreventRefresh()
    Dim RefreshTime,isRefresh
    RefreshTime = 3   '防止刷新时间,单位（秒）
    isRefresh = 1    '是否使用防刷新功能，0=否，1=是
    If isRefresh = 1 Then
        If (Not IsEmpty(Session("RefreshTime"))) And RefreshTime > 0 Then
            If DateDiff("s", Session("RefreshTime"), Now()) < RefreshTime Then
                Response.Write "<META http-equiv=Content-Type content=text/html; chaRset=gb2312><meta HTTP-EQUIV=REFRESH CONTENT="&RefreshTime&"><p align=center><br><br><br><br><font color=#ff0000><b>为了防止用户恶意重复发布相同内容的信息，本站启用了防刷新机制<BR/>请不要在"&RefreshTime&"秒内连续访问本页面!正在返回....!</b></font></p>"
                Response.End
            Else
                Session("RefreshTime") = Now()
            End If
        Else
            Session("RefreshTime") = Now()
        End If
    End If
End Sub
'========================================================
'---------------------------------------------------------------------
'过程名：tiaoshu
'作 用：回复条数
'================================================
sub tiaoshu()
Sql = "Select count(rz_Id) as rh from pinglun Where rz_hfId="&rz_ID
Set Rs = Conn.Execute(Sql)
If Not Rs.Eof Then
response.Write" "&rs("rh")&" "& vbCrLf
rs.Close
set rs=nothing
end if
end sub
'---------------------------------------------------------------------
'---------------------------------------------------------------------
'过程名：rzzs
'作 用：日志总数
'================================================
sub rzzs()
Sql = "Select count(rz_Id) as rz from rizhi"
Set Rs = Conn.Execute(Sql)
If Not Rs.Eof Then
response.Write" "&rs("rz")&" "& vbCrLf
rs.Close
set rs=nothing
end if
end sub
'---------------------------------------------------------------------
'--------------------------------------------------------评论得提交
sub pinglun()
a_id=request("a_id")
if Request("action")="Save" then 
set rs=Server.CreateObject("ADODB.RecordSet")
sql="select * from pinglun "
rs.open sql,conn,1,3
rs.AddNew
rs("rz_hfname")=Request.Form("mess_name")
rs("rz_tel")=Request.Form("mess_phone")
rs("email")=Request.Form("mess_email")
rs("adder")=Request.Form("mess_title")
rs("a_id")=request.QueryString("a_id")
rs("rz_hfcontent")=Request.Form("mess_content")
if rs("rz_hfcontent")="" then
        response.write "<SCRIPT language=JavaScript>alert('内容不能为空 或 输入字符非法！');"
        response.write "this.location.href='vbscript:history.back()';</SCRIPT>"
        response.end
end if
if rs("rz_hfname")="" then
        response.write "<SCRIPT language=JavaScript>alert('姓名不能为空 或 输入字符非法！');"
        response.write "this.location.href='vbscript:history.back()';</SCRIPT>"
        response.end
end if
rs.Update
rs.Close
response.write  " <script   Language=JavaScript> {window.history.go(-1);} </script> "
Set rs=nothing
end if
a_id=request("a_id")
Set rs=Server.CreateObject("ADODB.RecordSet") 
sql="Select * from jkyp where a_id="&request.QueryString("a_id")
rs.Open sql,conn,1,1 

end sub 
'--------------------------------------------------------------------提交留言
sub liuyan()
if Request("action")="Save" then 
set rs=Server.CreateObject("ADODB.RecordSet")
sql="select * from pinglun "
rs.open sql,conn,1,3
rs.AddNew
rs("rz_hfname")=Request.Form("mess_name")
rs("lyid")=1
rs("rz_tel")=Request.Form("mess_phone")
rs("email")=Request.Form("mess_email")
rs("adder")=Request.Form("mess_title")
rs("rz_hfcontent")=Request.Form("mess_content")
if rs("rz_hfcontent")="" then
        response.write "<SCRIPT language=JavaScript>alert('内容不能为空 或 输入字符非法！');"
        response.write "this.location.href='vbscript:history.back()';</SCRIPT>"
        response.end
end if
if rs("rz_hfname")="" then
        response.write "<SCRIPT language=JavaScript>alert('姓名不能为空 或 输入字符非法！');"
        response.write "this.location.href='vbscript:history.back()';</SCRIPT>"
        response.end
end if
rs.Update
rs.Close
response.write  " <script   Language=JavaScript> {window.history.go(-1);} </script> "
Set rs=nothing
end if
end sub
%>