随机功能无法正常工作

时间:2013-05-07 21:40:25

标签: arrays random asp-classic vbscript

我在使用包含随机函数的asp页面时出现问题,该随机函数显示随机数的随机记录。我现在拥有代码的方式,如下所示,即使有多条记录符合条件,页面上也不会显示任何内容。

在我的数据库中有500条记录,大约70条与标准匹配,但由于某种原因,它们似乎永远不属于 plist 变量,无法在查询中使用。

当我将最大数字更改为较低的数字(例如10)时,我收到一条错误消息,表明已找到EOF或没有更多记录可用。使用调试代码,我找不到任何与众不同的东西,只是从输入到plist的所有100条记录中,没有一条与主要条件中的记录匹配。

我在这里发布了整个代码。也许有人可以捕捉到可能导致无法正常工作的原因。

Sub GetRandomDomains
    dim conn, maxrecords, count, webname
    dim randomrs, sql

    'If (conn.State = adStateClosed) Then
    OpenDB conn
    'End If

    count=0
    maxrecords=100

    KeywordColumnGetRandomKeywords conn, maxrecords, sql

    If sql="" then
        conn.close
        set conn=nothing
        Response.Write(" NOT AVAILABLE")
    exit sub
    end if

    set randomrs=conn.execute(sql)

    Response.Write("<ul id='catnav'>")
    do While Not randomrs.EOF and count<maxrecords

        If isnull(randomrs("sitename")) Then
            webname=randomrs("domain")
        Else
            webname=randomrs("sitename")
        End if
        Response.Write "<li><a href=""http://www."& randomrs("domain") &"""> &nbsp;" & webname &"</a></li>"
        count=count+1
        randomrs.movenext
    loop
    Response.Write("</ul>")

    CloseSet randomrs
    CloseDB conn
end sub

Sub KeywordColumnGetRandomKeywords (conn,maxrecords,sql)
    dim i, id, index, plist, rs, sqlstr, sortstr
    plist=""
    Set rs=Server.CreateObject("ADODB.Recordset")
    sqlstr="SELECT domainid FROM domains"
    sqlstr=sqlstr

    Debugwrite sqlstr, "sqlstr for random domains"
    rs.Open sqlstr,conn,3,3
    If rs.eof then
        CloseSet rs
        Response.Write(" EMPTY")
        sql=""
        exit sub
    end if

    Debugwrite rs("domainid"), "rs for random domains"

    Dim arrData ' Array to Store Data
    Dim arrSequence ' Array to Hold Random Sequence
    Dim iArrayLooper ' Integer for Looping
    Dim iarraysize ' Size of Data Array

    If xdbasetype="Local" Then
        iarraysize=cint(rs.recordcount)
    else
        iarraysize=cint(GetRecordcount (conn))
    end if

    Debugwrite GetRecordcount(conn), "getrecordcount for random domains array"

    Debugwrite(IsArray(iarraysize)), "random domains count array"
    'if (cint(GetRecordcount(conn)))= 0 or isnull(cint(GetRecordcount(conn))) then
    'Exit Sub
    'End if
    redim arrdata(cint(iarraysize))
    for i = 0 to iarraysize-1
        arrData(i)=rs(0)
        rs.movenext
    next
    rs.close
    Set rs = Nothing
    If iarraysize<maxrecords then
        maxrecords=iarraysize
    end if
    ' Get an array of numbers 0 to array size randomly sequenced.
    arrSequence = Resequencearray(iArraySize)
    for i = 0 to maxrecords-1
        index=arrsequence(i)
        id=arrdata(index)
        if plist<>"" then
            plist=plist & ","
        end if
        plist=plist & id
    Next
    sql="select domainid, domain, sitename,sitematch,altmatch from domains"
    sql = sql & " WHERE restricted=0 and(sitematch like '%" & xsitematch & "%' or altmatch like '%" & xaltmatch & "%')"
    sql = sql & " and domainid In (" & plist & ") "
    Debugwrite sql, "first sql for random domains"
end sub

Function ResequenceArray(iArraySize)
    Dim arrTemp()
    Dim I
    Dim iLowerBound, iUpperBound
    Dim iRndNumber
    Dim iTemp
    ' Set array size
    ReDim arrTemp(iArraySize - 1)
    Randomize
    iLowerBound = LBound(arrTemp)
    iUpperBound = UBound(arrTemp)
    For I = iLowerBound To iUpperBound
        arrTemp(I) = I
    Next
    ' Loop through the array once, swapping each value
    ' with another in a random location within the array.
    For I = iLowerBound to iUpperBound
        iRndNumber = Int(Rnd * (iUpperBound - iLowerBound + 1))
        ' Swap Ith element with iRndNumberth element
        iTemp = arrTemp(I)
        arrTemp(I) = arrTemp(iRndNumber)
        arrTemp(iRndNumber) = iTemp
    Next 'I
    ' Return our array
    ResequenceArray = arrTemp
End Function

'***********************************************************************
' get record count for mysql
'************************************************************************
Function GetrecordCount(conn)
    dim sqlstr, rs, rcount
    sqlstr="select count(domainid) FROM domains WHERE restricted=0 and (domaingroup='" & xdomaingroup & "' or altmatch like '%" & xaltmatch & "%')"

    Debugwrite sqlstr, "sqlstr for random domains"

    set rs=conn.execute(sqlstr)
    if rs.eof then
        rcount=0
    else
        rcount=rs(0)
    end if
    CloseSet rs

    Getrecordcount=cint(rcount)

    Debugwrite rcount, "getrecordcount for random domains"
End function

1 个答案:

答案 0 :(得分:0)

好。可能有一种更简单的方法来解决这个问题。这是一段将数据作为数组获取的代码 - 更简单,我们可以更好地控制其中的内容...

'Constants relating to the following routines...
const C_NO_DATA = "NO_DATA" 'Used when no data is returned to a consuming routine
const C_ERROR   = "ERROR"   'Used when an error is generated

'GetDataSet
'    Returns a table of data based on the supplied SQL statement and connection string.
'Parameters:
'    sqlString (string) - The SQL string to be sent.
'    connString (string) - The database connection string.
'Usage:
'    dataSet = GetDataSet(sqlString, connString)
'Description:
'    This function generates a table of information in a 2 dimensional array.  The first dimension represents the columns
'    and the second the rows.  If an error occurs while the routine is executing the array and the base index (0,0) is set 
'    to C_ERROR, (0,1) to the VBScript error index, and (0,2) to the VBScript error description.
function GetDataSet(sqlString, connString)
    'Initialise...
    dim returnVal, rsData
    on error resume next
        'Define and open the recordset object...
        set rsData = Server.CreateObject("ADODB.RecordSet")
        rsData.Open sqlString, connString, 0, 1, 1
        'Initialise an empty value for the containing array...
        redim returnVal(0,0)
        returnVal(0,0) = C_NO_DATA
        'Deal with any errors...
        if not rsData.EOF and not rsData.BOF then
            'Store the data...
            returnVal = rsData.GetRows()
            'Tidy up...
            rsData.close
            set rsData = nothing
            select case err.number
                case 3021    'No data returned
                    'Do nothing as the initial value will still exist (C_NO_DATA)
                case 0        'No error
                    'Do nothing as data has been returned
                case else
                    redim returnVal(4,0)
                    returnVal(0,0) = C_ERROR
                    returnVal(1,0) = err.number
                    returnVal(2,0) = err.description
                    returnVal(3,0) = sqlString
                    returnVal(4,0) = connString
            end select
        end if
    on error goto 0
    'Return the array...
    GetDataSet = returnVal
end function

好的,所以我们将数据读入数组。请注意,我不知道您的xaltmatchxsitematch变量来自何处,因此您需要在某些时候提供这些变量...

Dim ds, sql
sql = _
    "SELECT " & _
    "domainid, " & _
    "domain, " & _
    "sitename, " & _
    "sitematch, " & _
    "altmatch " & _
"FROM " & _
    "domains " & _
"WHERE " & _
    "restricted=0 AND " & _
    "(sitematch LIKE '%" & xsitematch & "%' OR " & _
    "altmatch LIKE'%" & xaltmatch & "%') AND " & _
    "domainid IN (" & plist & ") "

ds = GetDataSet(sql, conn)

ds变量现在包含从数据库中提取的元素数组。我们现在需要做的就是循环所需的次数......

dim row, rows, used, randoms, col, cols, rc, cc
rows = UBound(ds, 2) 'Get the upper bound of the second array dimension
cols = UBound(ds, 1) 'Get the number of columns for writing to the page
randoms = 70 'Total number of randoms we need
used = ","

for rc = 1 to randoms
    'Just in case we don't want to repeat the same row...
    do
        row = int(rnd(1)*rows) 'Zero based - we don't need to add 1
    until instr(used, "," & row & ",")) = 0
    'Add our random row to the list...
    used = used & row & ","

    'Write our output to the page...
    response.write("<table>")
    for cc = 0 to cols
        response.write("<tr>")
        response.write("<td>")
        response.write(ds(cc, row))
        response.write("</td>")
        response.write("</tr>")
    next 'cc
    response.write("</table>")

next 'rc

GetDataSet代码是我库存函数的一部分,所以我知道它有效,但我会举起手来说我还没有测试其余部分。

与这个人一起玩,路易斯,让我知道你是怎么过的。