powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Синхронизация папок
9 сообщений из 9, страница 1 из 1
Синхронизация папок
    #33507317
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Имеется две папки с подкаталогами нужно определить изменилось ли что либо в папке 2 (добавились файлы, файлы обновились) и переписать все измененные(обновленные) файлы в папку 1.
Подскажите пожалуйста с чего начать и если не трудно пару строк кода.
...
Рейтинг: 0 / 0
Синхронизация папок
    #33507938
Вот пример. Если в папке "2" произошло изменение, копируем новые файлы в папку "1". Можешь расширить процедуру и сравнивать файлы; если изменится размер или дата/время будешь их заменять.

Код: plaintext
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.
Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
Private Const FILE_NOTIFY_CHANGE_DIR_NAME = &H2
Private Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1
Private Const FILE_NOTIFY_CHANGE_SIZE = &H8
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
Private Const FILE_NOTIFY_CHANGE_SECURITY = &H100
Private Const FILE_NOTIFY_CHANGE_ALL = &H4 Or &H2 _
  Or &H1 Or &H8 Or &H10 Or &H100
Private Const WAIT_OBJECT_0 = &H0

Private Declare Function FindFirstChangeNotification Lib "kernel32" _
  Alias "FindFirstChangeNotificationA" ( _
  ByVal lpPathName As String, _
  ByVal bWatchSubtree As Long, _
  ByVal dwNotifyFilter As Long) As Long

Private Declare Function FindNextChangeNotification Lib "kernel32" ( _
  ByVal hChangeHandle As Long) As Long

Private Declare Function FindCloseChangeNotification Lib "kernel32" ( _
  ByVal hChangeHandle As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" ( _
  ByVal hHandle As Long, _
  ByVal dwMilliseconds As Long) As Long

Sub CopyFiles( _
  strPath As String, _
  strTo As String)

    Dim hChange As Long
    Dim lngFlags As Long
    Dim lngStatus As Long
    Dim fso As New Scripting.FileSystemObject
    Dim fol As Scripting.Folder
    Dim fls As Scripting.Files
    Dim f As Scripting.File
    Dim dtmTime As Date
    
    lngFlags = FILE_NOTIFY_CHANGE_ALL
    
    hChange = FindFirstChangeNotification(strPath, _
       1 , lngFlags)
        
    If hChange >  0  Then
        Do
            DoEvents
            lngStatus = WaitForSingleObject(hChange, &HFFFF)
            If lngStatus = WAIT_OBJECT_0 Then
                Set fol = fso.GetFolder(strPath)
                Set fls = fol.Files
                For Each f In fls
                    If Not fso.FileExists(strTo & f.Name) Then
                        fso.CopyFile f.Path, strTo, False
                    End If
                Next f
                Call FindNextChangeNotification(hChange)
                dtmTime = Time()
            End If
        Loop While dtmTime < # 3 : 50 : 00  PM#
    End If
            
    Call FindCloseChangeNotification(hChange)
End Sub

Вызваешь так:

Код: plaintext
CopyFiles "D:\2\", "D:\1\"
...
Рейтинг: 0 / 0
Синхронизация папок
    #33508075
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Спасибо ща буду пробовать.
...
Рейтинг: 0 / 0
Синхронизация папок
    #33508564
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Скажите пожалуйста что делает эта строчка:
Loop While dtmTime < #3:50:00 PM#
что происходит в (до) 15:50
...
Рейтинг: 0 / 0
Синхронизация папок
    #33508792
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Че то все подвисает и ничего не происходит?
...
Рейтинг: 0 / 0
Синхронизация папок
    #33509142
Это частный пример работы функции установки уведомления об изменениях.

Программа будет выполняться до тех пор пока функция WaitForSingleObject не вернет результат и пока dtmTime < какого-то определенного времени.

WaitForSingleObject не возвращает результат до тех пор пока, не выполнится одно из двух действий.

- произойдет событие, связанное с дескриптором изменения.
- пройдет заданное вторым аргументом количество миллисекунд.

Приложение зависает потому, что блокируется основной поток приложения из-за того, что мы передали функции WaitForSingleObject в качестве второго аргумента значение #HFFFF (ожидать результат в течение неограниченного времени), тем самым наша процедура ожидает результат до тех пор пока не произойдет первое событие и все по причине того, что VB плохо работает с потоками. А как обойти это ограничение - это уже совершенно другой вопрос.

Чтобы я тебе посоветовал.

1. Изменить второй параметр функции WaitForSingleObject на, например, 1000 (висеть не будет, но будет притормаживать).
2. Воспользоваться контролом Waiter .

Вообщем прикладываю 2 проекта, посмотри.
...
Рейтинг: 0 / 0
Синхронизация папок
    #33510478
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Может у меня руки растут из жо, но опять ничего не получается. Пишет(прога) что синхронизирую папки, но синхронизация не происходит.
?
...
Рейтинг: 0 / 0
Синхронизация папок
    #33510638
Ты добавляешь/создаешь файлы в папке "2", но они не копируются в папку "1", так?

У себя проверял, все прекрасно работает.
...
Рейтинг: 0 / 0
Синхронизация папок
    #33510810
timtim
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да спасибо разобрался все работает это просто я накривил.
...
Рейтинг: 0 / 0
9 сообщений из 9, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Синхронизация папок
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]