這樣簡單實用
<%
dim sum '数据库中题目总数
dim snum '要选题目总数
dim cursum '已选的题目总数
dim arr() '存已选的题目
dim cur '当前选的
'-----------------------------------
snum=cint(dannum)
Randomize
intRand = Int(100* Rnd +1)
set rs1=Server.createobject("adodb.recordset")
sql="select * from 題庫 where ****
rs1.open sql,conn,3,2
sum=rs1.recordcount
if sum<snum then '如果题目总数少于要抽取题目的数目,退出程序
response.write"还没有您要考试科目的试题"
response.end
end if
redim arr(snum)
cursum=0
while cursum<=snum
cur=Int(sum*Rnd+1)
for i=1 to cursum
if arr(i-1)=cur then
exit for
end if
next
if cursum=0 or i>cursum then
arr(cursum)=cur
cursum=cursum+1
end if
wend
for i=0 to snum-1
rs1.movefirst
'response.write arr(i)&" "
rs1.move arr(i)-1
%>
楼上goldme76(金蜂)的方法很好,但是美中不足。因为取得的20条记录有可能会有重复的。看我的:
<%
Dim sql, i, rs, arrMax, arrRs(19)
Randomize
Set rs = Server.CreateObject("Adodb.Recordset")
sql="SELECT * FROM table"
rs.Open sql, conn, 1, 1
If rs.RecordCount > 19 Then
arrMax = 19
Else
arrMax = rs.RecordCount - 1
End If
getRndArr rs.RecordCount '调用子程序
For i = 0 To arrMax
rs.AbsolutePosition = arrRs(i)
......取出数据......
Next
Sub getRndArr(maxRC)
Dim n, rndInt
For n = 0 To arrMax
rndInt = CLng(Rnd() * maxRC)
If Not chkExist(rndInt, n) Then
arrRs(n) = rndInt - 1
Else
n = n - 1
End If
Next
End Sub
Function chkExist(theRndV, arrPc)
Dim p
For p = 0 To arrPc
If arrRs(p) = theRndV Then
chkExist = True
Exit Function
End If
Next
chkExist = False
End Function
%>