在经典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