在經典ASP中將SQL導出到Excel的更快方式？

Question

在大約2380行後，在運行此代碼的ASP頁上超過13000行的SQL Server Studio中需要1秒鐘的視圖超時。

有沒有更好的方式來做到這一點？我一直在尋找6個月沒有運氣。

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

我懷疑你的問題在於這樣一個事實：VBScript是可怕與字符串連接 - 這似乎是在做很多的。

儘管.NET StringBuilder類對VBScript不可用，但還是有一些有用的庫/代碼示例可用。一個例子是：http://www.eggheadcafe.com/articles/20011227.asp

它可能需要一些代碼的返工，但我敢打賭，性能將大大提高。

下面是使用上面鏈接代碼的示例。請注意，您可能希望將FastString類放在包含文件中，以便您可以在其他地方重複使用它。從上面的鏈接

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

代碼：

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 

替代的解決方案：

如果你不介意沒有風格的細胞，你可以利用的了 「GetRows的」 功能ADO記錄集。這一點使用的解決方案是在這種情況下非常有用：

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

這樣，那麼，你的輸出變爲：

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

我懷疑字符串構建它是什麼使得它如此之慢。 VBScript在這方面很糟糕。

我用了一個名爲clsString類來完成這樣的工作。

我覺得這是它：http://pcdispatchwiki.com/Intranet/includes/funcsSubsClasses.asp

從內存：

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