一个asp+mssql 站的 BUG 求解决

[hack600]

正常情况下 上面的采集的到开奖信息， 下面是预测号码的 个位 十位 前三 后面的期号应该都是最新的已开奖20131208-107 （下一期是201308-108 还没有开奖）

但是存在一个BUG ，期号有时候会 卡在前面某一期，有时候过一段时间又好，有时候是一整天。刷新，重启服务器都没用。所以我怀疑是 代码写的不严谨导致的

哪位大神能帮忙解决

下面是代码片段

	'预测下一期
	nextqs=cstr(cint(right(qihao,3))+1)
	
	if nextqs="121" then 
		jsdaymoney rq,1
		jsdaymoney rq,2
		jsdaymoney rq,3
		NewDate=now()
		if hour(NewDate)>3 then NewDate=NewDate+1
		rq=year(NewDate)*10000+month(NewDate)*100+day(NewDate)
		nextqs="001"
	end if
	nextqs=rq & left("-0000",4-len(nextqs)) & nextqs
	ychm=""
	sql="insert into his(rq,qs,ychm,zj) values('" & rq & "','" & nextqs  & "','" & ychm & "',0)"
	conn.execute(sql)
	
	response.write "<br>" & "预测下一期" & nextqs &"号码为：" & ychm
else
	response.write "<br>" & rs("qs") & "已经存在，号码=" & rs("hm") & "，日期:" & rs("rq") & ",预测号码=" & rs("ychm")
end if
rs.close
set rs=nothing
ConnClose()

response.write "<hr>" & Application("msg1")
response.write "<hr>" & Application("msg2")
response.write "<hr>" & Application("msg3")

%>
<%
Function getHTTPPage(url) 
	On Error Resume Next
	dim http 
	set http=Server.createobject("MSXML2.XMLHTTP") 
	Http.open "GET",url,false 
	'http.setRequestHeader "Cache-Control","no-cache"
	Http.setRequestHeader "If-Modified-Since", "0"
	Http.send() 
	if Http.readystate<>4 then
		exit function 
	end if 
    getHTTPPage=Http.responsetext
    set http=nothing
	If Err.number<>0 then 
		getHTTPPage="0"

		Response.Write "" 
		Err.Clear
	End If  
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

Function strCut(strContent,StartStr,EndStr,CutType)
	Dim S1,S2
	On Error Resume Next
	Select Case CutType
	Case 1
		S1 = InStr(strContent,StartStr)
		S2 = InStr(S1,strContent,EndStr)+Len(EndStr)
	Case 2
		S1 = InStr(strContent,StartStr)+Len(StartStr)
		S2 = InStr(S1,strContent,EndStr)
	End Select
	If Err Then
		strCute = ""
		Err.Clear
		Exit Function
	Else
		strCut = Mid(strContent,S1,S2-S1)
	End If
End Function


Function ZqHaoma(qs,n,p)
'检查范围是最近多少期
F=2
'符合条件后设置中的概率
G=80
'平均概率
PJ=55 


Randomize()
set rs1=server.CreateObject("adodb.recordset")

sql="select count(*) AS js from (select  top " & F & " * from his where ychm<>''  order by id desc) as A where A.zj=1"
'response.write sql
rs1.open sql,conn,1,1

if p=1 then   msg="个位" else msg="十位"
if rs1("js")<1 then msg="<br>"& msg& qs & "符合最近"&F&"期没出条件，" else msg="<br>"& msg&  qs & "不符合最近"&F&"期没出条件，" 
if rs1("js")<1 and (rnd()*1000 mod 100<G)  then 	T=2 else 	T=1

rs1.close
set rs1=nothing

if T=2 then
	msg = msg+"按最近没出强制更改！<br>"
	for i=1 to 1000
	 hm=NewHaoma()
	 if InStr(hm,n)>0 then	exit for
	next 
else
   if rnd()*100<PJ then
	msg = msg+"按平均概率"&PJ&"%计算，并中奖！<br>"
	for i=1 to 1000
	 hm=NewHaoma()
	 if InStr(hm,n)>0 then	exit for
	next 	
   else
	msg = msg+"按平均概率"&PJ&"%计算，没中奖！<br>"
	for i=1 to 1000
	 hm=NewHaoma()
	 if InStr(hm,n)=0 then	exit for
	next 
   end if
end if

ZqHaoma=hm
msg=msg & "<br>预测的中奖号码是：" & hm & "!"
if p=1 then Application("msg1")=msg else Application("msg2")=msg
End Function


Function NewHaoma()
dim a(10)
randomize()
for i=0 to 9 
  a(i)=0
next
t=0
for i=1 to 100
  p=rnd()*1000 mod 10
  if a(p)=0 then
    a(p)=1
    t=t+1
  end if
 if t=5 then 
	exit for
 end if
next

hm=""
for i=0 to 9 
 if a(i)=1 then 
      hm=hm & i
 end if
next
NewHaoma=hm

End Function


Function ZqQ3Haoma(qs,kjhm)
'检查范围是最近多少期
F=2
'符合条件后设置中的概率
G=80
'平均概率
PJ=78

set rs1=server.CreateObject("adodb.recordset")

sql="select count(*) AS js from (select  top " & F & " * from his where ychm3<>''  order by id desc) as A where A.zj3=1"
'response.write sql
rs1.open sql,conn,1,1
msg="<br>前三"& qs & "计数为"& rs1("js") & ","
if rs1("js")<1 then msg=msg &"符合最近"&F&"期没出条件，" else msg=msg & "不符合最近"&F&"期没出条件，" 


if rs1("js")<1 and (rnd()*1000 mod 100<G)  then 	T=1 else 	T=0

rs1.close
set rs1=nothing

if t=0 then	msg=msg & "按开均概率"&pj&"%开奖"
if t=0 and (rnd()*1000 mod 100<PJ) then t=1

for i=0 to 10000 
 	hm=NewQ3Haoma()

	if mid(kjhm,1,1)=mid(hm,1,1) OR mid(kjhm,2,1)=mid(hm,2,1) OR mid(kjhm,3,1)=mid(hm,3,1) then
		if t=0 then exit for
	else
		if t=1 then exit for
	end if

next
ZqQ3Haoma=hm
application("msg3")=msg & ",预测号码为：" & hm
End Function

Function NewQ3Haoma()
randomize()
NewQ3Haoma=(rnd()*1000 mod 10) &  (rnd()*1000 mod 10) & (rnd()*1000 mod 10)
End Function



Function GetNoHtml(str,l)
	Dim s,b,i
	b=0
	j=0
	for i=1 to Len(str) 
		c=mid(str,i,1)

		if b=2 and c<>"<" then
		 	s=s & c
			j=j+1
		end if

		if c="<" then
			b=1
		elseif c=">" then 
			b=2
		end if
	
		if j>=l then exit for
	next
	GetNoHtml=s
End Function


%>

[csdn_aspnet]

你输出一下 看看到底在哪卡主 或者加个日志功能

[hack600]

哪位大神能解决的，分数奉上。另支付宝 赠100 。

[hack600]

mark 顶下。。CSDN的大神呢

[hack600]

mark 顶下。。CSDN的大神呢！

[hack600]

mark 顶下。。CSDN的大神呢！