1

Тема: HTA + VBS: Остановить выполнение этого сценария

Приветствую всех кто будет читать мою тему. Написал на HTA+VBS небольшое приложение, благодаря которому можно производить поиск внутри файлов или по содержимому для пользователей которые плохо дружат с Far:
1) Производит поиск по 2м основным маскам.
2) Распределение производит по месяцам.
3) Выводит первые 2 строчки там формируется название типов файлов
4) Считывает содержимое файлов в массив
5) окошки для поиска по 2м критериям.

Основа готова, остались мелкие ньюансы.

1я проблема:
В директории бывает около 10 000 файлов при загрузке программа считывает все в память, и в момент когда производится считывание, если попробовать перетащить окно программы статус пишется (Не отвечает) хотя скрипт в этот момент выполняется исправно. Как можно это исправить?

2я проблема:
После того как скрипт полностью все считал в память появляется меню выбора маски файлов обработчик выпадающего списка:

Sub MenuTypeFile1MaskOnClick()

и в момент выбора любой маски появляется ошибка: "Остановить выполнение этого сценария?..."

, если здесь мы нажимаем "Нет", то все загружается без проблем, но табличка постоянно появляется. Возможно ли может как-то изменить алгоритм что б данная табличка не появлялась, без манипуляций на пользовательской станции?

Описание процедуры:


Sub MenuTypeFile1MaskOnClick()

    Dim w
    
    dim m
    
    Erase FileMassivMaskPath
    reDim preserve FileMassivMaskPath(-1)
    
    Erase FileMassivMaskName
    reDim preserve FileMassivMaskName(-1)
    
    Erase FileMassivMaskDate
    reDim preserve FileMassivMaskDate(-1)
    
    Erase FileMassivMaskContent
    reDim preserve FileMassivMaskContent(-1)
    
    Erase FileMassivMaskType
    reDim preserve FileMassivMaskType(-1)

    Dim n
    Dim PovtorDate
    n = -1
    Dim c
    Dim mtext
    For i = 0 To MenuTypeFile1Mask.length-1
        If MenuTypeFile1Mask(i).selected Then
            if MenuTypeFile1Mask(i).Value <> "" Then
            
            
                Dim objChildNode
                If MenuTypeFile1Date.hasChildNodes() Then
                    For Each objChildNode In MenuTypeFile1Date.ChildNodes
                        MenuTypeFile1Date.removeChild objChildNode
                    Next
                End If
            
                'остановился
                
                
                For w = 0 To Ubound(FileMassivPath) Step 1
                    
                    
                    objRegExp.Pattern = LCase(MenuTypeFile1Mask(i).Value)
                    'msgBox MenuTypeFile1Mask(i).Value
                    If objRegExp.Test(LCase(FileMassivName(w))) = "Истина" Then
                         'MsgBox "Сработало"
                        n = n + 1
                        reDim preserve FileMassivMaskPath(n)
                        reDim preserve FileMassivMaskName(n)
                        reDim preserve FileMassivMaskDate(n)
                        reDim preserve FileMassivMaskContent(n)
                        reDim preserve FileMassivMaskType(n)
                        
                        FileMassivMaskPath(n) = FileMassivPath(w)
                        FileMassivMaskName(n) = FileMassivName(w)
                        FileMassivMaskDate(n) = FileMassivDate(w)
                        FileMassivMaskContent(n) = FileMassiveContent(w)
                        FileMassivMaskType(n) = FileMassiveType(w)
                        
                        if n = 0 then
                            Dim objHTMLOptionElement0
                            Set objHTMLOptionElement0 = window.document.createElement("OPTION")
                            objHTMLOptionElement0.Text  = "Выберите месяц" &VBCRLF
                            objHTMLOptionElement0.Value = ""
                            MenuTypeFile1Date.Add objHTMLOptionElement0
                        End If 
                        
                        'месяц
                        m = DatePart("m", FileMassivMaskDate(n))
                        
                        PovtorDate = 0
                        
                        'Исключение повторов в выводимом списке
                        if n <> 0 then
                            For c = 0 to Ubound(FileMassivMaskDate) - 1 Step 1
                            
                                If DatePart("m", FileMassivMaskDate(c)) = m Then
                                    PovtorDate = 1
                                End If
                            
                            Next
                        End If
                        
                        If PovtorDate = 0 Then
                        
                            if m = 01 then
                                mtext = "Январь"
                            End If
                            
                            if m = 02 then
                                mtext = "Февраль"
                            End If
                            
                            if m = 03 then
                                mtext = "Март"
                            End If
                            
                            if m = 04 then
                                mtext = "Апрель"
                            End If
                            
                            if m = 05 then
                                mtext = "Май"
                            End If
                            
                            if m = 06 then
                                mtext = "Июнь"
                            End If
                            
                            if m = 07 then
                                mtext = "Июль"
                            End If
                            
                            if m = 08 then
                                mtext = "Август"
                            End If
                            
                            if m = 09 then
                                mtext = "Сентябрь"
                                
                                
                            End If
                            
                            if m = 10 then
                                mtext = "Октябрь"
                            End If
                            
                            if m = 11 then
                                mtext = "Ноябрь"
                            End If
                            
                            if m = 12 then
                                mtext = "Декабрь"
                            End If
                            
                            'MsgBox mtext
                            
                            Dim objHTMLOptionElement1
                            Set objHTMLOptionElement1 = window.document.createElement("OPTION")
                            objHTMLOptionElement1.Text  = mtext &VBCRLF
                            objHTMLOptionElement1.Value = m 
                            MenuTypeFile1Date.Add objHTMLOptionElement1
                            
                            
                        End If
                        
                    End If
                
                Next
            
            End If
        End If
    Next
    
