Папки и файлы

[Юджин]

Ситуация такая. В папке А появляются и пропадают файлы. надо отслеживать появление новых файлов, копировать новые в папку В, если в папке В эти файлы отсутствуют. ясно, что на код не надеюсь, но как это сделать? пробовал делать так:

Код: Выделить всё

s = Dir1("\\Public\material\2006\" + ShPath + "\" + "*.*")
If s = "" Then Exit Sub
Do
    If s <> "." And s <> ".." And s <> "" Then
        n_doc1 = n_doc1 + 1
        ReDim Preserve doc_FList(n_doc1)
        doc_FList(n_doc1) = s
        f = Dir("E:\priem\Hold Files 2.0\temp\*.*")
If f <> s Then
SourceFile = "\\Public\material\2006\" + ShPath + "\" + s
DestinationFile = "E:\priem\Hold Files 2.0\temp\" + s
FileCopy SourceFile, DestinationFile
List1.AddItem f
        End If
        f = Dir
        End If
    s = Dir1
Loop Until (s = "")


но два раза dir, конечно, не прокатило...

[marvan]

Надо использовать FindNextChangeNotification
В API-Guide есть пример, а в книжке у Б. Мак-Кинни по этому поводу целая статья с исходником.

[Antonariy]

Брось на форму ListBox, пару кнопок и текст:

Код: Выделить всё

Option Explicit

Const INFINITE As Long = &HFFFFFFFF
Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1
Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8
Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10
Const FILE_NOTIFY_CHANGE_LAST_ACCESS As Long = &H20
Const FILE_NOTIFY_CHANGE_CREATION As Long = &H40
Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100
Const FILE_NOTIFY_FLAGS = FILE_NOTIFY_CHANGE_ATTRIBUTES Or _
                                 FILE_NOTIFY_CHANGE_FILE_NAME Or _
                                 FILE_NOTIFY_CHANGE_LAST_WRITE

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 FindCloseChangeNotification Lib "kernel32" _
   (ByVal hChangeHandle As Long) As Long

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

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

Const WAIT_OBJECT_0 As Long = &H0
Const WAIT_ABANDONED As Long = &H80
Const WAIT_IO_COMPLETION As Long = &HC0
Const WAIT_TIMEOUT As Long = &H102
Const STATUS_PENDING As Long = &H103

Dim hChangeHandle As Long
Dim hWatched As Long
Dim terminateFlag As Long

Private Sub cmdBegin_Click()
Dim r As Long
Dim watchPath As String
Dim watchStatus As Long
   
   watchPath = "c:\" 'это папка, которую надо отслеживать
   terminateFlag = False
   Command1.Enabled = False
   WatchChangeAction watchPath
   MsgBox "Beginning watching of folder " & watchPath & " .. press OK"
   hWatched = WatchCreate(watchPath, FILE_NOTIFY_FLAGS)
   watchStatus = WatchDirectory(hWatched, 100)
   If watchStatus = 0 Then
       WatchChangeAction watchPath
       MsgBox "The watched directory has been changed.  Resuming watch..."
       Do
         watchStatus = WatchResume(hWatched, 100)
         If watchStatus = -1 Then
               MsgBox "Watching has been terminated for " & watchPath
         Else: WatchChangeAction watchPath
               MsgBox "The watched directory has been changed again."
         End If
       Loop While watchStatus = 0
   Else
      MsgBox "Watching has been terminated for " & watchPath
   End If
End Sub

Private Sub cmdStop_Click()
   Call WatchDelete(hWatched)
   hWatched = 0
   cmdBegin.Enabled = True
End Sub

Private Function WatchCreate(lpPathName As String, flags As Long) As Long
   WatchCreate = FindFirstChangeNotification(lpPathName, False, flags)
End Function

Private Sub WatchDelete(hWatched As Long)
   terminateFlag = True
   DoEvents
   Call FindCloseChangeNotification(hWatched)
End Sub

Private Function WatchDirectory(hWatched As Long, interval As Long) As Long
   Dim r As Long
   Do
      r = WaitForSingleObject(hWatched, interval)
      DoEvents
   Loop While r <> 0 And terminateFlag = False
   WatchDirectory = r
End Function

Private Function WatchResume(hWatched As Long, interval) As Boolean
   Dim r As Long
   r = FindNextChangeNotification(hWatched)
   Do
      r = WaitForSingleObject(hWatched, interval)
      DoEvents
   Loop While r <> 0 And terminateFlag = False
   WatchResume = r
End Function

Private Sub WatchChangeAction(fPath As String)
   Dim fName As String
   List1.Clear
   fName = Dir(fPath & "\" & "*.txt")
   If fName > "" Then
      List1.AddItem "path: " & vbTab & fPath
      List1.AddItem "file: " & vbTab & fName
      List1.AddItem "size: " & vbTab & FileLen(fPath & "\" & fName)
      List1.AddItem "attr: " & vbTab & GetAttr(fPath & "\" & fName)
   End If
End Sub