как отсортировать массивы с помощью vbscript?

<p>вопрос говорит все это действительно, но ...</p><p>я сканирую файл, ища строки, которые соответствуют определенному шаблону регулярных выражений, и затем я хочу распечатать строки, которые соответствуют, но в алфавитном порядке. я уверен, что это тривиально, но vbscript не мой фон</p><p>мой массив определяется как</p><pre><code>dim lines(10000) </code></pre><p>если это имеет какое-то значение, и я пытаюсь выполнить свой скрипт из обычного командной строки cmd</p><p>спасибо</p>

<p>от <a href="http://www.microsoft.com/technet/scriptcenter/funzone/games/tips08/gtip1130.mspx#e4c">microsoft</a> </p><p>сортировка массивов в vbscript никогда не была легкой; это потому, что vbscript не имеет команды сортировки любого вида. в свою очередь, это всегда означало, что сценаристы vbscript были вынуждены писать свои собственные процедуры сортировки, будь то пузырьковая сортировка, кучная сортировка, быстрая сортировка или какой-либо другой тип алгоритма сортировки.</p><p>итак (используя .net, как он установлен на моем компьютере):</p><pre><code>set outputlines = createobject("system.collections.arraylist") 'add lines outputlines.add output outputlines.add output outputlines.sort() for each outputline in outputlines stdout.writeline outputline next </code></pre>

<p>я знаю, что это довольно старая тема, но она может пригодиться любому в будущем. скрипт ниже делает то, что парень пытался достичь, просто используя vbscript. когда отсортированные термины, начинающиеся с заглавных букв, будут иметь приоритет.</p><pre><code>for a = ubound(arrayofterms) - 1 to 0 step -1 for j= 0 to a if arrayofterms(j)>arrayofterms(j+1) then temp=arrayofterms(j+1) arrayofterms(j+1)=arrayofterms(j) arrayofterms(j)=temp end if next next </code></pre>

<p>отключенные наборы записей могут быть полезны.</p><pre><code>const advarchar = 200 'the sql datatype is varchar 'create a disconnected recordset set rs = createobject("adodb.recordset") rs.fields.append "sortfield", advarchar, 25 rs.cursortype = adopenstatic rs.open rs.addnew "sortfield", "some data" rs.update rs.addnew "sortfield", "all data" rs.update rs.sort = "sortfield" rs.movefirst do until rs.eof strlist=strlist & vbcrlf & rs.fields("sortfield") rs.movenext loop msgbox strlist </code></pre>

<p>вот quicksort, который я написал для массивов, возвращаемых из метода getrows adodb.recordset.</p><pre><code>'author: eric weilnau 'date written: 7/16/2003 'description: quicksortdataarray sorts a data array using the quicksort algorithm. ' its arguments are the data array to be sorted, the low and high ' bound of the data array, the integer index of the column by which the ' data array should be sorted, and the string "asc" or "desc" for the ' sort order. ' sub quicksortdataarray(dataarray, lobound, hibound, sortfield, sortorder) dim pivot(), loswap, hiswap, count redim pivot(ubound(dataarray)) if hibound - lobound = 1 then if (sortorder = "asc" and dataarray(sortfield,lobound) > dataarray(sortfield,hibound)) or (sortorder = "desc" and dataarray(sortfield,lobound) < dataarray(sortfield,hibound)) then call swapdatarows(dataarray, hibound, lobound) end if end if for count = 0 to ubound(dataarray) pivot(count) = dataarray(count,int((lobound + hibound) / 2)) dataarray(count,int((lobound + hibound) / 2)) = dataarray(count,lobound) dataarray(count,lobound) = pivot(count) next loswap = lobound + 1 hiswap = hibound do do while (sortorder = "asc" and dataarray(sortfield,loswap) <= pivot(sortfield)) or sortorder = "desc" and (dataarray(sortfield,loswap) >= pivot(sortfield)) loswap = loswap + 1 if loswap > hiswap then exit do end if loop do while (sortorder = "asc" and dataarray(sortfield,hiswap) > pivot(sortfield)) or (sortorder = "desc" and dataarray(sortfield,hiswap) < pivot(sortfield)) hiswap = hiswap - 1 loop if loswap < hiswap then call swapdatarows(dataarray,loswap,hiswap) end if loop while loswap < hiswap for count = 0 to ubound(dataarray) dataarray(count,lobound) = dataarray(count,hiswap) dataarray(count,hiswap) = pivot(count) next if lobound < (hiswap - 1) then call quicksortdataarray(dataarray, lobound, hiswap-1, sortfield, sortorder) end if if (hiswap + 1) < hibound then call quicksortdataarray(dataarray, hiswap+1, hibound, sortfield, sortorder) end if end sub </code></pre>