End Sub

Post's attachments

Pos.hta 31.03 kb, 2 downloads since 2014-10-11 

You don't have the permssions to download the attachments of this post.

2

Re: HTA + VBS: Остановить выполнение этого сценария

В связи с однопоточной скриптовой моделью, целесообразно выносить ресурсоемкие задачи в отдельный процесс, например, поиск и обработку файлов передать в cmd, а hta использовать для отображения результатов.

3

Re: HTA + VBS: Остановить выполнение этого сценария

А какие критерии появления данного предупреждения ?

4

Re: HTA + VBS: Остановить выполнение этого сценария

Может можно дописать какую-то функцию или вызов что б не появлялось данное предупреждение ?

5

Re: HTA + VBS: Остановить выполнение этого сценария

Немного переделал  по факту получается нужно просто пересохранить содержимое из одних массивов в другие массивы


                        'MsgBox MenuTypeFile1Mask(i).Value &"=" &FileMask1
                        If LCase(MenuTypeFile1Mask(i).Value) = LCase(FileMask1) Then
                            For w = 0 To Ubound(FileMassivMaskPath1) Step 1
                            
                            'MsgBox MenuTypeFile1Mask(i).Value
                            'MsgBox FileMassivMaskPath1(w)
                            
                                If n = "" Then
                                    n = -1
                                    'MsgBox "Назначили N = -1"
                                EnD if
                                
                                n = n + 1
                                reDim preserve FileMassivMaskPath(n)
                                reDim preserve FileMassivMaskName(n)
                                reDim preserve FileMassivMaskDate(n)
                                reDim preserve FileMassivMaskContent(n)
                                reDim preserve FileMassivMaskType(n)
                                
                                FileMassivMaskPath(n) = FileMassivMaskPath1(w)
                                FileMassivMaskName(n) = FileMassivMaskName1(w)
                                FileMassivMaskDate(n) = FileMassivMaskDate1(w)
                                FileMassivMaskContent(n) = FileMassivMaskContent1(w)
                                FileMassivMaskType(n) = FileMassivMaskType1(w)
                                
                                
                                'месяц
                                m = DatePart("m", FileMassivMaskDate(n))
                                
                                
                                PovtorDate = 0
                                
                                'Исключение повторов в выводимом списке
                                For c = 0 to Ubound(FileMassivMaskDate) - 1 Step 1
                                
                                    If DatePart("m", FileMassivMaskDate(c)) = m Then
                                        PovtorDate = 1
                                    End If
                                
                                Next
                                
                                If PovtorDate = 0 Then
                                
                                    if m = 01 then
                                        mtext = "Январь"
                                    End If
                                    
                                    if m = 02 then
                                        mtext = "Февраль"
                                    End If
                                    
                                    if m = 03 then
                                        mtext = "Март"
                                    End If
                                    
                                    if m = 04 then
                                        mtext = "Апрель"
                                    End If
                                    
                                    if m = 05 then
                                        mtext = "Май"
                                    End If
                                    
                                    if m = 06 then
                                        mtext = "Июнь"
                                    End If
                                    
                                    if m = 07 then
                                        mtext = "Июль"
                                    End If
                                    
                                    if m = 08 then
                                        mtext = "Август"
                                    End If
                                    
                                    if m = 09 then
                                        mtext = "Сентябрь"
                                        
                                    End If
                                    
                                    if m = 10 then
                                        mtext = "Октябрь"
                                    End If
                                    
                                    if m = 11 then
                                        mtext = "Ноябрь"
                                    End If
                                    
                                    if m = 12 then
                                        mtext = "Декабрь"
                                    End If
                                    
                                    
                                    If p = "" Then
                                        p = -1
                                        'MsgBox "Назначили P = -1"
                                    EnD if
                                    
                                    p = p + 1
                                    
                                    reDim preserve MounthChooseText(p)
                                    MounthChooseText(p) = mtext
                                    
                                    reDim preserve MounthChooseValue(p)
                                    MounthChooseValue(p) = m
                                    
                                    
                                End If
                            
                            Next
                        End If

6

Re: HTA + VBS: Остановить выполнение этого сценария

Перестроил работу алгоритма все получилось. Отказался от перезаписи массивов одного и того же содержания, после сортировки. Стал работать с индексами массива.

7

Re: HTA + VBS: Остановить выполнение этого сценария

OFF: wildwolf007, продолжаю настоятельно советовать отказаться от использования массивов при нужде многократного «ReDim Preserve». Это дико медленная операция сама по себе, а в случае роста длины массива или её многократного использования превращается в кошмар.

8

Re: HTA + VBS: Остановить выполнение этого сценария

Подобный код:

                                    if m = 01 then
                                        mtext = "Январь"
                                    End If
                                    
                                    if m = 02 then
                                        mtext = "Февраль"
                                    End If
…

будет нагляднее в таком виде:

mtext = Array("Январь", "Февраль", "Март", "Апрель", "Май", "Июнь", "Июль", "Август", "Сентябрь", "Октябрь", "Ноябрь", "Декабрь")(m - 1)

если «m» заведомо не выйдет за пределы диапазона [1..12].

9

Re: HTA + VBS: Остановить выполнение этого сценария

Какие еще варианты возможны замены redim если происходит замена размера массива ? И я не знаю какой размер будет у массива?

10

Re: HTA + VBS: Остановить выполнение этого сценария

wildwolf007 пишет:

Какие еще варианты возможны замены redim если происходит замена размера массива ? И я не знаю какой размер будет у массива?

В одной из Ваших предыдущих тем я приводил пример замены массива.

11 (изменено: wildwolf007, 2014-10-12 21:36:17)

Re: HTA + VBS: Остановить выполнение этого сценария

Просмотрел все 3 справки не могу понять как я могу добавлять в массив данные если заранее не обозначу его размерность?
Как-то так :


Set DataList = CreateObject _
      ("System.Collections.ArrayList")

