一个公交查询系统

<!--#include file="conn.asp"-->
<%
Dim startTag,endTag,rs,sql,i,j,str,q,r,k,a(),b(),m,aa(),aaa(),aaaa(),aaaaa(),bb(),bbb(),bbbb(),bbbbb(),Onlynum,oneDirect,ii,jj,ww
i=0
j=0
startTag="卫岗"
EndTag="新庄"
sql="SELECT * FROM Bus025 WHERE (CHARINDEX('"&startTag&"', BusLine) > 0)"
set rs=server.CreateObject("Adodb.recordset")
rs.open sql,conn,1,1
'取得所有经过这站的线路
redim a(rs.recordcount)
redim aa(rs.recordcount)
redim aaa(rs.recordcount)
redim aaaa(rs.recordcount)
redim aaaaa(rs.recordcount)
do while not rs.eof
a(i)=rs("BusLine")
aa(i)=rs("BusNo")
aaa(i)=rs("stime")
aaaa(i)=rs("etime")
aaaaa(i)=rs("dtime")
i=i+1
rs.movenext
loop
rs.close

sql="SELECT * FROM Bus025 WHERE (CHARINDEX('"&EndTag&"', BusLine) > 0)"
rs.open sql,conn,1,1
redim b(rs.recordcount)
redim bb(rs.recordcount)
redim bbb(rs.recordcount)
redim bbbb(rs.recordcount)
redim bbbbb(rs.recordcount)
'取得所有经过这站的线路
do while not rs.eof
b(j)=rs("BusLine")
bb(j)=rs("BusNo")
bbb(i)=rs("stime")
bbbb(i)=rs("etime")
bbbbb(i)=rs("dtime")
j=j+1
rs.movenext
loop
rs.close

sql="SELECT * FROM Bus025 WHERE (CHARINDEX('"&EndTag&"', BusLine) > 0) and (CHARINDEX('"&startTag&"', BusLine) > 0)"
rs.open sql,conn,1,1
if not rs.eof then
str="有线路如下:<br>"
m=0
do while not rs.eof
m=m+1
q=rs("BusLine")
r=split(q,"-")
str=str&"<font color='#0000FF'><b>第"&m&"种方案--直达线路</font></b><br>"&rs("BusNo")&"始站时间："&rs("stime")&"末站时间："&rs("etime")&"最后更新时间"&"  "&rs("Dtime")&"<br>"
if Instr(q,startTag)<Instr(q,EndTag) then
for ii=0 to ubound(r) step 1
if r(ii)=starttag or r(ii)=endtag then
str=str&"<font color='#FF0000' ><b>"&r(ii)&"</b></font>"&"-"
else
str=str&r(ii)&"-"
end if
next
else
for ii=ubound(r) to 0 step -1
if r(ii)=endtag or r(ii)=starttag then
str=str&"<font color='#FF0000' ><b>"&r(ii)&"</b></font>"&"-"
else
str=str&r(ii)&"-"
end if
next
end if
str=left(str,len(str)-1)
str=str&"<br>"
rs.movenext
loop
else
str=str+"没有直达车"
end if
rs.close
'取得转达一次的所有车
'response.Write str
'response.End()
if str="没有直达车" then
ww=oneline(a,aa,b,bb,startTag,EndTag,m)
str=str+"<br>需要转车方案<br><br>"+ww
else
str=str
end if

function oneline(a,aa,b,bb,startTag,EndTag,m)
dim p,n,c,o,f,ano,bno,statnum,statnum1,str1,Lcount,sline,sCount,exst,str2
'取得所有经过起始点的线路
for p=0 to ubound(a)-1
'取得其中的某条线路分割出各个站点
ano=aa(p)
r=split(a(p),"-")
'取得所有经过b点的所有线路
for n=0 to ubound(b)-1
bno=bb(n)
if cstr(bno)<>cstr(ano) then
'取得经过某条信路上所有站点
c=split(b(n),"-")
'遍例两个数组中看是否有相同的站点，有就读出来，没有就算了
statnum=0
Lcount=0
sCount=0
exst=false
for f=0 to ubound(r)-1
for o=0 to ubound(c)-1
if trim(r(f))=trim(c(o)) then
If trim(startTag)<>trim(r(f)) then
statnum1=getLineCount(startTag,trim(r(f)),a(p))+getLineCount(trim(r(f)),EndTag,b(n))
if Lcount=0 then
sCount=statnum1
Lcount=Lcount+1
exst=true
str1="(共"&sCount&"站)</b></font><br>"+aa(p)&"始发时间:"&aaa(p)&"末站时间:"&aaaa(p)&"最新更新时间:"&aaaaa(p)&"<br>"&getMidLine(startTag,trim(r(f)),a(p))&"<br>"&"转"&bb(n)&"<br>"&getMidLine(trim(r(f)),EndTag,b(n))&"<br>"
end if
'response.write "sCount"&sCount&"<br>"
if Cint(sCount)>Cint(statnum1) then
exst=true
sCount=statnum1
str1="(共"&sCount&"站)</b></font><br>"+aa(p)&"始站时间"&aaa(p)&"末站时间"&aaaa(p)&"最新更新时间"&aaaaa(p)&"<br>"&getMidLine(startTag,trim(r(f)),a(p))&"<br>"&"转"&bb(n)&"<br>"&getMidLine(trim(r(f)),EndTag,b(n))&"<br>"
end if
end if
end if
next
next
if exst=true then
m=m+1
str2=str2&"<font color='#0000FF'><b>第"&m&"种方案---转达一般车"
str2=str2+str1
end if
end if
next
next
oneline=str2
end function
response.write str
'取得一线路上两点间的所有站点
function getMidLine(startT,sameT,lineT)
dim statN,ka,Knum
statN=split(lineT,"-")
if instr(lineT,startT)<instr(lineT,sameT) then
Knum=ubound(statN)-1
for ka=0 to ubound(statN)-1
if trim(statN(ka))=startT then
kum=ka
getMidLine="<font color='#FF0000' ><b>"&startT&"</b></font>"
end if
if trim(statN(ka))=sameT then
kum=ka
getMidLine=getMidLine&" - "&"<font color='#FF0000' ><b>"&sameT&"</b></font>"
exit for
end if
if ka>kum then
getMidLine=getMidLine&" - "&statN(ka)
end if
next
else
Knum=ubound(statN)-1
for ka=0 to ubound(statN)-1
if trim(statN(ka))=sameT then
kum=ka
getMidLine=" - <font color='#FF0000' ><b>"&sameT&"</b></font>"
end if
if trim(statN(ka))=startT then
kum=ka
getMidLine="<font color='#FF0000' ><b>"&startT&"</b></font>"&getMidLine
exit for
end if
if ka>kum then
getMidLine=" - "&statN(ka)&getMidLine
end if
next
end if
end function

'取得一条张上两点间所有的站数
function getLineCount(startT,sameT,lineT)
dim statN,ka,Knum

statN=split(lineT,"-")
if instr(lineT,startT)<instr(lineT,sameT) then
Knum=ubound(statN)-1
for ka=0 to ubound(statN)-1
if trim(statN(ka))=startT then
kum=ka
getLineCount=0
end if
if trim(statN(ka))=sameT then
kum=ka
getLineCount=getLineCount+1
exit for
end if
if ka>kum then
getLineCount=getLineCount+1
end if
next
else
Knum=ubound(statN)-1
for ka=0 to ubound(statN)-1
if trim(statN(ka))=sameT then
kum=ka
getLineCount=0
end if
if ka>kum then
getLineCount=getLineCount+1
end if
if trim(statN(ka))=startT then
kum=ka
getLineCount=getLineCount+1
exit for
end if
next
end if
end function
%>