□浮生蕭條□

<!--#include file="look_ip.asp" -->
<%
Dim db2,conn2,connstr2
db2="data/weathercity.mdb"
Set conn2 = Server.CreateObject("ADODB.Connection")
connstr2="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db2)
conn2.open connstr2
set rs2=Server.CreateObject("ADODB.Recordset")

function CloseDatabase
Conn2.close
Set conn2 = Nothing
End Function
<%
ip=request.ServerVariables("REMOTE_HOST")
response.write "IP地址："&ip
response.write " "
address=lookaddress(ip)
response.write "来自于："&address&"<br><br>"

set rs2=conn2.execute("select * from weathercity where instr('"&address&"',city)>0")
if not rs2.eof then
if isnumeric(rs2("weathercode")) then
%>

<%
Html=GetURL("http://www.t7online.com/cgi-bin/citydruck?WMO="&rs2("weathercode")&"&LANG=cn&TIME=1127291869")
'获取远程文件

Function GetURL(url)
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "GET", url, False
.Send
GetURL = .responsebody
GetURL = Bytes2BStr(GetURL)
if len(.responsebody)<100 then
response.write "Error: Get URL"
response.end
end if

End With
Set Retrieval = Nothing
End Function

'二进制转换
Function bytes2bstr(vin)
strreturn = ""
for i = 1 to lenb(vin)
thischarcode = ascb(midb(vin,i,1))
if thischarcode < &h80 then
strreturn = strreturn & chr(thischarcode)
else
nextcharcode = ascb(midb(vin,i+1,1))
strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))
i = i + 1
end if
next
bytes2bstr = strreturn
End Function

'取得特定文字之间的文字
Function GetBetween(Text0, Text1, Text2)
pos_1 = Instr(Text0, Text1)
pos_2 = Instr(Text0, Text2)
GetBetween = Mid(Text0, pos_1 + len(Text1), pos_2 - pos_1 - len(Text1))
End Function

'正则表达式替换
Function RegExpTest(patrn,strng,rewho)
Dim re,Match,Matches
RetStr=strng
Set re = New RegExp '建立正则表达式
re.Pattern = patrn '建立正则表达式模式
re.IgnoreCase = True '是否不区分大小写，你可以关闭，因为HTML标记是不区分大小写的。
re.Global = True '是否全局可用
Set Matches = re.Execute(strng) '执行搜索
For Each Match in Matches '遍历匹配集合
RetStr=replace(RetStr,match.value,rewho) '找到区配字符，并开始替换
Next
RegExpTest = RetStr
End Function

city=getbetween(html,"<b>","</b>")

'response.write city
'response.end

table_body="<table border=1>"&getbetween(html,"BGCOLOR=""#ffffff"">","</table>")&"</table>"
table_body=regexptest("<TD.+?>",table_body,"<td>")
table_body=replace(table_body,"src=""/daten/symbole/","src=""http://www.t7online.com/daten/symbole/")
response.write "<div align=center><b>"&city&"</b>"&"</div><br>"&"<div align=center>"&table_body&"</div>"
%>

<%end if
else%>

<script language="javascript"
src="http://extern.t7online.com/javascript/teaser_<%rs2("weathercode")%>.js">
</script>
===
上面是index部分，下面是lookip.asp

<%

function lookaddress(sip)
dim str1,str2,str3,str4
dim num
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

Dim adb,aConnStr,AConn

adb = "data/ipaddress.mdb"
Set aconn = Server.CreateObject("ADODB.Connection")
aconnstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(adb)

aConn.Open aConnStr

sql="select country,city from [address] where ip1 <="&num&" and ip2 >="&num
set irs=aconn.execute(sql)

if irs.eof and irs.bof then
lookaddress="数据库未保存该IP信息"
else
do while not irs.eof
lookaddress=lookaddress &irs(0)& irs(1)
irs.movenext
loop
end if
irs.close
set irs=nothing
Set AConn=Nothing
end if
else
lookaddress="数据库未保存该IP信息"
end if

end function

end if
closedatabase%>




===
最新的IP库下载（也是偶做的）：
www.92yao.com/data/ipaddress.mdb
==