DataList.Add "B"
DataList.Add "C"
DataList.Add "E"
DataList.Add "D"
DataList.Add "A"

DataList.Sort()

For Each strItem in DataList
    Wscript.Echo strItem
Next

Или есть еще варианты ?

Наверное у меня столько вопросов т.к. еще не научился читать между строк. И до конца не умею разбираться со справочной документацией.

12

Re: HTA + VBS: Остановить выполнение этого сценария

И здесь указывается совершенно другой язык чем ежели VBS указан просто VB

ArrayList Class (System.Collections)

http://msdn.microsoft.com/en-us/library … .110).aspx

13

Re: HTA + VBS: Остановить выполнение этого сценария

wildwolf007 пишет:

Как-то так :

Да. Метод «.Add()» чем-то не устраивает?

wildwolf007 пишет:

И здесь указывается совершенно другой язык чем ежели VBS указан просто VB

Вообще-то, не VB, а VB.Net. Но данный класс доступен и как сервер Automation.

14

Re: HTA + VBS: Остановить выполнение этого сценария

Спасибо огромное за вот этот метод:


Set DataList = CreateObject _
      ("System.Collections.ArrayList")

DataList.Add "2"
DataList.Add "4"
DataList.Add "6"
DataList.Add "1"
DataList.Add "3"
DataList.Add "5"

DataList.Sort()
'DataList.Reverse()

For Each strItem in DataList
    Wscript.Echo strItem
Next

Давно искал возможность сотртировки.
Спасибо огромное!

Скажите, а что по поводу скорости обработки  у данного метода ?

15 (изменено: wildwolf007, 2014-10-12 21:49:51)

Re: HTA + VBS: Остановить выполнение этого сценария

Вообще-то, не VB, а VB.Net. Но данный класс доступен и как сервер Automation.

Необходимо установка дополнительных библиотек и только на Windows Server ? Прошу прощения если задаю глупые вопросы просто не слышал о таком еще.
Насколько я понял это язык программирование идет в состав Visual Studio по крайней мере про него там я слышал.

И насколько я понимаю там намного больше возможностей чем у VBScript тем более идет без компиляции.
VBScript  большой плюс что можно открыть блокнот и спокойно писать без каких либо компиляций.

16

Re: HTA + VBS: Остановить выполнение этого сценария

wildwolf007, достаточно FrameWork-a, так что на каком-нибудь старом XP может не заработать в отличии, скажем, от Recordset и действует только в поле одномерных массивов.

17

Re: HTA + VBS: Остановить выполнение этого сценария

Ок, спасибо.

18

Re: HTA + VBS: Остановить выполнение этого сценария

Скажите, а что по поводу скорости обработки  у данного метода ?

Ничего не скажу. Но Вы можете сравнить.

Необходимо установка дополнительных библиотек

Нет. Функционал реализуется библиотекой «mscorlib.dll» из комплекта Microsoft .Net Framework.

и только на Windows Server ?

В данном случае слово «сервер» относится к термину «Automation». Сервер Automation реализуется библиотекой .dll или .ocx. Клиент Automation — приложение, скрипт, обращающееся к серверу Automation, посредством создания экземпляра класса.

Например, библиотека Microsoft Scripting Runtime («scrrun.dll») реализует такие сервера Automation, как «Scripting.FileSystemObject», «Scripting.Dictionary» и «Scripting.Encoder».

Прошу прощения если задаю глупые вопросы просто не слышал о таком еще.

Думаю, слышали, но в ином контексте — как об «ActiveX».

Задавайте, это не страшно, все мы проходили через незнание. Форум для того и предназначен.

19

Re: HTA + VBS: Остановить выполнение этого сценария

Насколько я понял это язык программирование идет в состав Visual Studio по крайней мере про него там я слышал.

Да.

И насколько я понимаю там намного больше возможностей чем у VBScript

Да.

тем более идет без компиляции.

Нет.