<p>если вы все равно собираетесь выводить строки, вы можете запустить вывод с помощью команды сортировки. не элегантно, но не требует большой работы:</p><pre><code>cscript.exe //nologo your-script | sort </code></pre><p>примечание <strong>// nologo</strong> пропускает строки логотипа (<em>microsoft (r) windows script host version</em>... бла-бла-бла) в середине отсортированного вывода. (я думаю, ms не знает, для чего предназначен stderr.)</p><p>смотрите <a href="http://ss64.com/nt/sort.html">http://ss64.com/nt/sort.html</a> для подробностей о сортировке.</p><p><strong>/ + n</strong> - наиболее полезная опция, если ваш ключ сортировки не начинается в первом столбце.</p><p>сравнения всегда <strong>без учета регистра</strong>, что является хромой.</p>

<p>вот еще одна реализация быстрой сортировки в vbscript. это нестабильный подход, определенный в википедии (см. здесь: <a href="http://en.wikipedia.org/wiki/quicksort">http://en.wikipedia.org/wiki/quicksort</a> ). использует намного меньше памяти (оригинальная реализация требует, чтобы верхние и нижние временные массивы хранения создавались при каждой итерации, что может увеличить объем памяти на n членов в худшем случае).</p><p>в порядке возрастания поменяйте знаки. </p><p>если вы хотите отсортировать символы, используйте функцию asc (ch).</p><pre><code>'------------------------------------- ' quicksort ' carlos nunez, created: 25 april, 2010. ' ' note: partition function also ' required '------------------------------------- function qsort(list, first, last) dim i, j if (typename(list) <> "variant()" or ubound(list) = 0) then exit function 'list passed must be a collection or array. 'if the set size is less than 3, we can do a simple comparison sort. if (last-first) < 3 then for i = first to last for j = first to last if list(i) < list(j) then swap list,i,j end if next next else dim p\_idx 'we need to set the pivot relative to the position of the subset currently being sorted. 'if the starting position of the subset is the first element of the whole set, then the pivot is the median of the subset. 'otherwise, the median is offset by the first position of the subset. '------------------------------------------------------------------------------------------------------------------------- if first-1 < 0 then p\_idx = round((last-first)/2,0) else p\_idx = round(((first-1)+((last-first)/2)),0) end if dim p\_nidx: p\_nidx = partition(list, first, last, p\_idx) if p\_nidx = -1 then exit function qsort list, first, p\_nidx-1 qsort list, p\_nidx+1, last end if end function function partition(list, first, last, idx) dim i partition = -1 dim p\_val: p\_val = list(idx) swap list,idx,last dim swap\_pos: swap\_pos = first for i = first to last-1 if list(i) <= p\_val then swap list,i,swap\_pos swap\_pos = swap\_pos + 1 end if next swap list,swap\_pos,last partition = swap\_pos end function function swap(list,a\_pos,b\_pos) dim tmp tmp = list(a\_pos) list(a\_pos) = list(b\_pos) list(b\_pos) = tmp end function </code></pre>

<p>при наличии больших ("широких") массивов вместо перемещения каждого элемента длинного ряда данных используйте одномерный массив с индексами массива.</p><p>инициализировать ptr\_arr с помощью 0,1,2,3, .. ubound (arr) затем получить доступ к данным с помощью </p><pre><code>arr(field\_index,ptr\_arr(row\_index)) </code></pre><p>вместо</p><pre><code>arr(field\_index,row\_index) </code></pre><p>и просто поменяйте местами элементы ptr\_arr вместо замены строк.</p><p>если вы обрабатываете массив построчно, например, отображаете его как a, вы можете отключить внешний вид внутреннего цикла:</p><pre><code>max\_col=ubound(arr,1) response.write "<table>" for n = 0 to ubound(arr,2) response.write "<tr>" row=ptr\_arr(n) for i=0 to max\_col response.write "<td>"&arr(i,row)&"</td>" next response.write "</tr> next response.write "</table>" </code></pre>

<p>vbscript не имеет метода для сортировки массивов, поэтому у вас есть два варианта:</p><ul> <li>написание функции сортировки, такой как mergesort, с нуля.</li> <li>используйте подсказку jscript из <a href="http://www.aspfaqs.com/aspfaqs/showfaq.asp?faqid=83">этой статьи</a> </li> </ul>

<p>некоторая сортировка массивов старой школы. конечно, это сортирует только одномерные массивы.</p><p>«c:\dropbox\автоматизация\библиотека\array.vbs</p><pre><code>option explicit public function array\_advancedbubblesort(byref rarr\_arraytosort(), byval rstr\_sortorder) ' ================================================================================== ' date : 12/09/1999 ' author : christopher j. scharer (cjs) ' description : creates a sorted array from a one dimensional array ' in ascending (default) or descending order based on the rstr\_sortorder. ' variables : ' rarr\_arraytosort() the array to sort and return. ' rstr\_sortorder the order to sort in, default ascending or d for descending. ' ================================================================================== const const\_function\_name = "array\_advancedbubblesort" dim bln\_sorted dim lng\_loop\_01 dim str\_sortorder dim str\_temp bln\_sorted = false str\_sortorder = left(ucase(rstr\_sortorder), 1) 'we only need to know if the sort order is a(senc) or d(esend)...and for that matter we really only need to know if it's d because we are defaulting to ascending. do while (bln\_sorted = false) bln\_sorted = true str\_temp = "" if (str\_sortorder = "d") then 'sort in descending order. for lng\_loop\_01 = lbound(rarr\_arraytosort) to (ubound(rarr\_arraytosort) - 1) if (rarr\_arraytosort(lng\_loop\_01) < rarr\_arraytosort(lng\_loop\_01 + 1)) then bln\_sorted = false str\_temp = rarr\_arraytosort(lng\_loop\_01) rarr\_arraytosort(lng\_loop\_01) = rarr\_arraytosort(lng\_loop\_01 + 1) rarr\_arraytosort(lng\_loop\_01 + 1) = str\_temp end if if (rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) > rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01)) then bln\_sorted = false str\_temp = rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) = rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01) rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01) = str\_temp end if next else 'default to ascending. for lng\_loop\_01 = lbound(rarr\_arraytosort) to (ubound(rarr\_arraytosort) - 1) if (rarr\_arraytosort(lng\_loop\_01) > rarr\_arraytosort(lng\_loop\_01 + 1)) then bln\_sorted = false str\_temp = rarr\_arraytosort(lng\_loop\_01) rarr\_arraytosort(lng\_loop\_01) = rarr\_arraytosort(lng\_loop\_01 + 1) rarr\_arraytosort(lng\_loop\_01 + 1) = str\_temp end if if (rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) < rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01)) then bln\_sorted = false str\_temp = rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - (lng\_loop\_01 - 1)) = rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01) rarr\_arraytosort((ubound(rarr\_arraytosort) - 1) - lng\_loop\_01) = str\_temp end if next end if loop end function public function array\_bubblesort(byref rarr\_arraytosort()) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' ================================================================================== const const\_function\_name = "array\_bubblesort" dim lng\_loop\_01 dim lng\_loop\_02 dim var\_temp for lng\_loop\_01 = (ubound(rarr\_arraytosort) - 1) to 0 step -1 for lng\_loop\_02 = 0 to lng\_loop\_01 if rarr\_arraytosort(lng\_loop\_02) > rarr\_arraytosort(lng\_loop\_02 + 1) then var\_temp = rarr\_arraytosort(lng\_loop\_02 + 1) rarr\_arraytosort(lng\_loop\_02 + 1) = rarr\_arraytosort(lng\_loop\_02) rarr\_arraytosort(lng\_loop\_02) = var\_temp end if next next end function public function array\_getdimensions(byval rarr\_array) const const\_function\_name = "array\_getdimensions" dim int\_dimensions dim int\_result dim str\_dimensions int\_result = 0 if isarray(rarr\_array) then on error resume next do int\_dimensions = -2 int\_dimensions = ubound(rarr\_array, int\_result + 1) if int\_dimensions > -2 then int\_result = int\_result + 1 if int\_result = 1 then str\_dimensions = str\_dimensions & int\_dimensions else str\_dimensions = str\_dimensions & ":" & int\_dimensions end if end if loop until int\_dimensions = -2 on error goto 0 end if array\_getdimensions = int\_result ' & ";" & str\_dimensions end function public function array\_getuniquecombinations(byval rarr\_fields, byref robj\_combinations) const const\_function\_name = "array\_getuniquecombinations" dim int\_element dim str\_combination on error resume next array\_getuniquecombinations = cbool(false) for int\_element = lbound(rarr\_fields) to ubound(rarr\_fields) str\_combination = rarr\_fields(int\_element) call robj\_combinations.add(robj\_combinations.count & ":" & str\_combination, 0) ' call array\_getuniquecombinationssub(rarr\_fields, robj\_combinations, int\_element) next 'int\_element for int\_element = lbound(rarr\_fields) to ubound(rarr\_fields) call array\_getuniquecombinationssub(rarr\_fields, robj\_combinations, int\_element) next 'int\_element array\_getuniquecombinations = cbool(true) end function 'array\_getuniquecombinations public function array\_getuniquecombinationssub(byval rarr\_fields, byref robj\_combinations, byref rint\_lbound) const const\_function\_name = "array\_getuniquecombinationssub" dim int\_element dim str\_combination on error resume next array\_getuniquecombinationssub = cbool(false) str\_combination = rarr\_fields(rint\_lbound) for int\_element = (rint\_lbound + 1) to ubound(rarr\_fields) str\_combination = str\_combination & "," & rarr\_fields(int\_element) call robj\_combinations.add(robj\_combinations.count & ":" & str\_combination, str\_combination) next 'int\_element array\_getuniquecombinationssub = cbool(true) end function 'array\_getuniquecombinationssub public function array\_heapsort(byref rarr\_arraytosort()) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' ================================================================================== const const\_function\_name = "array\_heapsort" dim lng\_loop\_01 dim var\_temp dim arr\_size arr\_size = ubound(rarr\_arraytosort) + 1 for lng\_loop\_01 = ((arr\_size / 2) - 1) to 0 step -1 call array\_siftdown(rarr\_arraytosort, lng\_loop\_01, arr\_size) next for lng\_loop\_01 = (arr\_size - 1) to 1 step -1 var\_temp = rarr\_arraytosort(0) rarr\_arraytosort(0) = rarr\_arraytosort(lng\_loop\_01) rarr\_arraytosort(lng\_loop\_01) = var\_temp call array\_siftdown(rarr\_arraytosort, 0, (lng\_loop\_01 - 1)) next end function public function array\_insertionsort(byref rarr\_arraytosort()) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' ================================================================================== const const\_function\_name = "array\_insertionsort" dim lng\_elementcount dim lng\_loop\_01 dim lng\_loop\_02 dim lng\_index lng\_elementcount = ubound(rarr\_arraytosort) + 1 for lng\_loop\_01 = 1 to (lng\_elementcount - 1) lng\_index = rarr\_arraytosort(lng\_loop\_01) lng\_loop\_02 = lng\_loop\_01 do while lng\_loop\_02 > 0 if rarr\_arraytosort(lng\_loop\_02 - 1) > lng\_index then rarr\_arraytosort(lng\_loop\_02) = rarr\_arraytosort(lng\_loop\_02 - 1) lng\_loop\_02 = (lng\_loop\_02 - 1) end if loop rarr\_arraytosort(lng\_loop\_02) = lng\_index next end function private function array\_merge(byref rarr\_arraytosort(), byref rarr\_arraytemp(), byval rlng\_left, byval rlng\_middleindex, byval rlng\_right) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : merges an array. ' ================================================================================== const const\_function\_name = "array\_merge" dim lng\_loop\_01 dim lng\_leftend dim lng\_elementcount dim lng\_temppos lng\_leftend = (rlng\_middleindex - 1) lng\_temppos = rlng\_left lng\_elementcount = (rlng\_right - rlng\_left + 1) do while (rlng\_left <= lng\_leftend) \_ and (rlng\_middleindex <= rlng\_right) if rarr\_arraytosort(rlng\_left) <= rarr\_arraytosort(rlng\_middleindex) then rarr\_arraytemp(lng\_temppos) = rarr\_arraytosort(rlng\_left) lng\_temppos = (lng\_temppos + 1) rlng\_left = (rlng\_left + 1) else rarr\_arraytemp(lng\_temppos) = rarr\_arraytosort(rlng\_middleindex) lng\_temppos = (lng\_temppos + 1) rlng\_middleindex = (rlng\_middleindex + 1) end if loop do while rlng\_left <= lng\_leftend rarr\_arraytemp(lng\_temppos) = rarr\_arraytosort(rlng\_left) rlng\_left = (rlng\_left + 1) lng\_temppos = (lng\_temppos + 1) loop do while rlng\_middleindex <= rlng\_right rarr\_arraytemp(lng\_temppos) = rarr\_arraytosort(rlng\_middleindex) rlng\_middleindex = (rlng\_middleindex + 1) lng\_temppos = (lng\_temppos + 1) loop for lng\_loop\_01 = 0 to (lng\_elementcount - 1) rarr\_arraytosort(rlng\_right) = rarr\_arraytemp(rlng\_right) rlng\_right = (rlng\_right - 1) next end function public function array\_mergesort(byref rarr\_arraytosort(), byref rarr\_arraytemp(), byval rlng\_firstindex, byval rlng\_lastindex) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' note :the rarr\_arraytemp array that is passed in has to be dimensionalized to the same size ' as the rarr\_arraytosort array that is passed in prior to calling the function. ' also the rlng\_firstindex variable should be the value of the lbound(rarr\_arraytosort) ' and the rlng\_lastindex variable should be the value of the ubound(rarr\_arraytosort) ' ================================================================================== const const\_function\_name = "array\_mergesort" dim lng\_middleindex if rlng\_lastindex > rlng\_firstindex then ' recursively sort the two halves of the list. lng\_middleindex = ((rlng\_firstindex + rlng\_lastindex) / 2) call array\_mergesort(rarr\_arraytosort, rarr\_arraytemp, rlng\_firstindex, lng\_middleindex) call array\_mergesort(rarr\_arraytosort, rarr\_arraytemp, lng\_middleindex + 1, rlng\_lastindex) ' merge the results. call array\_merge(rarr\_arraytosort, rarr\_arraytemp, rlng\_firstindex, lng\_middleindex + 1, rlng\_lastindex) end if end function public function array\_push(byref rarr\_array, byval rstr\_value, byval rstr\_delimiter) const const\_function\_name = "array\_push" dim int\_loop dim str\_array\_01 dim str\_array\_02 'if there is no delimiter passed in then set the default delimiter equal to a comma. if rstr\_delimiter = "" then rstr\_delimiter = "," end if 'check to see if the rarr\_array is actually an array. if isarray(rarr\_array) = true then 'verify that the rarr\_array variable is only a one dimensional array. if array\_getdimensions(rarr\_array) <> 1 then array\_push = "err, the rarr\_array variable passed in was not a one dimensional array." exit function end if if isarray(rstr\_value) = true then 'verify that the rstr\_value variable is is only a one dimensional array. if array\_getdimensions(rstr\_value) <> 1 then array\_push = "err, the rstr\_value variable passed in was not a one dimensional array." exit function end if str\_array\_01 = split(rarr\_array, rstr\_delimiter) str\_array\_02 = split(rstr\_value, rstr\_delimiter) rarr\_array = join(str\_array\_01 & rstr\_delimiter & str\_array\_02) else on error resume next redim preserve rarr\_array(ubound(rarr\_array) + 1) if err.number <> 0 then ' "subscript out of range" an array that was passed in must have been erased to re-create it with new elements (possibly when passing an array to be populated into a recursive function) redim rarr\_array(0) err.clear end if if isobject(rstr\_value) = true then set rarr\_array(ubound(rarr\_array)) = rstr\_value else rarr\_array(ubound(rarr\_array)) = rstr\_value end if end if else 'check to see if the rstr\_value is an array. if isarray(rstr\_value) = true then 'verify that the rstr\_value variable is is only a one dimensional array. if array\_getdimensions(rstr\_value) <> 1 then array\_push = "err, the rstr\_value variable passed in was not a one dimensional array." exit function end if rarr\_array = rstr\_value else rarr\_array = split(rstr\_value, rstr\_delimiter) end if end if array\_push = ubound(rarr\_array) end function public function array\_quicksort(byref rarr\_arraytosort(), byval rlng\_low, byval rlng\_high) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' note :the rlng\_low variable should be the value of the lbound(rarr\_arraytosort) ' and the rlng\_high variable should be the value of the ubound(rarr\_arraytosort) ' ================================================================================== const const\_function\_name = "array\_quicksort" dim var\_pivot dim lng\_swap dim lng\_low dim lng\_high lng\_low = rlng\_low lng\_high = rlng\_high var\_pivot = rarr\_arraytosort((rlng\_low + rlng\_high) / 2) do while lng\_low <= lng\_high do while (rarr\_arraytosort(lng\_low) < var\_pivot \_ and lng\_low < rlng\_high) lng\_low = lng\_low + 1 loop do while (var\_pivot < rarr\_arraytosort(lng\_high) \_ and lng\_high > rlng\_low) lng\_high = (lng\_high - 1) loop if lng\_low <= lng\_high then lng\_swap = rarr\_arraytosort(lng\_low) rarr\_arraytosort(lng\_low) = rarr\_arraytosort(lng\_high) rarr\_arraytosort(lng\_high) = lng\_swap lng\_low = (lng\_low + 1) lng\_high = (lng\_high - 1) end if loop if rlng\_low < lng\_high then call array\_quicksort(rarr\_arraytosort, rlng\_low, lng\_high) end if if lng\_low < rlng\_high then call array\_quicksort(rarr\_arraytosort, lng\_low, rlng\_high) end if end function public function array\_selectionsort(byref rarr\_arraytosort()) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' ================================================================================== const const\_function\_name = "array\_selectionsort" dim lng\_elementcount dim lng\_loop\_01 dim lng\_loop\_02 dim lng\_min dim var\_temp lng\_elementcount = ubound(rarr\_arraytosort) + 1 for lng\_loop\_01 = 0 to (lng\_elementcount - 2) lng\_min = lng\_loop\_01 for lng\_loop\_02 = (lng\_loop\_01 + 1) to lng\_elementcount - 1 if rarr\_arraytosort(lng\_loop\_02) < rarr\_arraytosort(lng\_min) then lng\_min = lng\_loop\_02 end if next var\_temp = rarr\_arraytosort(lng\_loop\_01) rarr\_arraytosort(lng\_loop\_01) = rarr\_arraytosort(lng\_min) rarr\_arraytosort(lng\_min) = var\_temp next end function public function array\_shellsort(byref rarr\_arraytosort()) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sorts an array. ' ================================================================================== const const\_function\_name = "array\_shellsort" dim lng\_loop\_01 dim var\_temp dim lng\_hold dim lng\_hvalue lng\_hvalue = lbound(rarr\_arraytosort) do lng\_hvalue = (3 * lng\_hvalue + 1) loop until lng\_hvalue > ubound(rarr\_arraytosort) do lng\_hvalue = (lng\_hvalue / 3) for lng\_loop\_01 = (lng\_hvalue + lbound(rarr\_arraytosort)) to ubound(rarr\_arraytosort) var\_temp = rarr\_arraytosort(lng\_loop\_01) lng\_hold = lng\_loop\_01 do while rarr\_arraytosort(lng\_hold - lng\_hvalue) > var\_temp rarr\_arraytosort(lng\_hold) = rarr\_arraytosort(lng\_hold - lng\_hvalue) lng\_hold = (lng\_hold - lng\_hvalue) if lng\_hold < lng\_hvalue then exit do end if loop rarr\_arraytosort(lng\_hold) = var\_temp next loop until lng\_hvalue = lbound(rarr\_arraytosort) end function private function array\_siftdown(byref rarr\_arraytosort(), byval rlng\_root, byval rlng\_bottom) ' ================================================================================== ' date : 03/18/2008 ' author : christopher j. scharer (cjs) ' description : sifts the elements down in an array. ' ================================================================================== const const\_function\_name = "array\_siftdown" dim bln\_done dim max\_child dim var\_temp bln\_done = false do while ((rlng\_root * 2) <= rlng\_bottom) \_ and bln\_done = false if rlng\_root * 2 = rlng\_bottom then max\_child = (rlng\_root * 2) elseif rarr\_arraytosort(rlng\_root * 2) > rarr\_arraytosort(rlng\_root * 2 + 1) then max\_child = (rlng\_root * 2) else max\_child = (rlng\_root * 2 + 1) end if if rarr\_arraytosort(rlng\_root) < rarr\_arraytosort(max\_child) then var\_temp = rarr\_arraytosort(rlng\_root) rarr\_arraytosort(rlng\_root) = rarr\_arraytosort(max\_child) rarr\_arraytosort(max\_child) = var\_temp rlng\_root = max\_child else bln\_done = true end if loop end function </code></pre>

