Форум программистов, компьютерный форум, киберфорум
VBScript/JScript/WSH/WMI/HTA
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.53/15: Рейтинг темы: голосов - 15, средняя оценка - 4.53
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
1
VBS

Копирование с USB в папку на компьютере, с проверками

11.11.2017, 22:14. Показов 2941. Ответов 11
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Попросили помочь в написании скрипта, а я сам не особо в этом шарю. Задача такова:
Определить, изменялась ли заданная пользователем папка за последний месяц. Если нет, скопировать в нее файлы со съемного носителя. Проверить наличие съемного носителя, вывести список имеющихся на ней файлов и удостовериться, что на рабочем диске достаточно места. Создать файл, записав туда тип диска, с которого выполнялось копирование и его метку. Файлу присвоить атрибут «Скрытый».
Порылся по форуму, почитал немного литературу, и слепил такого Франкенштейна.
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
strTarget = Trim(InputBox("set path to copy"))
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
Set tFolder = fso.GetFolder(strTarget)
Set sDrive = fso.GetDrive(strSource)
Set sFolder = fso.GetFolder(strSource)   ' флешка-источник
 
If Age>30 Then
    Set lDrive = tFolder.Drive.DriveLetter  ' получаем диск папки назначения
    Set uDrive = sDrive.DriveLetter ' получаем диск папки-источника
    drFree = (FormatNumber(lDrive.AvailableSpace/1024, 0) - (FormatNumber(uDrive.TotalSize/1024, 0) - FormatNumber(uDrive.AvailableSpace/1024, 0)) - 1024)
    If drFree > 0 Then
    usbDrive
    sFolder.Copy tFolder
    Else
    WScript.Echo("Not enough space on destination drive")
    End If
    WScript.Echo("Destination folder was in use in last 30 days")
End If
 
'======================================
Function Age(tFolder)
    Age = DateDiff("d", tFolder.DateLasModified, Now())
End Function
 
'======================================
Sub usbDrive
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2") 
Set objEvents = objWMIService.ExecNotificationQuery _
("SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE " & _
    "TargetInstance ISA 'Win32_LogicalDisk'" & _
    " AND TargetInstance.DriveType = 2")
    Set objReceivedEvent = objEvents.NextEvent
    Set strSource = objReceivedEvent.TargetInstance.Name
    Set Folder = fso.GetFolder(strSource)
    For Each File In Folder.Files
    WScript.Echo File.Name
    Set logLine = "VolumeType:" & objReceivedEvent.TargetInstance.DriveType & VbCrLf & _
    "VolumeName: " & objReceivedEvent.TargetInstance.VolumeName
    Set Folder = FSO.GetFolder(strTarget)
    Set TextStream = Folder.CreateTextFile("log.txt")
    TextStream.WriteLine logLine
    TextStream.Close
    set logFile = fso.GetFile(strTarget & "log.txt") ' как получить только что созданный файл, чтобы назначить ему атрибут?
    logFile.Attributes = 2
End Sub
Теперь вопросы по порядку:
1. Проверка последнего использования папки в функции Age, скрипт нашёл на форуме, по идее проблем быть не должно;
2. Проверка наличия свободного места. Что думаете по этому поводу?
3. Проверка наличия съёмного носителя, находил на форуме, вроде вставил правильно. Но есть сомнения.
4. С записью в текстовый файл информации о флешке вроде не должно быть, но вот как затем его сделать скрытым...
5. Ну и собственно организовать копирование. Корректно ли я его сделал.
Ну и при запуске выдаёт ошибку на последней строке. Ошибка: предполагается наличие инструкций
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
11.11.2017, 22:14
Ответы с готовыми решениями:

Поиск на компьютере INI-файла и копирование найденного файла в папку определенного пользователя
Нужна ваша помощь! Нужно найти файл с расширением .ini и скопировать его в папку Пользователи\(имя...

Будет ли работать быстрее флешка с USB 2.0, если подключить ее к разъему на компьютере USB 3.0?
Будет ли работать быстрее флешка с USB 2.0, если подключить ее к разъему на компьютере USB 3.0?

Будет ли работать принтер с USB 2.0 на компьютере с USB 1.1?
Здравствуйте, Хочу приобрести себе принтер, но в характеристиках принтера указан USB 2.0, а у меня...

Не могу отобразить папку .thumbnails на компьютере
В телефоне Samsung Galaxy Note II есть папка .thumbnails. Хочу скинуть фото и видео из этой папке...

11
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
13.11.2017, 09:39 2
Eugene_BY
1-5. Дата модификации папки может вовсе не совпадать с датой модификации измёнённого последним объекта в её структуре. Поэтому логично рекурсивно просматривать и при соответствии копировать все объекты. С другой стороны, копирование изменённых объектов подразумевает замену, поэтому нужно предусмотреть опцию перезаписи или переименования по счётчику. Смысла записывать Age в функцию я не вижу.
2. Проще записать If .AvailableSpace > [bytes].
3. Если нужно искать только USB-флеш-накопители (не SSD/HDD), то проще смотреть по if sDrive.DriveType = 1 And sDrive.IsReady. Если нужна конкретная флешка, то — по if sDrive.SerialNumber = [№] And sDrive.IsReady.
4. logFile.Attributes = logFile.Attributes Or 2

Добавлено через 18 часов 22 минуты
Если вам есть что ответить, логично было бы написать здесь, а не цитировать меня на другом форуме и вести неполноценные беседы, так и не ответив на ключевые вопросы по поводу конкретной/любой флешки, способа указания/выбора источника/получателя, точного понимания организации копирования и т. п. После внесения ясности велика вероятность появления более конкретной помощи, коли самостоятельно решить вопрос не получается.
1
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
13.11.2017, 10:11  [ТС] 3
Спасибо за подсказку. По поводу флешки, в задании на этот счёт никакой конкретики. Я думаю, любая подключаемая. Т.е. источник автоматически получается из подключаемой флешки. А вот получателя задаёт пользователь. И вот уточнение по поводу даты изменения не самой папки, а находящихся в ней файлов, думаю, всё же папку рассматривать, так как в задании уточнения нет. Чтобы не усложнять скрипт. Функцию я убрал. По поводу рекомендации к проверке наличия свободного места. Я думаю, стоит учитывать конкретный объём копируемого, и дать небольшой запас. Т.е. может оформить более красиво, но с той логикой, что у меня. По поводу копирования, думаю в цикле перебор всех файлов с копированием, и на случай наличия вложенных папок. Попробую сегодня переписать и показать, что у меня вышло.
И у меня почему-то на работе сервак не любит киберфорум, открывает сохранённые копии страниц. Но это уже к теме не относится.
0
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
13.11.2017, 11:27 4
Цитата Сообщение от Eugene_BY
Я думаю, любая подключаемая.
Таки USB-флешка/карта или любой внешний носитель (+eSDD/eHDD)?
Цитата Сообщение от Eugene_BY
Т.е. источник автоматически получается из подключаемой флешки.
Т. е. на любой подключаемой флешке стоит ожидать наличия заданной папки?
Цитата Сообщение от Eugene_BY
думаю, всё же папку рассматривать, так как в задании уточнения нет.
В задании (не домашнем ли?) нет и уточнения по поводу даты модификации. Написано "изменялась ли заданная пользователем папка". Под изменением логично подразумевать внутренности (создание/изменение файлов на разной глубине). И как я уже писал, для копирования нужно точное понимание, заменять старый или добавлять переименованный файл.

P.S.: Насчёт сервака сомневаюсь. Другой браузер попробуйте.
0
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
13.11.2017, 13:49  [ТС] 5
Всё же в сервере дело, дома и на мобильном Хром отображает нормально, а на работе ни Хром, ни Огнелис, ни IE не хотят.
Теперь по теме вопроса. Это лабораторная на заочке. Попросили помочь, мне стало интересно и взялся. Уточнил задание. Это именно флешка, копирование с любой подключаемой, как файлы в корне, так и папки с вложениями. Путь указывает пользователь в инпутбоксе, переменная tPath. Проверять именно папку по поводу даты изменения. Ну а замена файлов или переименование, это на усмотрение выполняющего задание.
Надеюсь, время будет сегодня, показать, что получается у меня.
0
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
13.11.2017, 16:14 6
Лучший ответ Сообщение было отмечено Eugene_BY как решение

Решение

Плохое задание, если проверять нужно только дату модификации папки (даже не её размер, не говоря про содержимое).
Я уж было сам набросал более грамотный вариант, но раз всё так печально у "профессуры", что ж тут поделать. В любом случае сопоставлять со свободным местом нужно размер каждого годного файла, иначе в результате из-за разницы в размерах прерывание скриптом может не случиться или будет в ряде случаев несвоевременным.
Ладно, хоть и не люблю помогать по домашкам, пусть будет как образец:

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
Option Explicit
Const RPath = "Folder1\Folder2\Folder3" ' относительный флеш-диска путь к получателю
Const Min = 250 ' минимальный остаток свободного места на диске в Мб
Const Days = 30 ' минимальное число дней с момента модификации файлов
 
Dim FSO, Drive, RFolder, Path, oDrive
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each Drive In FSO.Drives
    If Drive.DriveType = 1 Then
        RFolder = FSO.BuildPath(Drive, RPath)
        If Not FSO.FolderExists(RFolder) Then Msg "Каталог " & RFolder & " отсутствует!", 4144
        Set Path = CreateObject("Shell.Application").BrowseForFolder(0,_
        vbCr & vbCr & "Выберите каталог-получатель:", 1, 17)
        If Not Path is Nothing Then Path = Path.Self.Path Else WSH.Quit
        Set oDrive = FSO.GetDrive(FSO.GetDriveName(Path))
        Copy RFolder : Msg "Операция выполнена!", 4160
    End If
Next
 
Sub Msg(Text, Num)
    MsgBox Text, Num, " Обновление каталога с флешки      " : WSH.Quit
End Sub
 
Sub Copy(Folder)
    Dim nPath, F, mDate, Size, nFile, oFile, nSize, nDate, Dir
    nPath = Path & Mid(Folder, Len(RFolder) + 2)
    If Not FSO.FolderExists(nPath) Then FSO.CreateFolder nPath
    For Each F In FSO.GetFolder(Folder).Files
        mDate = F.DateLastModified : nSize = 0 : nDate = ""
        If DateDiff("d", mDate, Now) > Days Then
            Size = F.Size : nFile = Path & Mid(F, Len(RFolder) + 2)
            If FSO.FileExists(nFile) Then Set oFile = FSO.GetFile(nFile) :_
            nSize = oFile.Size : nDate = oFile.DateLastModified
            If Size <> nSize Or mDate <> nDate Then
                If Size < nSize Then Size = nSize - Size Else Size = nSize
                If Min*1048576 > oDrive.AvailableSpace - Size Then _
                Msg "Недостаточно места на диске " & oDrive & " !" & vbCr & _
                    vbCr & "Операция прервана на файле:" & vbCr & F, 4144
                F.Copy nPath & "\", vbTrue
            End If
        End If
    Next
    For Each Dir In FSO.GetFolder(Folder).SubFolders : Copy Dir : Next
End Sub
1
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
13.11.2017, 16:20  [ТС] 7
В любом случае спасибо. Я ещё сам доделаю то, что задумал, и покажу, что вышло. А программы устаревшие, к сожалению, из того, что видел. Довелось повозиться со скрипом для выборки из БД и отображения в браузере. VBS эксплорером не поддерживается уже с винды 8.2, а в десятке и эксплорера нет. Пришлось на виртуалке делать.
0
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
13.11.2017, 16:33 8
Пож-та. Во второй строке описался. Не "к получателю", а "к источнику".
Explorer — это оболочка Windows. Как это нет? IE из 10-ки тоже не убирали.
Ограничение для IE пока ещё можно обойти (см. снизу).
0
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
15.11.2017, 00:55  [ТС] 9
Появилось время, немного покопался в своём скрипте. Из вашего скрипта использовал выбор пути к папке-получателю.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Set fso = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")
 
For each sDrive in fso.Drives
If  sDrive.DriveType = 1 and sDrive.IsReady Then
    Set tPath = CreateObject("Shell.Application").BrowseForFolder(0,_
        vbCr & vbCr & "Choose folder-recipient:", 1, 17)
        tPath = tPath.self.Path
    Set tFolder = fso.GetFolder(tPath)
    Set tDrive = fso.GetDrive(fso.GetDriveName(tPath))
    Set tAge = tFolder.DateLastModified
    If DateDiff("d", tAge, Now()) >30 Then
        drFree = (FormatNumber(tDrive.AvailableSpace/1024*1024, 0) - (FormatNumber(sDrive.TotalSize/1024*1024, 0) - FormatNumber(sDrive.AvailableSpace/1024*1024, 0)) - 250)
        If drFree > 0 Then
            CopyFiles tPath
        Else  WScript.Echo("Not enough place for copy")
        End If
    Else WScript.Echo("Destination folder was in use in last 30 days")
    End If
 
End if
Next
Процедуру копирования ещё дорабатываю, с перебором подпапок. Ну и туда же прикрутить отображение файлов с флешки и запись лога. Но на данном этапе возникла ошибка: требуется объект "DateLastModified". И ссылается на строку 11. Где ошибка в получении папки из пути копирования? Объявление переменных я не копировал, чтобы не загромождать страницу.
0
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
15.11.2017, 04:44 10
1. Выбор пути надо полностью использовать — с 14-й строкой, иначе при отмене будет ругань.
2. И правильно ссылается. Set уберите. Это же не объект.
3. Пересмотрите drFree. /1024*1024 - это бессмыслица (арифметика, 2 класс). Лучше как у меня 34-38 строках сделать. Вместо FormatNumber проще Fix/Int/Round использовать:
Visual Basic
1
2
3
4
5
6
Num = CreateObject("Scripting.FileSystemObject").GetDrive("C:\").AvailableSpace
MsgBox _
FormatNumber(Num/1048576, 0) & vbCr &_
Round(Num/1048576, 0) & vbCr &_
Fix(Num/1048576) & vbCr &_
Int(Num/1048576)
1
0 / 0 / 0
Регистрация: 07.03.2016
Сообщений: 39
16.11.2017, 00:29  [ТС] 11
Понял. Спасибо, буду дальше разбираться.

Добавлено через 16 часов 25 минут
Добил скрипт, вот что у меня в итоге получилось:

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
Dim sDrive, tDrive, tFolder, tPath, tAge, drFree, LogStream, sPath, Str
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set oShellApp = CreateObject("Shell.Application")
 
For each sDrive in fso.Drives
If  sDrive.DriveType = 1 and sDrive.IsReady Then
    Set tPath = CreateObject("Shell.Application").BrowseForFolder(0,_
        vbCr & vbCr & "Choose folder-recipient:", 1, 17)
        If Not tPath is Nothing Then Path = tPath.Self.Path Else WSH.Quit
        tPath = tPath.self.Path
    Set tFolder = fso.GetFolder(tPath)
    Set tDrive = fso.GetDrive(fso.GetDriveName(tPath))
    sPath = sDrive.Path
    tAge = tFolder.DateLastModified
    If DateDiff("d", tAge, Now()) >30 Then
        drFree = (FormatNumber(tDrive.AvailableSpace/1048576, 0) - (FormatNumber(sDrive.TotalSize/1048576, 0) - FormatNumber(sDrive.AvailableSpace/1048576, 0)) - 250)
        If drFree > 0 Then
            Set LogStream = fso.OpenTextFile(tPath & "\CopyLog.log", 8, True)
            LogStream.WriteLine "Copy begined: " & Now()
            CopyFiles sPath
            LogStream.WriteLine "Drive type: " & sDrive.DriveType
            LogStream.WriteLine "Drive label: " & sDrive.VolumeName
            LogStream.WriteLine "Copy completed: " & Now()
            LogStream.Close
            set logFile = fso.GetFile(tPath & "\CopyLog.log")
            logFile.Attributes = 2          
        Else  WScript.Echo("Not enough place for copy")
        End If
    Else WScript.Echo("Destination folder was in use in last 30 days")
    End If
WScript.Echo Str
WScript.Echo("Done!")
End if
Next
 
 
' процедура рекурсивно перебирает файлы в каталоге
Sub CopyFiles(FolderPath)
    On Error Resume Next
    Set oFolderItems = oShellApp.NameSpace(FolderPath).Items()
    For Each oFolderItem In oFolderItems
        If oFolderItem.IsFolder And LCase(Right(oFolderItem.Name, 4)) <> ".zip" Then
            CopyFiles oFolderItem.Path
        Else
            Set oFile = fso.GetFile(oFolderItem.Path)
            CopyFile oFolderItem.Path        
        End If
    Next
End Sub
' процедура копирует файл
Sub CopyFile(FilePath)
    On Error Resume Next
    SubPath = Mid(FilePath, Len(sPath) + 1)
    TargetPath = tPath & SubPath
    FolderPath = fso.GetParentFolderName(TargetPath)
    If Not fso.FolderExists(FolderPath) Then
        CreateFolder FolderPath
    End If
    ' если у файла назначения есть атрибут ReadOnly, снимаем его
    If fso.FileExists(TargetPath) Then
        Set oFile = fso.GetFile(TargetPath)
        If oFile.Attributes And 1 Then
            oFile.Attributes = oFile.Attributes - 1
        End If
    End If
    fso.CopyFile FilePath, TargetPath, True
    Str = Str & oFile & vbCrLf 
End Sub
' процедура создаёт каталог
Sub CreateFolder (FolderPath)
    On Error Resume Next
    ParentFolder = fso.GetParentFolderName(FolderPath)
    If Not fso.FolderExists(ParentFolder) Then
        CreateFolder ParentFolder
    End If
    fso.CreateFolder FolderPath
End Sub
Если у знакомой будет желание, то пусть попробует сама оптимизировать. Хотя если вдруг её преподаватель захочет что-то изменить, то видимо мне придётся. Так как вроде начал что-то понимать, а она даже не разбиралась.
0
6228 / 2670 / 1051
Регистрация: 06.06.2017
Сообщений: 9,128
16.11.2017, 12:27 12
Eugene_BY, пока не очень.
11 строка лишняя, в 10 достаточно добавить t перед Path.
Насчёт drFree как мимо ушей пропустили.
Неясно, зачем было разбивать всё на несколько процедур.
Я же короткий путь показал без всяких On Error Resume Next и ненужных проверок.
В 43 строке oFolderItem.Name на современных системах даёт не полное имя, а базовое. Поэтому это неверный способ получения расширения. К тому же в некоторых случаях IsFolder может давать True не только в отношении zip.
Куда проще перебирать через FSO.GetFolder().SubFolders.
46-47, 57-59, 63-65, 74-76 объединяются.
На 63 неверная запись. Должно быть так: If (oFile.Attributes And 1) = 1 Then
Логика процедуры создания каталога мне вообще неясна. Если идёт работа с родительским каталогом, зачем его пытаться создать?
0
16.11.2017, 12:27
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
16.11.2017, 12:27
Помогаю со студенческими работами здесь

Как синхронизировать папку из OneDrive с папкой на компьютере?
Подскажите, как синхронизировать папку из onedrive с папкой на компьютере.

Копирование в сетевую папку
доброго дня! Подскажите, как дописать, чтобы он авторизовался при копирование на сетевую папку ?...

Копирование файла в папку
Добрый день всем. Понимаю, что вопрос простенький, но сколько не искал в нете ответа, так и не...

Копирование изображения в папку
Здравствуйте! У меня такой вопрос: с помощью OpenDialog открыть изображение(точнее выбрать) и при...


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

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru