Форум программистов, компьютерный форум, киберфорум
VBScript/JScript/WSH/WMI
Форум программистов и сисадминов Киберфорум > Компьютерный форум > Windows > Администрирование Windows > VBScript/JScript/WSH/WMI
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.88/34: Рейтинг темы: голосов - 34, средняя оценка - 4.88
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122

Объединить hta и vbs

11.03.2015, 10:19. Показов 6972. Ответов 10
Метки нет (Все метки)
Студворк — интернет-сервис помощи студентам
Здравствуйте, понравился progressbar в hta
Кликните здесь для просмотра всего текста
JavaScript
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

<html>
<head>
<title>Обновление программы Выписка рецептов </title>
<meta http-equiv="MSThemeCompatible" content="Yes">
<meta name='resource-type' content='application'>
<meta name='author' content='Shotman0'>
<meta name='copyright' content='Copyright (c) 2007 by shotman'>
<meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>
 
<script language="jscript" type="text/jscript">
 
function resizewin(w,h){
        var top = (screen.width-w)/2;
        var left = (screen.height-h)/2;
        resizeTo(w,h);
        moveTo(top,left);
}
resizewin(600,570);
function doNothing(){return true;}
//window.onerror = doNothing;
 
    function Start(){
        var d = document;
        var line = d.getElementById('process_line');
        var text = d.getElementById('text');
        var line_p = line.firstChild;
        var l = parseInt(document.getElementById('img').style.width.substring(0,(document.getElementById('img').style.width.length-1)));
        d.getElementById('bar').style.visibility = 'visible';
        Go();
    }
    
    function Go(){
        var step = 1;
        var l = parseInt(document.getElementById('img').style.width.substring(0,(document.getElementById('img').style.width.length-1)));
        document.getElementById('img').style.width = (l+parseInt(step))+"%";
        document.getElementById('text').innerHTML = (l+parseInt(step))+"%";
        if(document.getElementById('img').style.width!='100%'){setTimeout('Go()',100)}
        else{
            animFade(document.getElementById('oppo'),0);
            document.getElementById('oppo').display = "none";
        }
    }
    
    function Reset(){
        var d = document;
        var line = d.getElementById('process_line');
        var text = d.getElementById('text');
        var line_p = line.firstChild;
        var l = line_p.style.width.substring(0,(line_p.style.width.length-1));    
        d.getElementById('bar').style.visibility = 'hidden';
        line_p.style.width = "0%";
        text.innerHTML = "0%";
    }
    
    function animFade(ref, counter){
        var f = ref.filters, done = (counter==100);
        if(f){
            for (i=ref.filters.alpha.opacity; i>0; i--){            
                setTimeout('document.getElementById("oppo").filters.alpha.opacity=parseInt(document.getElementById("oppo").filters.alpha.opacity-1);',i*2);
               }
        }
        else ref.style.opacity = ref.style.MozOpacity = counter/100.1;
}
 
</script>
 
<style>
 
*{
    padding:0px;
    margin:0px;
    font:11px Tahoma, Verdana, Arial, Helvetica, sans-serif;
    color:#000000;
}
table{
    border:0px;
    border-collapse:collapse;
}
 
#process_line{
    width:300px;
    height:5px;
    background-color:#FFFFFF;
    border:#CCCCCC 1px solid;
    text-align:left;
    margin-top:3px;
}
 
#bar{
    text-align:center;
    padding-top:200px;
    visibility:hidden;
}
 
#text{
    font-size:10px;
    color:#0000CC;
    font:Verdana, Arial, Helvetica, sans-serif;
}
 
</style>
<body bgcolor="#ffffff" onLoad="Start()">
 
<hta:application
    id="processbar"
    applicationName="processbar"
    contextMenu="no"
    icon="files/data/admin.ico"
    scroll="no"
    scrollFlat="yes"
    selection="no"
    singleInstance="yes"
    version="1.0"
    navigable="yes"
    windowstate="normal"
/>
 
<div id="oppo" style="position:relative; z-index:99; height:150px; background-color:#FFFFFF; filter:Alpha(Opacity=100)">&nbsp;<div>
<div id="bar">
<span id="text">&nbsp;</span>
<div id="process_line"><img id="img" style="background-color:#000099; width:0%; height:3px; filter:Alpha(Opacity=10, FinishOpacity=90, Style=1, StartX=X, StartY=Y, FinishX=X, FinishY=Y) " alt="" /></div>
</div>
</body>
 
</html>

и хочу его использовать при копировании данных с сервера сам код на vbs
Кликните здесь для просмотра всего текста
ActionScript 3
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180

' Создание объектов оболочки и файловой системы
Dim wsh
Dim WshShell 
Set WshShell = WScript.CreateObject("WScript.Shell")
Set wsh = WScript.CreateObject("WScript.Shell")
Set oShell = CreateObject("wscript.shell")
Set oFSO = CreateObject("Scripting.Filesystemobject")
Set WSNetwork = CreateObject("WScript.Network")
wsh.Run("""\\***\-----\***.hta""")
If Not oFSO.FolderExists("C:\-----\log") Then 
oFSO.CreateFolder("C:\--------\log")
End If
LogFolder = "C:\------\log\" ' место расположения лог-файла
StartFolder = "\\*****\"' откуда копируем
aEndFolder = array("-------\") ' куда копируем
 
' обнуление и описание счетчиков, используемых в скрипте
num_EndFolder = 0       '- общее число папок, места назначения для копируемых данных
num_EndFolder_0 = 0     '- не доступное кол-во папок из  num_EndFolder
num_files = 0           '- общее число обработанных файлов
num_files_copy = 0      '- из них скопировано с заменой на новую версию
err_files_copy = 0      '- из них не скопировано в результате ошибки при работе с num_files_copy
num_files_new = 0       '- из них скопировано новых файлов
err_files_new = 0       '- из них не скопировано в результате ошибки при работе с num_files_new
num_SubFolder = 0       '- обработано папок и подпапок
num_SubFolder_copy = 0  '- из них скопировано новых папок и подпапок
err_SubFolder = 0       '- из них не скопировано в результате ошибки при работе с num_SubFolder
 
'***********************************************
' Создание лог-файла
' Задаем имя лога
sLogName = "LogTemp_" & Date & "_" & Time
' Заменяем в имени все знаки на подчеркивания
sLogName = Replace(sLogName, ".", "_")
sLogName = Replace(sLogName, ":", "_")
sLogName = LogFolder & sLogName
' Создаем файл
Set oLogFile = oFSO.CreateTextFile(sLogName & ".log",true)
 
'***********************************************
 
Set oEndFolder = CreateObject("Scripting.FileSystemObject")
' Цикл для перебора папок "куда копируем"
For i=0 to UBound (aEndFolder)
    ' Счетчик кол-ва папок для копируемых данных
    num_EndFolder=num_EndFolder+1
    ' Проверяем доступность папки, в которую хотим произвести копирование
    If oEndFolder.FolderExists ( aEndFolder(i) ) Then 
        ' Записываем результат в лог
        oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " доступна для работы" & vbCrLf
        CopyFolder StartFolder,aEndFolder(i)
        ' Счетчик доступных для копирования папок
        ' удолил      
    else
        ' Записываем результат в лог
        oLogFile.Writeline
        oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена." & vbCrLf
        ' Дублируем сообщение, выводом предупреждения на экран
        WScript.Echo "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена."
        ' Счетчик недоступных для копирования папок
        num_EndFolder_0=num_EndFolder_0+1
    End if
Next
oLogFile.WriteLine "========== Отчет о копировании ==========" & vbCrLf
oLogFile.WriteLine "Было задано " & num_EndFolder & " папок, для копирования в них данных." 
oLogFile.WriteLine "Часть папок оказалась не доступна - " & num_EndFolder_0 & " шт. (см.логи выше)"
oLogFile.WriteLine "Скриптом было обработано - " & num_files & " файлов."
oLogFile.WriteLine "Из них скопировано с заменой - " & num_files_copy & " шт., не скопировано в результате ошибки - " & err_files_copy & " шт."
oLogFile.WriteLine "Из них скопировано новых файлов - " & num_files_new & " шт., не скопировано в результате ошибки - " & err_files_new & " шт."
oLogFile.WriteLine "Скриптом было обработано - " & num_SubFolder & " подпапок."
oLogFile.WriteLine "Из них скопировано новых подпапок - " & num_SubFolder_copy & " шт., не скопировано в результате ошибки - " & err_SubFolder & " шт."
 
Sub CopyFolder(sCopyFolder,sEndCopyFolder)
    ' Создание объекта Folder
    Set oFolder = oFSO.GetFolder(sCopyFolder)
    Set oEndCopyFolder = oFSO.GetFolder(sEndCopyFolder)
    ' Получение коллекции файлов
    Set colFiles = oFolder.Files
    ' Обработка каждого файла из коллекции
    For each oFile in colFiles
        oLogFile.Writeline "Дата создания копируемого файла:"
        oLogFile.Writeline oFile & vbTab & oFile.DateCreated
        ' Счетчик числа проверяемых файлов
        num_files=num_files+1
        ' Проверяем существует уже такой файл в папке, если его нет, то копируем. 
        ' Если есть, то проверяем его актуальность и заменяем более новым, если он устарел.
        If oFSO.FileExists(oFSO.BuildPath(oEndCopyFolder, oFile.Name)) Then 
            ' Записываем результат в лог
            oLogFile.Writeline "Такой файл уже существует в папке " & oEndCopyFolder
            ' Проверяем насколько это свежая копия файла, для этого сравниваем даты создания двух файлов
            oLogFile.Writeline "Проверяем актуальность копии:"
            ' Выгружаем полный путь к проверяемому файлу
            sFileEnd = oFSO.BuildPath(oEndCopyFolder, oFile.Name)
            ' Создаем объект File, для работы с этим файлом
            Set oFileEnd = oFSO.GetFile(sFileEnd)
            ' Сравниваем даты изменения файлов 
            If oFileEnd.DateLastModified < oFile.DateLastModified Then
                ' Проверяемый файл оказался устаревшим, поэтому заменяем его более новым
                oLogFile.Writeline "Копия файла устарела, заменяем его новым.     **********" & vbCrLf
                oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
                ' Проверка на наличие ошибок
                if err.Number <> 0 then
                    ' Запись сообщения об ошибке в лог
                    oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                    ' Очистка ошибки
                    Err.Clear
                    ' Счетчик ошибок при замене файлов
                    err_files_copy=err_files_copy+1
                else
                    ' Счетчик файлов, которые были заменены на новые
                    num_files_copy=num_files_copy+1             
                End if
            else
                ' В этом случае копия прошла проверку, просто продолжаем работу скрипта далее
                oLogFile.Writeline "Копия актуальна. Продолжаем работу." & vbCrLf
            End if
        else
            ' Записываем результат в лог
            oLogFile.Writeline "Этот файл отсутствует в папке " & oEndCopyFolder & " Копируем файл." & vbCrLf
            oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
            ' Проверка на наличие ошибок
            if err.Number <> 0 then
                ' Запись сообщения об ошибке в лог
                oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                ' Очистка ошибки
                Err.Clear
                ' Счетчик ошибок при копировании новых файлов
                err_files_new=err_files_copy+1
            else
                ' Счетчик новых скопированных файлов
                num_files_new=num_files_copy+1              
            End if
        End if  
    Next
    ' Проверяем все папки и подпапки
    oLogFile.Writeline "Обрабатываем и копируем все подпапки из папки " & oEndCopyFolder & vbCrLf
    ' Получение коллекции подпапок
    Set colSubFolders = oFolder.SubFolders
    ' Обработка каждой подпапки
    For Each oSubFolder In colSubFolders
        oLogFile.Writeline "Проверяем подпапку " & oSubFolder
        ' Счетчик обработанных папок и подпапок
        num_SubFolder=num_SubFolder+1   
        ' Проверяем существует уже такая подпапка в папке, если ее нет, то копируем. 
        ' Если есть, то переходим к проверке файлов в подпапке.
        If oFSO.FolderExists(oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path))) Then
            ' Записываем результат в лог
            oLogFile.Writeline "Такая подпапка уже существует в папке " & oEndCopyFolder
            oLogFile.Writeline "Проверяем все файлы в этой подпапке: "
            ' Выгружаем полный путь к проверяемоой подпапке
            sSubFolderEnd = oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path)) & "\" 
            ' Производим рекурсивный вызов процедуры копирования файлов - программа вызывает сама себя
            CopyFolder oSubFolder, sSubFolderEnd            
            ' oLogFile.Writeline
        else
            ' Записываем результат в лог         
            oLogFile.Writeline "Эта подпапка отсутствует в папке " & oEndCopyFolder & " Копируем подпапку." & vbCrLf
            oFSO.CopyFolder oSubFolder, sEndCopyFolder, True
            ' Проверка на наличие ошибок
            if err.Number <> 0 then
                ' Запись сообщения об ошибке в лог
                oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                ' Очистка ошибки
                Err.Clear
                ' Счетчик ошибок при копировании новых папок и подпапок
                err_SubFolder=err_SubFolder+1
            else
                ' Счетчик новых скопированных папок и подпапок
                num_SubFolder_copy=num_SubFolder_copy+1         
            End if
        End if          
    Next