<p>это реализация vbscript сортировки слиянием. </p><pre><code>'@function name: sort '@author: lewis gordon '@creation date: 4/26/12 '@description: sorts a given array either in ascending or descending order, as specified by the ' order parameter. this array is then returned at the end of the function. '@prerequisites: an array must be allocated and have all its values inputted. '@parameters: ' $arraytosort: this is the array that is being sorted. ' $order: this is the sorting order that the array will be sorted in. this parameter ' can either be "asc" or "desc" or ascending and descending, respectively. '@notes: this uses merge sort under the hood. also, this function has only been tested for ' integers and strings in the array. however, this should work for any data type that ' implements the greater than and less than comparators. this function also requires ' that the merge function is also present, as it is needed to complete the sort. '@examples: ' dim i ' dim testarray(50) ' randomize ' for i=0 to ubound(testarray) ' testarray(i) = int((100 - 0 + 1) * rnd + 0) ' next ' msgbox join(sort(testarray, "desc")) ' '@return value: this function returns a sorted array in the specified order. '@change history: none 'the merge function. public function merge(leftarray, rightarray, order) 'declared variables dim finalarray dim finalarraysize dim i dim larrayposition dim rarrayposition 'variable initialization larrayposition = 0 rarrayposition = 0 'calculate the expected size of the array based on the two smaller arrays. finalarraysize = ubound(leftarray) + ubound(rightarray) + 1 redim finalarray(finalarraysize) 'this should go until we need to exit the function. while true 'if we are done with all the values in the left array. add the rest of the right array 'to the final array. if larrayposition >= ubound(leftarray)+1 then for i=rarrayposition to ubound(rightarray) finalarray(larrayposition+i) = rightarray(i) next merge = finalarray exit function 'if we are done with all the values in the right array. add the rest of the left array 'to the final array. elseif rarrayposition >= ubound(rightarray)+1 then for i=larrayposition to ubound(leftarray) finalarray(i+rarrayposition) = leftarray(i) next merge = finalarray exit function 'for descending, if the current value of the left array is greater than the right array 'then add it to the final array. the position of the left array will then be incremented 'by one. elseif leftarray(larrayposition) > rightarray(rarrayposition) and ucase(order) = "desc" then finalarray(larrayposition+rarrayposition) = leftarray(larrayposition) larrayposition = larrayposition + 1 'for ascending, if the current value of the left array is less than the right array 'then add it to the final array. the position of the left array will then be incremented 'by one. elseif leftarray(larrayposition) < rightarray(rarrayposition) and ucase(order) = "asc" then finalarray(larrayposition+rarrayposition) = leftarray(larrayposition) larrayposition = larrayposition + 1 'for anything else that wasn't covered, add the current value of the right array to the 'final array. else finalarray(larrayposition+rarrayposition) = rightarray(rarrayposition) rarrayposition = rarrayposition + 1 end if wend end function 'the main sort function. public function sort(arraytosort, order) 'variable declaration. dim i dim leftarray dim modifier dim rightarray 'check to make sure the order parameter is okay. if not ucase(order)="asc" and not ucase(order)="desc" then exit function end if 'if the array is a singleton or 0 then it is sorted. if ubound(arraytosort) <= 0 then sort = arraytosort exit function end if 'setting up the modifier to help us split the array effectively since the round 'functions aren't helpful in vbscript. if ubound(arraytosort) mod 2 = 0 then modifier = 1 else modifier = 0 end if 'setup the arrays to about half the size of the main array. redim leftarray(fix(ubound(arraytosort)/2)) redim rightarray(fix(ubound(arraytosort)/2)-modifier) 'add the first half of the values to one array. for i=0 to ubound(leftarray) leftarray(i) = arraytosort(i) next 'add the other half of the values to the other array. for i=0 to ubound(rightarray) rightarray(i) = arraytosort(i+fix(ubound(arraytosort)/2)+1) next 'merge the sorted arrays. sort = merge(sort(leftarray, order), sort(rightarray, order), order) end function </code></pre>