|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Arquivos/Diretórios)
|
|
 |
Título da Dica: Como interceptar mudanças em um diretório
|
 |
|
|
|
Postada em 8/9/2000 por Webmaster
webmaster@vbweb.com.br
Claro que apos a ocorrer a mudanca essa funcao nao vai retornar qual o arquivo modificado. O ideal (tem outro jeito?) é manter uma lista do status dos arquivos na pasta (e se for o caso, subpastas) em uma coleção ou array.
Depois de receber uma notificacao criar uma nova lista e comparar com a antiga pra descobrir o que mudou.
'Declaracoes:
Public Declare Function FindFirstChangeNotification Lib _
"kernel32" Alias "FindFirstChangeNotificationA" _
(ByVal lpPathName As String, ByVal bWatchSubtree _
As Long, ByVal dwNotifyFilter As Long) As Long
Public Declare Function FindCloseChangeNotification Lib _
"kernel32" (ByVal hChangeHandle As Long) As Long
Public Declare Function FindNextChangeNotification Lib _
"kernel32" (ByVal hChangeHandle As Long) As Long
Public Const FILE_NOTIFY_CHANGE_ATTRIBUTES As Long = &H4
Public Const FILE_NOTIFY_CHANGE_DIR_NAME As Long = &H2
Public Const FILE_NOTIFY_CHANGE_FILE_NAME As Long = &H1
Public Const FILE_NOTIFY_CHANGE_SECURITY As Long = &H100
Public Const FILE_NOTIFY_CHANGE_LAST_WRITE As Long = &H10
Public Const FILE_NOTIFY_CHANGE_SIZE As Long = &H8
Public Const WAIT_FAILED As Long = &HFFFFFFFF
Public Const WAIT_OBJECT_0 As Long = &H0
Public Const WAIT_ABANDONED As Long = &H80
Public Const WAIT_ABANDONED_0 As Long = &H80
Public Const WAIT_TIMEOUT As Long = &H102
Public Const WAIT_IO_COMPLETION As Long = &HC0
Public Declare Function WaitForSingleObject Lib _
"kernel32" (ByVal hHandle As Long, ByVal _
dwMilliseconds As Long) As Long
' Public Declare Function WaitForSingleObjectEx Lib _
' "kernel32" (ByVal hHandle As Long, ByVal _
' dwMilliseconds As Long, ByVal bAlertable As _
' Long) As Long
Public Declare Function GetShortPathName Lib _
"kernel32" Alias "GetShortPathNameA" (ByVal _
lpszLongPath As String, ByVal lpszShortPath _
As String, ByVal cchBuffer As Long) As Long
Public Const MAX_PATH As Long = 260
'Em um Form:
Option Explicit
Private hFind As Long
Private bParar As Boolean
' Dois command button com captions "Assistir" e "Parar"
' Uma caixa de texto txtDir para conter o Path a ser monitorado
' Uma listbox List1 para mostrar o que esta acontecendo :-)
Private Sub Command1_Click()
Dim hEvento As Long
Dim sPathParaApi As String * MAX_PATH
Dim sPathLongo As String
bParar = False
'
' Nao sei se a funcao FindFirstChangeNotification aceita
' diretórios longos entao estou convertendo antes de mandar
'
sPathParaApi = String(MAX_PATH, Chr(0))
sPathLongo = txtDir.Text
If GetShortPathName(sPathLongo,sPathParaApi,MAX_PATH) Then
If hFind <> 0 Then
Call FindCloseChangeNotification(hFind)
hFind = 0
End If
' Atenção nisso
' FindFirstChangeNotification(Path, _
' Deseja monitorar os subdiretorios?, _
' Tipo de monitoracao)
'
' Tipos possiveis
' FILE_NOTIFY_CHANGE_ATTRIBUTES - Notifica se houve
' mudança nos atributos
' FILE_NOTIFY_CHANGE_DIR_NAME - Notifica se houve
' mudança no nome dos
' diretorios
' FILE_NOTIFY_CHANGE_FILE_NAME - Mudança no nome dos arqs,
' criação ou exclusao
' FILE_NOTIFY_CHANGE_SECURITY - Mudança de permissão
' FILE_NOTIFY_CHANGE_LAST_WRITE - Mudança na data de ultima
' gravação
' FILE_NOTIFY_CHANGE_SIZE - Mudança de tamanho
'
' Combinacoes são possivel com OR
hFind = FindFirstChangeNotification(sPathParaApi, False, _
FILE_NOTIFY_CHANGE_FILE_NAME)
If hFind = 0 Then
MsgBox "Ops... Nao foi possivel inicializar", vbInformation, _
"Erro"
End If
Do
' Estou usando TimeOut pra dar tempo do usuario clicar
' em PARAR e poder sair desse Loop
' mas não é obrigatório....
' PS.: Lembre se q WaitForSingleObject irá travar o
' thread até acontecer alguma coisa :-)
hEvento = WaitForSingleObject(hFind, 200)
Select Case hEvento
Case WAIT_FAILED
List1.AddItem "WAIT_FAILED"
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
Case WAIT_ABANDONED
List1.AddItem "WAIT_ABANDONED"
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
Case WAIT_ABANDONED_0
List1.AddItem "WAIT_ABANDONED_0"
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
Case WAIT_OBJECT_0
List1.AddItem "WAIT_OBJECT_0"
'
' Essa é a notificacao que algo aconteceu....
'
' Executa ações
'
' blah blah blah....
'
Case WAIT_IO_COMPLETION
List1.AddItem "WAIT_IO_COMPLETION"
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
Case WAIT_TIMEOUT
DoEvents
If bParar Then
List1.AddItem "Stopped"
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
End If
If FindNextChangeNotification(hFind) = 0 Then
List1.AddItem "Problemas..."
Call FindCloseChangeNotification(hFind)
hFind = 0
Exit Do
End If
End Select
Loop
Else
MsgBox "Erro ao converter diretório.", vbInformation, _
"Erro"
End If
End Sub
Private Sub Command2_Click()
bParar = True
End Sub
Private Sub Form_Load()
' Setei um default, mas isso vc pode mudar
txtDir.Text = "C:\WINNT\Profiles\User\Desktop"
End Sub
|
|
|
|
|