End Sub
 
      
 
WshShell.Run "taskkill /f /IM mshta.exe",0 
wsh.Run("""C:\*****.exe""")
      
Set wsh = Nothing

пока использую обычную гиф анимацию для отображения что данные копируются
Кликните здесь для просмотра всего текста
HTML5
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

<html id="appHTA">
    <head>
        <meta charset="windows-1251">
        <meta http-equiv="Content-Type" content="text/html; charset=windows-1251">
        <meta http-equiv="Content-Language" content="ru">
        <title>My HTA application</title>
        <hta:Application
            Id="oHTA"
            ApplicationName="My HTA application"
            Border="none"
            Caption="no"
            ContextMenu="no"
            InnerBorder="no"
            MaximizeButton="no"
            MinimizeButton="no"
            Navigable="no"
            Scroll="no"
            ScrollFlat="no"
            Selection="no"
            ShowInTaskbar="no"
            SingleInstance="yes"
            SysMenu="no"
            Version="0.1"
            WindowState="normal"
        />
        <style type="text/css">
            BODY {
                color: blue;
                background-color: ButtonFace;
                margin: 0em;
            }
 
        </style>
    <html>
    
    <body id="tagBody">
    
        <img id="Splash" width="100%" height="100%">
    </body>
    
    <script language="VBScript">
        Option Explicit
        
        Dim strImgSource
        Dim objStdPicture
        
        With CreateObject("Scripting.FileSystemObject")
            strImgSource = .BuildPath(Replace(.GetParentFolderName(oHTA.commandLine), """", ""), "My file.gif")
            
            If .FileExists(strImgSource) Then
                Set objStdPicture = LoadPicture(strImgSource)
                Splash.src = "file://" & strImgSource
        
                With window
                    .resizeTo Round(objStdPicture.Width / 26.47), Round(objStdPicture.Height / 26.47)
                    .moveTo (.screen.availWidth - tagBody.offsetWidth) \ 2, (.screen.availHeight - tagBody.offsetHeight) \ 2
                End With
            Else
                MsgBox "Can't find path [" & strImgSource & "].", vbOKOnly & vbExclamation
            End If
        End With
        
                </script>
</html>

подскажите как привязать progressbar к vbs скрипту, что бы отображался правильный процент загрузки

Добавлено через 23 минуты
Спасибо заранее
1
Лучшие ответы (1)
Сообщение: #7339212
IT_Exp
Эксперт
34794 / 4073 / 2104
Регистрация: 17.06.2006
Сообщений: 32,602
Блог
 11.03.2015, 10:19
Ответы с готовыми решениями:

Запуск скрипта VBS из HTA
Добрый день. Помогите пожалуйста в решении следующей задачи. Есть скрипт который собирает определенные данные по ПК пользователя и есть...

Ошибка vbs внутри HTA
Цель: с помощью HTA приложения выполнить команду в cmd, нашёл вот такой код Set WshShell = CreateObject(&quot;WScript.Shell&quot;) ...

HTA, VBS: Ввод кода, по дате
Здравствуйте, подскажите пожалуиста как сделать так, что-бы в HTA файле было, поле для ввода пароля и что-бы пароль зависел от даты! ...

10
251 / 239 / 16
Регистрация: 31.12.2009
Сообщений: 324
11.03.2015, 21:46
переделал немного вашу первую HTA-шку (которая с прогрессбаром) - чтобы явно задавать процент заполнения полосы, также внутри HTA-шки вставил VBS-пример вызова яваскриптовой функции, он (пример) вроде работает, но fade-out на 100% почему-то не срабатывает
таким образом, видимо, ваш основной VBS-скрипт (второй по порядку) имеет смысл засунуть в эту переделанную HTA-шку, в тот же тег, что и VBS-пример (пример можно вытереть или закомментировать), только основной VBS-скрипт наверное придется немного модифицировать:
1. убрать/переделать строки типа "WScript.CreateObject("WScript.Shell ")" на "CreateObject("WScript.Shell")" и остальные ссылки типа "WScript.***" - HTA-шка на такое ругается
2. переделать/сделать аналог вашей рекурсивной процедуры "CopyFolder(sCopyFolder,sEndCopyFold er)" для того чтобы на первом этапе только подсчитать общее количество файлов и каталогов для дальнейшего копирования, чтобы "более лучше" можно было считать проценты ну и вставить вызовы яваскриптовой функции "updateProgress()" для адекватного прогрессбара по количеству обработанных файлов/каталогов
PHP/HTML
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107

<html>
<head>
<title>Обновление программы Выписка рецептов </title>
<meta http-equiv="MSThemeCompatible" content="Yes">
<meta name='resource-type' content='application'>
<meta name='author' content='Shotman0'>
<meta name='copyright' content='Copyright (c) 2007 by shotman'>
<meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>
</head>
 
 
<script language="jscript" type="text/jscript">
function resizewin(w,h){
    var top = (screen.width-w)/2;
    var left = (screen.height-h)/2;
    resizeTo(w,h);
    moveTo(top,left);
}
 
resizewin(600,570);
 
//"rate" - задавать в процентах [0...100]!
function updateProgress(rate)
{
    document.getElementById('img').style.width = parseInt(rate) + "%";
    document.getElementById('text').innerHTML  = rate + "%";
    if(rate >= 100)
    {
        for (var i = document.getElementById("oppo").filters.alpha.opacity; i > 0; i--)
            setTimeout('document.getElementById("oppo").filters.alpha.opacity=parseInt(document.getElementById("oppo").filters.alpha.opacity - 1);', i*2);
        document.getElementById('oppo').display = "none";
    }
}
</script>
 
 
<script language="vbscript" type="text/vbscript">
dim state: state = 0
Sub funk()
    if state <= 100 then
        state = state + 10
        updateProgress state
        setTimeout "funk()", 1000
    end if
End Sub
</script>
 
 
<style>
*{
    padding:0px;
    margin:0px;
    font:11px Tahoma, Verdana, Arial, Helvetica, sans-serif;
    color:#000000;
}
table{
    border:0px;
    border-collapse:collapse;
}
 
#process_line{
    width:300px;
    height:5px;
    background-color:#FFFFFF;
    border:#CCCCCC 1px solid;
    text-align:right;
    margin-top:3px;
}
 
#bar{
    text-align:center;
    padding-top:200px;
    visibility:visible;
}
 
#text{
    font-size:10px;
    color:#0000CC;
    font:Verdana, Arial, Helvetica, sans-serif;
}
</style>
 
 
<body bgcolor="#ffffff" onLoad="funk()">
 
<hta:application
    id="processbar"
    applicationName="processbar"
    contextMenu="no"
    icon="files/data/admin.ico"
    scroll="no"
    scrollFlat="yes"
    selection="no"
    singleInstance="yes"
    version="1.0"
    navigable="yes"
    windowstate="normal"
/>
 
<div id="oppo" style="position:relative; z-index:99; height:150px; background-color:#FFFFFF; filter:Alpha(Opacity=100)">&nbsp;<div>
<div id="bar">
<span id="text">&nbsp;</span>
<div id="process_line"><img id="img" style="background-color:#000099; width:0%; height:3px; filter:Alpha(Opacity=10, FinishOpacity=90, Style=1, StartX=X, StartY=Y, FinishX=X, FinishY=Y) " alt="" /></div>
</div>
</body>
 
</html>
3
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122
12.03.2015, 10:44  [ТС]
Спасибо за информацию, буду дописывать о результатах сообщу
1
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122
13.03.2015, 12:13  [ТС]
Сделал как вы рекомендовали, написал процедуру для подсчёта файлов
PHP
1
2
3
4
5
6
7
8
9
10

Sub ListFolder(curDir)
  n = n + fso.GetFolder(curDir).Files.Count
  For Each s1 in fso.GetFolder(curDir).SubFolders
    If Not s1.attributes=22 Then 
       ListFolder(s1.path)
    End If
  Next
End Sub
 
ListFolder("C:\1\")
а так же процедуру для подсчёна процентов скопированных файлов

PHP
1
2
3
4
5
6

Sub funk()
    if state <= n then
    state = num_files*100/n
            updateProgress state
            end if
End Sub
Но что-то сделал не так, не показывается прогрессбар, хотя всё копируется и запускается, если специально заблокировать какой нибудь файл от копирования, то от падает с ошибкой что нельзя копировать и показывает прогрессбар с процентом уже скопированных файлов,
вот весь код
Кликните здесь для просмотра всего текста
PHP
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303

<html>
<head>
<title>Обновление файлов</title>
<meta http-equiv="MSThemeCompatible" content="Yes">
<meta name='resource-type' content='application'>
<meta name='author' content='Shotman0'>
<meta name='copyright' content='Copyright (c) 2007 by shotman'>
<meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>
</head>
 
 
<script language="jscript" type="text/jscript">
function resizewin(w,h){
    var top = (screen.width-w)/2;
    var left = (screen.height-h)/2;
    resizeTo(w,h);
    moveTo(top,left);
}
 
resizewin(600,570);
 
//"rate" - задавать в процентах [0...100]!
function updateProgress(rate)
{
    document.getElementById('img').style.width = parseInt(rate) + "%";
    document.getElementById('text').innerHTML  = rate + "%";
    if(rate >= 100)
    {
        for (var i = document.getElementById("oppo").filters.alpha.opacity; i > 0; i--)
            setTimeout('document.getElementById("oppo").filters.alpha.opacity=parseInt(document.getElementById("oppo").filters.alpha.opacity - 1);', i*2);
        document.getElementById('oppo').display = "none";
    }
}
</script>
 
 
<script language="vbscript" type="text/vbscript">
' Создание объектов оболочки и файловой системы
Dim fso
n=0
Dim wsh
Dim WshShell 
Set WshShell = CreateObject("WScript.Shell")
Set wsh = CreateObject("WScript.Shell")
Set oShell = CreateObject("wscript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set oFSO = CreateObject("Scripting.Filesystemobject")
Set WSNetwork = CreateObject("WScript.Network")
If Not oFSO.FolderExists("C:\-----\log") Then 
oFSO.CreateFolder("C:\----\log")
End If
LogFolder = "C:\----\log\" ' место расположения лог-файла
StartFolder = "\\-----\"' откуда копируем
aEndFolder = array("С:\---\") ' куда копируем
 
' обнуление и описание счетчиков, используемых в скрипте
num_EndFolder = 0       '- общее число папок, места назначения для копируемых данных
num_EndFolder_0 = 0     '- не доступное кол-во папок из  num_EndFolder
num_files = 0           '- общее число обработанных файлов
num_files_copy = 0      '- из них скопировано с заменой на новую версию
err_files_copy = 0      '- из них не скопировано в результате ошибки при работе с num_files_copy
num_files_new = 0       '- из них скопировано новых файлов
err_files_new = 0       '- из них не скопировано в результате ошибки при работе с num_files_new
num_SubFolder = 0       '- обработано папок и подпапок
num_SubFolder_copy = 0  '- из них скопировано новых папок и подпапок
err_SubFolder = 0       '- из них не скопировано в результате ошибки при работе с num_SubFolder
 
'***********************************************
' Создание лог-файла
' Задаем имя лога
sLogName = "LogTemp_" & Date & "_" & Time
' Заменяем в имени все знаки на подчеркивания
sLogName = Replace(sLogName, ".", "_")
sLogName = Replace(sLogName, ":", "_")
sLogName = LogFolder & sLogName
' Создаем файл
Set oLogFile = oFSO.CreateTextFile(sLogName & ".log",true)
 
'***********************************************
Sub ListFolder(curDir)
  n = n + fso.GetFolder(curDir).Files.Count
  For Each s1 in fso.GetFolder(curDir).SubFolders
    If Not s1.attributes=22 Then 
       ListFolder(s1.path)
    End If
  Next
End Sub
 
ListFolder("\\-----\")
'MsgBox "Общее количество файлов: " & n
 
Sub funk()
    if state <= n then
    state = num_files*100/n
            updateProgress state
            end if
End Sub
Set oEndFolder = CreateObject("Scripting.FileSystemObject")
' Цикл для перебора папок "куда копируем"
For i=0 to UBound (aEndFolder)
    ' Счетчик кол-ва папок для копируемых данных
    num_EndFolder=num_EndFolder+1
    
    ' Проверяем доступность папки, в которую хотим произвести копирование
    If oEndFolder.FolderExists ( aEndFolder(i) ) Then 
        ' Записываем результат в лог
        oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " доступна для работы" & vbCrLf
        CopyFolder StartFolder,aEndFolder(i)
        ' Счетчик доступных для копирования папок
        ' удолил      
    else
        ' Записываем результат в лог
        oLogFile.Writeline
        oLogFile.Writeline "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена." & vbCrLf
        ' Дублируем сообщение, выводом предупреждения на экран
        WScript.Echo "Папка " & "'" & aEndFolder(i) & "'" & " в настоящий момент не доступна. Работа с ней прекращена."
        ' Счетчик недоступных для копирования папок
        num_EndFolder_0=num_EndFolder_0+1
         
      
     
    End if
Next
oLogFile.WriteLine "========== Отчет о копировании ==========" & vbCrLf
oLogFile.WriteLine "Было задано " & num_EndFolder & " папок, для копирования в них данных." 
oLogFile.WriteLine "Часть папок оказалась не доступна - " & num_EndFolder_0 & " шт. (см.логи выше)"
oLogFile.WriteLine "Скриптом было обработано - " & num_files & " файлов."
oLogFile.WriteLine "Из них скопировано с заменой - " & num_files_copy & " шт., не скопировано в результате ошибки - " & err_files_copy & " шт."
oLogFile.WriteLine "Из них скопировано новых файлов - " & num_files_new & " шт., не скопировано в результате ошибки - " & err_files_new & " шт."
oLogFile.WriteLine "Скриптом было обработано - " & num_SubFolder & " подпапок."
oLogFile.WriteLine "Из них скопировано новых подпапок - " & num_SubFolder_copy & " шт., не скопировано в результате ошибки - " & err_SubFolder & " шт."
 
Sub CopyFolder(sCopyFolder,sEndCopyFolder)
    ' Создание объекта Folder
    
    Set oFolder = oFSO.GetFolder(sCopyFolder)
    Set oEndCopyFolder = oFSO.GetFolder(sEndCopyFolder)
    ' Получение коллекции файлов
    Set colFiles = oFolder.Files
    ' Обработка каждого файла из коллекции
    For each oFile in colFiles
        oLogFile.Writeline "Дата создания копируемого файла:"
        oLogFile.Writeline oFile & vbTab & oFile.DateCreated
        ' Счетчик числа проверяемых файлов
        num_files=num_files+1
        ' Проверяем существует уже такой файл в папке, если его нет, то копируем. 
        ' Если есть, то проверяем его актуальность и заменяем более новым, если он устарел.
        If oFSO.FileExists(oFSO.BuildPath(oEndCopyFolder, oFile.Name)) Then 
            ' Записываем результат в лог
            oLogFile.Writeline "Такой файл уже существует в папке " & oEndCopyFolder
            ' Проверяем насколько это свежая копия файла, для этого сравниваем даты создания двух файлов
            oLogFile.Writeline "Проверяем актуальность копии:"
            ' Выгружаем полный путь к проверяемому файлу
            sFileEnd = oFSO.BuildPath(oEndCopyFolder, oFile.Name)
            ' Создаем объект File, для работы с этим файлом
            Set oFileEnd = oFSO.GetFile(sFileEnd)
            ' Сравниваем даты изменения файлов 
            If oFileEnd.DateLastModified < oFile.DateLastModified Then
                ' Проверяемый файл оказался устаревшим, поэтому заменяем его более новым
                oLogFile.Writeline "Копия файла устарела, заменяем его новым.     **********" & vbCrLf
                oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
                ' Проверка на наличие ошибок
                if err.Number <> 0 then
                    ' Запись сообщения об ошибке в лог
                    oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                    ' Очистка ошибки
                    Err.Clear
                    ' Счетчик ошибок при замене файлов
                    err_files_copy=err_files_copy+1
                else
                    ' Счетчик файлов, которые были заменены на новые
                    num_files_copy=num_files_copy+1             
                End if
            else
                ' В этом случае копия прошла проверку, просто продолжаем работу скрипта далее
                oLogFile.Writeline "Копия актуальна. Продолжаем работу." & vbCrLf
            End if
        else
            ' Записываем результат в лог
            oLogFile.Writeline "Этот файл отсутствует в папке " & oEndCopyFolder & " Копируем файл." & vbCrLf
            oFSO.CopyFile oFile, sEndCopyFolder & oFile.Name, True
            ' Проверка на наличие ошибок
            if err.Number <> 0 then
                ' Запись сообщения об ошибке в лог
                oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                ' Очистка ошибки
                Err.Clear
                ' Счетчик ошибок при копировании новых файлов
                err_files_new=err_files_copy+1
            else
                ' Счетчик новых скопированных файлов
                num_files_new=num_files_copy+1              
            End if
        End if  
    Next
    ' Проверяем все папки и подпапки
    oLogFile.Writeline "Обрабатываем и копируем все подпапки из папки " & oEndCopyFolder & vbCrLf
    ' Получение коллекции подпапок
    Set colSubFolders = oFolder.SubFolders
    ' Обработка каждой подпапки
    For Each oSubFolder In colSubFolders
        oLogFile.Writeline "Проверяем подпапку " & oSubFolder
        ' Счетчик обработанных папок и подпапок
        num_SubFolder=num_SubFolder+1   
        ' Проверяем существует уже такая подпапка в папке, если ее нет, то копируем. 
        ' Если есть, то переходим к проверке файлов в подпапке.
        If oFSO.FolderExists(oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path))) Then
            ' Записываем результат в лог
            oLogFile.Writeline "Такая подпапка уже существует в папке " & oEndCopyFolder
            oLogFile.Writeline "Проверяем все файлы в этой подпапке: "
            ' Выгружаем полный путь к проверяемоой подпапке
            sSubFolderEnd = oFSO.BuildPath(oEndCopyFolder, oFSO.GetBaseName(oSubFolder.Path)) & "\" 
            ' Производим рекурсивный вызов процедуры копирования файлов - программа вызывает сама себя
            CopyFolder oSubFolder, sSubFolderEnd            
            ' oLogFile.Writeline
        else
            ' Записываем результат в лог         
            oLogFile.Writeline "Эта подпапка отсутствует в папке " & oEndCopyFolder & " Копируем подпапку." & vbCrLf
            oFSO.CopyFolder oSubFolder, sEndCopyFolder, True
            ' Проверка на наличие ошибок
            if err.Number <> 0 then
                ' Запись сообщения об ошибке в лог
                oLogFile.Writeline "-----> Error # " & CStr(Err.Number) & " " & Err.Description
                ' Очистка ошибки
                Err.Clear
                ' Счетчик ошибок при копировании новых папок и подпапок
                err_SubFolder=err_SubFolder+1
            else
                ' Счетчик новых скопированных папок и подпапок
                num_SubFolder_copy=num_SubFolder_copy+1         
            End if
        End if          
    Next
End Sub
 
    
 
WshShell.Run "taskkill /f /IM mshta.exe",0 
wsh.Run("""C:\----\""")
      
Set wsh = Nothing
</script>
 
 
<style>
*{
    padding:0px;
    margin:0px;
    font:11px Tahoma, Verdana, Arial, Helvetica, sans-serif;
    color:#000000;
}
table{
    border:0px;
    border-collapse:collapse;
}
 
#process_line{
    width:300px;
    height:5px;
    background-color:#FFFFFF;
    border:#CCCCCC 1px solid;
    text-align:right;
    margin-top:3px;
}
 
#bar{
    text-align:center;
    padding-top:200px;
    visibility:visible;
}
 
#text{
    font-size:10px;
    color:#0000CC;
    font:Verdana, Arial, Helvetica, sans-serif;
}
</style>
 
 
<body bgcolor="#ffffff" onLoad="funk()">
 
<hta:application
    id="processbar"
    applicationName="processbar"
    contextMenu="no"
    icon="files/data/admin.ico"
    scroll="no"
    scrollFlat="yes"
    selection="no"
    singleInstance="yes"
    version="1.0"
    navigable="yes"
    windowstate="normal"
/>
 
<div id="oppo" style="position:relative; z-index:99; height:150px; background-color:#FFFFFF; filter:Alpha(Opacity=100)">&nbsp;<div>
<div id="bar">
<span id="text">&nbsp;</span>
<div id="process_line"><img id="img" style="background-color:#000099; width:0%; height:3px; filter:Alpha(Opacity=10, FinishOpacity=90, Style=1, StartX=X, StartY=Y, FinishX=X, FinishY=Y) " alt="" /></div>
</div>
</body>
 
</html>

подскажите где допустил ошибку(копировал разные по весу файлы, и разное колличество)
1
251 / 239 / 16
Регистрация: 31.12.2009
Сообщений: 324
14.03.2015, 11:47
Лучший ответ Сообщение было отмечено Glin как решение

Решение

Цитата Сообщение от Glin Посмотреть сообщение
...не показывается прогрессбар, хотя всё копируется и запускается, если специально заблокировать какой нибудь файл от копирования, то от падает с ошибкой что нельзя копировать и показывает прогрессбар...
у меня вот тоже не получилось отображать прогрессбар из циклов (в том числе циклов вашей функции CopyFolder()) - не срабатывает функция setTimer(), а получилось (вроде) примерно в таком варианте: (он (этот вариант) делался "с нуля" но прогрессбар показывает, для него понадобится перенос вашего функционала (функции CopyFolder()) в функцию CopyFile(sSrcFileName, sDstFolderName), тоесть работы многовато, но если нужен прогрессбар, то видимо больше никак, кстати под прогрессбаром, видимо можно динамически показывать какой файл и куда копируется):
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

<html>
<head>
<title>Обновление программы Выписка рецептов </title>
<meta http-equiv="MSThemeCompatible" content="Yes">
<meta name='resource-type' content='application'>
<meta name='author' content='Shotman0'>
<meta name='copyright' content='Copyright (c) 2007 by shotman'>
<meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>
</head>
 
 
 
<script language="vbscript" type="text/vbscript">
Dim g_nFilesTotal, g_nFilesProcessed: g_nFilesTotal = 0
Dim g_objFS, g_objLog
Dim g_arrA()
 
 
 
Sub main()
    Dim objA
 
    sSrcFolder = "C:\src\" ' откуда копируем
    sDstFolder = "C:\dst\" ' куда копируем
 
 
    Set g_objFS = CreateObject("Scripting.Filesystemobject")
 
 
    If g_nFilesTotal = 0 Then
        g_nFilesProcessed = 0
        ListFolder sSrcFolder
        MsgBox "Общее количество файлов: " & g_nFilesTotal
        g_nFilesProcessed = 1
    End If
 
 
    If g_nFilesProcessed < Ubound(g_arrA) Then
        CopyFile g_arrA(g_nFilesProcessed), sDstFolder
        g_nFilesProcessed = g_nFilesProcessed + 1
        updateProgress CInt(g_nFilesProcessed/g_nFilesTotal*100)
        setTimeout "main()", 100
    End If
 
 
    Set g_objFS = Nothing
End Sub
 
 
 
Sub CopyFile(sSrcFileName, sDstFolderName)
    'MsgBox "копируем: " & sSrcFileName & vbCrLf & " в: " & sDstFolderName & g_objFS.GetFileName(sSrcFileName) & vbCrLf & " i=" & g_nFilesProcessed
    g_objFS.CopyFile sSrcFileName, sDstFolderName & g_objFS.GetFileName(sSrcFileName), True
End Sub
 
 
 
Sub ListFolder(sCurDir)
    Dim objA
 
On Error Resume Next
    g_nFilesTotal = g_nFilesTotal + g_objFS.GetFolder(sCurDir).Files.Count
 
    For Each objA in g_objFS.GetFolder(sCurDir).Files
        g_arrA(g_nFilesProcessed) = objA.Path
        g_nFilesProcessed = g_nFilesProcessed + 1
        ReDim Preserve g_arrA(g_nFilesProcessed)
    Next
 
    For Each objA in g_objFS.GetFolder(sCurDir).SubFolders
        ListFolder(objA.Path)
    Next
On Error GoTo 0
End Sub
 
 
 
Sub updateProgress(rate)
    If (rate < 100) Then
        document.getElementById("img").style.width = CInt(rate) & "%"
        document.getElementById("text").innerHTML  = rate & "%"
    Else
        document.getElementById("img").style.width = "100%"
        document.getElementById("text").innerHTML  = "100%"
        for i = document.getElementById("oppo").filters.alpha.opacity To 0 Step -1
            setTimeout "document.getElementById(""oppo"").filters.alpha.opacity=CInt(document.getElementById(""oppo"").filters.alpha.opacity - 1)", i*2
        Next
    End If
End Sub
</script>
 
 
<style>
*{
    padding:0px;
    margin:0px;
    font:11px Tahoma, Verdana, Arial, Helvetica, sans-serif;
    color:#000000;
}
table{
    border:0px;
    border-collapse:collapse;
}
 
#process_line{
    width:300px;
    height:5px;
    background-color:#FFFFFF;
    border:#CCCCCC 1px solid;
    text-align:left;
    margin-top:3px;
}
 
#bar{
    text-align:center;
    padding-top:200px;
    visibility:visible;
}
 
#text{
    font-size:10px;
    color:#0000CC;
    font:Verdana, Arial, Helvetica, sans-serif;
}
</style>
 
 
<body bgcolor="#ffffff" onLoad="main()">
 
<hta:application
    id="processbar"
    applicationName="processbar"
    contextMenu="no"
    icon="files/data/admin.ico"
    scroll="no"
    scrollFlat="yes"
    selection="no"
    singleInstance="yes"
    version="1.0"
    navigable="yes"
    windowstate="normal"
/>
 
<div id="oppo" style="position:relative; z-index:99; height:150px; background-color:#FFFFFF; filter:Alpha(Opacity=100)">&nbsp;<div>
<div id="bar">
<span id="text">&nbsp;</span>
<div id="process_line"><img id="img" style="background-color:#000099; width:0%; height:3px; filter:Alpha(Opacity=10, FinishOpacity=90, Style=1, StartX=X, StartY=Y, FinishX=X, FinishY=Y) " alt="" /></div>
</div>
</body>
 
</html>
2
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122
16.03.2015, 13:14  [ТС]
За совет какой файл копируется, спасибо. Попробую доработать свой, может найду в чём причина, если нет буду дорабатывать ваш код.
2
251 / 239 / 16
Регистрация: 31.12.2009
Сообщений: 324
17.03.2015, 15:06
Спасибо и вам, я вот, тоже первый раз увидел такую продвинутую HTA-шку, (в смысле HTML/CSS) как ваша первая, да и вторая тоже любопытная, интересно было поковыряться а про screen updating вроде на stackoverflow писали, что яваскрипт (и вбскрипт хта-шечный) он типа однозадачный, и иначе чем settimer-ом экран не перерисовывается хотя, конечно могу ошибаться
1
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122
23.03.2015, 12:00  [ТС]
Сдаюсь, долго и мучитель ковырял, но к результату не пришёл, либо не показывает progressbar, либо норм файл-лог не создаётся. Оставлю как есть, анимация через гиф, пойду читать мануал.
0
251 / 239 / 16
Регистрация: 31.12.2009
Сообщений: 324
23.03.2015, 14:44
Цитата Сообщение от Glin Посмотреть сообщение
...норм файл-лог не создаётся...
с добавленным логом и отображением копируемых файлов хта-шка из #5 поста изменится примерно так:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

<html>
<head>
<title>Обновление программы Выписка рецептов </title>
<meta http-equiv="MSThemeCompatible" content="Yes">
<meta name='resource-type' content='application'>
<meta name='author' content='Shotman0'>
<meta name='copyright' content='Copyright (c) 2007 by shotman'>
<meta http-equiv='Content-Type' content='text/html; charset=windows-1251'>
</head>
 
 
 
<script language="vbscript" type="text/vbscript">
Dim g_nFilesTotal, g_nFilesProcessed: g_nFilesTotal = 0
Dim g_objFS, g_objLog
Dim g_arrA()
 
 
 
Sub main()
 
    sSrcFolder = "C:\-\_src\"        'откуда копируем
    sDstFolder = "C:\-\_dst\"        'куда копируем
    sLogName   = "C:\-\_dst\log.txt" 'имя лога
 
    Set g_objFS = CreateObject("Scripting.Filesystemobject")
 
    Set g_objLog = g_objFS.OpenTextFile(sLogName, 8, True) '8=ForAppending; true=create_if_not_exist
 
    If g_nFilesTotal = 0 Then
        g_nFilesProcessed = 0
        ListFolder sSrcFolder
        MsgBox "Общее количество файлов: " & g_nFilesTotal
        g_nFilesProcessed = 1
    End If
 
 
    If g_nFilesProcessed < Ubound(g_arrA) Then
        CopyFile g_arrA(g_nFilesProcessed), sDstFolder
        g_nFilesProcessed = g_nFilesProcessed + 1
        updateProgress CInt(g_nFilesProcessed/g_nFilesTotal*100)
        setTimeout "main()", 100
    End If
 
 
    Set g_objLog = Nothing
    Set g_objFS  = Nothing
End Sub
 
 
 
Sub CopyFile(sSrcFileName, sDstFolderName)
    Dim sStr
 
    sStr = "копируем: " & sSrcFileName & "<br>" & "в: " & sDstFolderName & g_objFS.GetFileName(sSrcFileName) & "<br>" & "i=" & g_nFilesProcessed
 
    document.getElementById("text1").innerHTML  = sStr
 
    g_objFS.CopyFile sSrcFileName, sDstFolderName & g_objFS.GetFileName(sSrcFileName), True
    g_objLog.WriteLine(sStr)
End Sub
 
 
 
Sub ListFolder(sCurDir)
    Dim objA
 
On Error Resume Next
    g_nFilesTotal = g_nFilesTotal + g_objFS.GetFolder(sCurDir).Files.Count
 
    For Each objA in g_objFS.GetFolder(sCurDir).Files
        g_arrA(g_nFilesProcessed) = objA.Path
        g_nFilesProcessed = g_nFilesProcessed + 1
        ReDim Preserve g_arrA(g_nFilesProcessed)
    Next
 
    For Each objA in g_objFS.GetFolder(sCurDir).SubFolders
        ListFolder(objA.Path)
    Next
On Error GoTo 0
End Sub
 
 
 
Sub updateProgress(rate)
    If (rate < 100) Then
        document.getElementById("img").style.width = CInt(rate) & "%"
        document.getElementById("text").innerHTML  = rate & "%"
    Else
        document.getElementById("img").style.width = "100%"
        document.getElementById("text").innerHTML  = "100%"
        for i = document.getElementById("oppo").filters.alpha.opacity To 0 Step -1
            setTimeout "document.getElementById(""oppo"").filters.alpha.opacity=CInt(document.getElementById(""oppo"").filters.alpha.opacity - 1)", i*2
        Next
    End If
End Sub
</script>
 
 
<style>
*{
    padding:0px;
    margin:0px;
    font:11px Tahoma, Verdana, Arial, Helvetica, sans-serif;
    color:#000000;
}
table{
    border:0px;
    border-collapse:collapse;
}
 
#process_line{
    width:300px;
    height:5px;
    background-color:#FFFFFF;
    border:#CCCCCC 1px solid;
    text-align:left;
    margin-top:3px;
}
 
#bar{
    text-align:center;
    padding-top:200px;
    visibility:visible;
}
 
#text{
    font-size:10px;
    color:#0000CC;
    font:Verdana, Arial, Helvetica, sans-serif;
}
</style>
 
 
<body bgcolor="#ffffff" onLoad="main()">
 
<hta:application
    id="processbar"
    applicationName="processbar"
    contextMenu="no"
    icon="files/data/admin.ico"
    scroll="no"
    scrollFlat="yes"
    selection="no"
    singleInstance="yes"
    version="1.0"
    navigable="yes"
    windowstate="normal"
/>
 
<div id="oppo" style="position:relative; z-index:99; height:150px; background-color:#FFFFFF; filter:Alpha(Opacity=100)">&nbsp;<div>
<div id="bar">
<span id="text">&nbsp;</span>
<div id="process_line"><img id="img" style="background-color:#000099; width:0%; height:3px; filter:Alpha(Opacity=10, FinishOpacity=90, Style=1, StartX=X, StartY=Y, FinishX=X, FinishY=Y) " alt="" /></div>
<span id="text1">&nbsp;</span>
</div>
</body>
 
</html>

Цитата Сообщение от Glin Посмотреть сообщение
...пойду читать мануал...
...про глобальные переменные (в скрипте они с префиксом g_: g_arrA(), ...) - логическая структура его (скрипта) и впрямь "аховая",
из-за особенностей (выявившихся в процессе) отрисовки GUI
...и про массивы (ReDim) - в данном варианте почему-то копируется на 1 файл меньше чем нужно, хотя MsgBox при старте показывает правильное число,
если через массивы "вылечить" сие не получится, придется изобретать что-то другое
Цитата Сообщение от Glin Посмотреть сообщение
...Сдаюсь...
3
16 / 16 / 5
Регистрация: 26.05.2014
Сообщений: 122
24.03.2015, 14:22  [ТС]
Цитата Сообщение от buggydancer Посмотреть сообщение
копируется на 1 файл меньше чем нужно
Почему-то не берёт первый элемент массива, читать чужой код сложно, поэтому пока сам не разобрался почему, происходит.
Судя по логу
Кликните здесь для просмотра всего текста
копируем: D:\1\3<br>в: D:\2\3<br>i=1
копируем: D:\1\4<br>в: D:\2\4<br>i=2
копируем: D:\1\5<br>в: D:\2\5<br>i=3
копируем: D:\1\6<br>в: D:\2\6<br>i=4
копируем: D:\1\Thumbs.db<br>в: D:\2\Thumbs.db<br>i=5
копируем: D:\1\Новая папка\1<br>в: D:\2\1<br>i=6

не берёт 2 файл из папки 1 который должен быть 1 в массиве.
Сейчас пробую дописать ваш код чтобы сохранял иерархию попок при копировании.

и да не буду сдаваться!

Добавлено через 36 минут
И меня не будет какое то время, в связи со здоровьем, как появлюсь буду дальше вас доставать =)
1
 Аватар для volodin661
6791 / 2288 / 348
Регистрация: 10.12.2013
Сообщений: 7,897
27.03.2015, 14:44
Цитата Сообщение от Glin Посмотреть сообщение
чтобы сохранял иерархию попок
иерархия попок произвела впечатление.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
BasicMan
Эксперт
29316 / 5623 / 2384
Регистрация: 17.02.2009
Сообщений: 30,364
Блог
 27.03.2015, 14:44
Помогаю со студенческими работами здесь

VBS Отправка e-mail через SMTP-сервер - VBScript/JScript/WSH/WMI/HTA
Помогите, при запуске скрипта возникает ошибка Option Explicit 'Содание объекта CDO Dim objmes Set...

HTA: не работает атрибут windowstate в теге <hta:application>
какое бы значение этому атрибуту не присваивал (normal |minimize | maximize), окно открывается дефолтного размера (т.е. normal) кроме...

HTA: Где узнать, какая версия MS JScript поддерживается в HTA для конкретной версии Windows
По работе возникла необходимость переделать давно написанное HTA-приложение На работе стоит Windows-7 c MSIE-8, а дома, где начал...

Создание бинарного файла из vbs / Как создать exe файл из vbs
Имеется файл с расширением exe. Нужно как-нибудь занести массив байт в скрипт, и чтоб потом этот файл создавался при запуске vbs

VBS.rmnet5 и Programm.Unwanted.2042 и VBS.Dropper.128
Вирус распространяется во время его поиска dr.web'om. Уже не знаю, что делать помогите не могу его удалить(


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Новые блоги и статьи
Модульная разработка через nuget packages
DevAlt 07.03.2026
Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F#
DevAlt 06.03.2026
В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .
Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование
8Observer8 05.03.2026
Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .
SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D
8Observer8 04.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .
SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий
8Observer8 02.03.2026
Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .
Реалии
Hrethgir 01.03.2026
Нет, я не закончил до сих пор симулятор. Эта задача сложнее. Не получилось уйти в плавсостав, но оно и к лучшему, возможно. Точнее получалось - но сварщиком в палубную команду, а это значит, в моём. . .
Ритм жизни
kumehtar 27.02.2026
Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .
SDL3 для Web (WebAssembly): Сборка библиотек: SDL3, Box2D, FreeType, SDL3_ttf, SDL3_mixer и SDL3_image из исходников с помощью CMake и Emscripten
8Observer8 27.02.2026
Недавно вышла версия 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual Studio. . . .
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Условия использования - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru