在Classic ASP中将SQL导出到Excel的更快捷方式？

Question

A view that takes 1 second in SQL Server Studio for over 13000 rows times out on an ASP page running this code after around 2380 rows.

Is there a better way to do this? I've been searching for 6 months with no luck.

Server.ScriptTimeout=200
    dim updateNBK
    updateNBK = UCase(request.QueryString("SelTABLE"))

    dim allstring
    allstring = UCase(Request.QueryString("SelTABLE")) & " " & UCase(Request.QueryString("SelNBK"))


    allstring = LCase(allstring)
    dim checkforinject
    If(InStr(allstring, "'")<>0)then
        checkforinject = true
    Elseif(InStr(allstring, "--")<>0)then
        checkforinject = true
    End If

    If (checkforinject = true) then
        Response.Write("<b>Injection Detected</b><br/> You may not enter the following characters: ' or --")
    Elseif (checkforinject = false) then

    dim strSQL


        if(Request.QueryString("submitbutton") = "Download") then

        strSQL = "select COLUMN_NAME from INFORMATION_SCHEMA.COLUMNS  where TABLE_NAME = '" & UCase(request.QueryString("SelTABLE")) & "'"


        On Error Resume Next
        set arn = cnt.execute(strSQL)   

        dim datastr
        dim datahead
        datahead = "<table class='bluetable'><thead><tr><td colspan='30'>" & UCase(request.QueryString("SelTABLE")) & " contents</td></tr></thead>"
        dim columns
        colums = 0
        datastr = datastr & "<tbody class='datasheet'><tr class='selectblue'>"
        if not arn.EOF then
                    arn.movefirst

                    do
                        On Error Resume Next
                        datastr = datastr & "<td>" & arn(0) & "</td>"
                        columns = columns + 1
                        arn.movenext
                    loop until arn.EOF
                end if
        datastr = datastr & "</tr>"

        strSQL = "Select * from " & UCase(request.QueryString("SelTABLE"))

        if(UCase(Request.QueryString("SelNBK")) <> "") then

        strSQL = strSQL & " where SubmitterNBK = '" & UCase(Request.QueryString("SelNBK")) & "'"

        end if

        set arn = cnt.execute("Select TimestampColumnName from FormsInfo where FormOutput='" & UCase(request.QueryString("SelTABLE")) & "'")

        strSQL = strSQL & " ORDER BY " & arn(0) & " desc;"

        Response.Write "Test1"

        On Error Resume Next
        set arn = cnt.execute(strSQL)   
        dim counter
        counter = 0
        if not arn.EOF then
                    arn.movefirst
                    Response.Write "Test2"
                    dim cellnum
                    do
                    datastr = datastr & "<tr>"
                        On Error Resume Next
                        cellnum = 0
                        'datastr = datastr & "<td>" & arn.value.toString() & "</td>"
                        do
                        datastr = datastr & "<td>" & arn(cellnum) & "</td>"
                        cellnum = cellnum + 1
                        loop while cellnum < columns
                        arn.movenext
                        'Response.Write "TestLoop"
                        Response.Write "<br/>Loop ran " & counter & " times." 
                        counter = counter + 1
                    datastr = datastr & "</tr>"
                    loop until arn.EOF
                    Response.Write "<br/>Loop ended." 
        end if


        datahead = "<table class='bluetable'>"

        Response.Clear  

        Response.ContentType = "application/vnd.ms-excel" ' arbitrary 

        Response.AddHeader "Content-Disposition","attachment; filename=" & UCase(request.QueryString("SelTABLE")) & ".xls"

        Set adoStream = CreateObject("ADODB.Connection") 
        adoStream.Open() 
        adoStream.Type = 2

        Response.Write datahead & datastr 
        Response.Flush

        adoStream.Close 
        Set adoStream = Nothing 
        Response.End

Answer 1

I suspect your problem lies in the fact that VBScript is horrible with string concatenation - which it appears you are doing a lot of.

Although the .NET StringBuilder class is unavailable to VBScript, there are a couple of useful libraries/code samples available. One example is here: http://www.eggheadcafe.com/articles/20011227.asp

It may take a little rework of your code, but I bet the performance will drastically improve.

Here is an example using the code from the link above. Note that you will probably want to place the FastString class in an include file so you can reuse it elsewhere.

Dim test : Set test = new FastString
Dim I
For I = 0 To 1000
  test.Append("TESTING")
Next
Response.Write test.Concat

Code from the link above:

Class FastString
  Dim stringArray, growthRate, numItems
  Private Sub Class_Initialize()
    growthRate = 50: numItems = 0
    ReDim stringArray(growthRate)
  End Sub
  Public Sub Append(ByVal strValue)
    ' next line prevents type mismatch error if strValue is null. Performance hit is negligible.
    strValue=strValue & ""
    If numItems > UBound(stringArray) Then ReDim Preserve stringArray(UBound(stringArray) + growthRate)
    stringArray(numItems) = strValue: numItems = numItems + 1
  End Sub
  Public Sub Reset
    Erase stringArray
    Class_Initialize
  End Sub
  Public Function Concat()
    Redim Preserve stringArray(numItems)
    concat = Join(stringArray, "")
  End Function
End Class

Alternate solution:

If you don't mind not having styled cells, you can leverage the "GetRows" functionality of the ADO recordset. This little used solution is quite useful in this situation:

Dim tableRows : tableRows = arn.GetString(,,"</td><td>","</td></tr><tr><td>","&nbsp;")
Response.Write "<table class='bluetable'>" & tableRows & "</table>"

So, then, your output becomes:

Set arn = cnt.Execute(strSQL)   
Response.Clear  
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader "Content-Disposition","attachment; filename=" & UCase(request.QueryString("SelTABLE")) & ".xls"
Dim tableRows : tableRows = arn.GetString(,,"</td><td>","</td></tr><tr><td>","&nbsp;")
Response.Write "<table class='bluetable'>" & tableRows & "</table>"

Answer 2

I suspect the string building it what is making it so slow. VBScript is terrible at this.

I used to use a class called clsString to do this kind of work.

I think this is it: http://pcdispatchwiki.com/Intranet/includes/funcsSubsClasses.asp

From memory:

dim tmpStr : set tmpStr = new clsString
tmpStr.add "Hello"
tmpStr.add vbCRLF
tmpStr.add "World"
dim finalText : finalText = tmpStr.Value