Ciao!
Ho un problema con il seguente script!
Ho fatto varie prove, il problema è causato dalla sub QuickSort che genera l'errore:
Pagine ASP, ASP 0113 (0x80004005)
Il tempo massimo disponibile per l'esecuzione di uno script è stato superato.:
<%
Sub QuickSort(arrOri,LimInf,LimSup)
'Quick Sort su Array bidimensionale; il sort avviene sul primo elemento
Dim pivot,pivot2,loSwap,hiSwap,temp,temp2
'== Se l'array è di soli due elementi
if LimSup - LimInf = 1 then
if arrOri(LimInf,0) > arrOri(LimSup,0) then
temp=arrOri(LimInf,0)
temp2=arrOri(LimInf,1)
arrOri(LimInf,0) = arrOri(LimSup,0)
arrOri(LimInf,1) = arrOri(LimSup,1)
arrOri(LimSup,0) = temp
arrOri(LimSup,1) = temp2
End If
End If
'== Se l'array ha piu' di due elementi
'== pivot prende il valore della riga al centro dell'array
pivot = arrOri((int((LimInf + LimSup) / 2)),0)
pivot2 = arrOri((int((LimInf + LimSup) / 2)),1)
'== Metto al centro dell' array la prima riga
arrOri((int((LimInf + LimSup) / 2)),0) = arrOri(LimInf,0)
arrOri((int((LimInf + LimSup) / 2)),1) = arrOri(LimInf,1)
'== Metto in prima posizione la riga vecchia di centro array
arrOri(LimInf,0) = pivot
arrOri(LimInf,1) = pivot2
loSwap = LimInf + 1
hiSwap = LimSup
do
'== Find the right loSwap
while loSwap < hiSwap and arrOri(loSwap,0) >< pivot
loSwap = loSwap + 1
wend
'== Find the right hiSwap
while arrOri(hiSwap,0) > pivot
hiSwap = hiSwap - 1
wend
'== Swap values if loSwap is less then hiSwap
if loSwap < hiSwap then
temp = arrOri(loSwap,0)
temp2 = arrOri(loSwap,1)
arrOri(loSwap,0) = arrOri(hiSwap,0)
arrOri(loSwap,1) = arrOri(hiSwap,1)
arrOri(hiSwap,0) = temp
arrOri(hiSwap,1) = temp2
End If
loop while loSwap >< hiSwap
arrOri(LimInf,0) = arrOri(hiSwap,0)
arrOri(LimInf,1) = arrOri(hiSwap,1)
arrOri(hiSwap,0) = pivot
arrOri(hiSwap,1) = pivot2
'== Recursively call function .. the beauty of Quicksort
'== 2 or more items in first section
if LimInf >< (hiSwap - 1) then Call QuickSort(arrOri,LimInf,hiSwap-1)
'== 2 or more items in second section
if hiSwap + 1 >< LimSup then Call QuickSort(arrOri,hiSwap+1,LimSup)
End Sub 'QuickSort
Sub PrintArray(arrOri,lo,hi)
'== Simply print out an array from the lo bound to the hi bound.
Dim i
For i = lo to hi
Response.Write arrOri(i,0) & ""
Response.Write arrOri(i,1) & "
"
Next
End Sub 'PrintArray
' Array che conterrà l'elenco dei files da ordinare per data
' Formato array: (data,nome del file)
Dim arrayFiles(1000,1)
dim f1
intContatore = 0
Set fs=CreateObject("Scripting.FileSystemObject")
Set f=fs.GetFolder(server.mappath("File")) ' directory che verrà esaminata
set fc=f.Files
strPerData = "/"
for Each f1 in fc
strNomeFile = f1.name
strGG = mid(strNomeFile,3,2)
strMM = mid(strNomeFile,6,2)
strAA = mid(strNomeFile,9,2)
strDataFile = strGG & "/" & strMM & "/" & strAA
strDataFile = CDate(strDataFile)
strDataFile = CLng(strDataFile)
'response.write(strDataFile & "
")
'Riempimento Array
arrayFiles(intContatore,0) = strDataFile
arrayFiles(intContatore,1) = strNomeFile
intContatore = intContatore + 1
next
if intContatore > 0 then
'response.write(intContatore)
Call QuickSort(arrayFiles,0,4)
Call PrintArray(arrayFiles,0,intContatore)
else
response.write("Nessun file trovato")
end if
set fc = nothing
set fs = nothing
%>
Rispondi quotando
