• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Giám Sát Thư mục

Các thủ thuật về hệ thống, thư mục, tập tin và mạng
Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Giám Sát Thư mục

Gửi bàigửi bởi truongphu » T.Bảy 17/01/2009 2:59 pm

Thủ thuật: Giám Sát Thư mục
Tác giả: Bryan Stafford
Mô tả: Trong bộ Sưu tập thư mục đặc biệt đã có:

Khóa thư mục (Folder Guard XP)

Bảo vệ thư mục

Và bây giờ là Giám Sát Thư mục
Theo dõi tạo file hay folder và Xóa

Tập tin đính kèm
Watch_Directory_Demo.rar
(10.94 KiB) Đã tải 840 lần


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

ksnoob
Bài viết: 2
Ngày tham gia: T.Năm 23/12/2010 9:59 am

Re: Giám Sát Thư mục

Gửi bàigửi bởi ksnoob » T.Tư 05/01/2011 11:54 pm

Mã: Chọn hết

Option Explicit
 
  ' the directory we are watching
  Private m_sWatchedDir As String
 
  Private m_udtFT As FILETIME
 
  ' array to track files in the watched directory
  Private m_audtDirContents() As WIN32_FIND_DATA
 
  ' instance of the watch object
  Private WithEvents m_oWatchDir As cWatchForChanges

Private Sub m_oWatchDir_ChangeDetected(ByVal eChangeType As NOTIFY_CHANGE_TYPE)
  ' event fired from the watch object when a change is detected
 
 
  Dim sRet$, OutFT As FILETIME
 
  ' determine the type of change that occured....
  Select Case True
    Case (eChangeType And cwdName) > 0, (eChangeType And cwdDirName) > 0
      ' name change, we need to check the names in the dir against the
      ' info we cached when we started the watch
     
      sRet = FindFilesByName(m_sWatchedDir, eChangeType)
 
      ' reset the array since there was a name change....
      If LenB(sRet) Then
        FillFilesArray m_sWatchedDir
      Else
        If ((eChangeType And cwdSize) > 0) Or ((eChangeType And cwdLastWrite) > 0) Then
          sRet = FindFilesByTime(m_sWatchedDir, m_udtFT, OutFT, eChangeType)
        End If
       
        If LenB(sRet) = 0 Then
          sRet = ReturnChangeTypeString(eChangeType)
         
          If LenB(sRet) Then sRet = sRet & " changed but unable to detect changed file(s).  The change may have already been detected in the last notification."
        End If
      End If

 
    Case (eChangeType And cwdSize) > 0, (eChangeType And cwdLastWrite) > 0
      ' size or last write change, we only need to compare file times to see
      ' which file was changed.
      sRet = FindFilesByTime(m_sWatchedDir, m_udtFT, OutFT, eChangeType)
 
      If LenB(sRet) = 0 Then
        sRet = ReturnChangeTypeString(eChangeType)
       
        If LenB(sRet) Then sRet = sRet & " changed but unable to detect changed file(s).  The change may have already been detected in the last notification."
      End If
     
  End Select
 
 
 
  ' prepare the output string
  With txChanges
    .Text = .Text & "Change Logged At: " & Format$(Now, "hh:mm:ss") & vbNewLine
   
 
    If LenB(sRet) = 0 Then sRet = "Unable to finde changed file." & vbNewLine
   
    .Text = .Text & sRet & vbNewLine
   
    .SelStart = Len(.Text)
   
    Beep
  End With
 
  ' update the cached "lastwrite" time
  If CompareFileTime(OutFT, m_udtFT) = 1& Then m_udtFT = OutFT
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ' always make sure the watch object is destroyed before exiting
  Set m_oWatchDir = Nothing
 
  ' clean up the array
  Erase m_audtDirContents
End Sub

Private Sub cmdSelectDir_Click()
  ' select a directory tree to watch
  m_sWatchedDir = MSupport.GetFolder(hWnd, "Select A Directory To Watch.")
 
  If FileExists(m_sWatchedDir) Then
    lblWatchPath.Caption = MSupport.DrawPathEllipsis(m_sWatchedDir, lblWatchPath, Me)
  End If
 
End Sub

Private Sub cmdStartWatch_Click()

  If FileExists(m_sWatchedDir) Then
   
    ' get the baseline for the files in the dir
    Call FillFilesArray(m_sWatchedDir)
   
    ' get the current time so that we have something to compare files with later on
    GetSystemTimeAsFileTime m_udtFT
   
    ' create a new instance of the watch object
    Set m_oWatchDir = New cWatchForChanges
   
    If m_oWatchDir.StartWatch(m_sWatchedDir) Then
      cmdStartWatch.Enabled = False
      cmdStopWatch.Enabled = True
      cmdSelectDir.Enabled = False
    Else
      MsgBox "An error occured.  Unable to watch directory."
    End If
  Else
    MsgBox "Invalid watch directory."
  End If
 
End Sub

Private Sub cmdStopWatch_Click()

  m_oWatchDir.StopWatch
 
  Set m_oWatchDir = Nothing

  cmdStartWatch.Enabled = True
  cmdStopWatch.Enabled = False
  cmdSelectDir.Enabled = True

End Sub

Private Function FindFilesByName(ByVal sPath$, ByVal eChangeType As NOTIFY_CHANGE_TYPE) As String
  ' finds files with changed names by checking the file names against the cached
  ' values in the module level array

  Dim i&, hFileSearch&, sFileNames$, nUbound&, sChangeType$, bFound As Boolean
  Dim udtFindData As WIN32_FIND_DATA, anFoundIndexes() As Boolean
 
  sChangeType = ReturnChangeTypeString(eChangeType)
 
  ' fix up the path
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

  ' start the search for all files in the folder
  hFileSearch = FindFirstFile(sPath & "*.*", udtFindData)

  If hFileSearch <> INVALID_HANDLE_VALUE Then
   
    If LenB(m_audtDirContents(0).cFileName) Then
      nUbound = UBound(m_audtDirContents)
    Else
      nUbound = (-1)
    End If
   
    ReDim anFoundIndexes(nUbound) As Boolean
   
    Do
      ' reset the variable
      bFound = False
     
      With udtFindData
        .cFileName = StripNulls(.cFileName)
       
        For i = 0 To nUbound
          If LenB(.cFileName) = LenB(m_audtDirContents(i).cFileName) Then
            ' only compare the strings if the length is the same
            If .cFileName = m_audtDirContents(i).cFileName Then
              bFound = True
              anFoundIndexes(i) = True
              Exit For
            End If
          End If
        Next
     
        If bFound = False Then
          sFileNames = sFileNames & "Change Type: " & sChangeType & vbNewLine
         
          If .dwFileAttributes And vbDirectory Then
            sFileNames = sFileNames & "  " & sPath & Trim$(.cFileName) & "  [Dir]" & vbNewLine
          Else
            sFileNames = sFileNames & "  " & sPath & Trim$(.cFileName) & vbNewLine
          End If
        End If
      End With
           
      If FindNextFile(hFileSearch, udtFindData) = API_FALSE Then
        ' if we get ERROR_NO_MORE_FILES close the search and jump out of the loop
        If Err.LastDllError = ERROR_NO_MORE_FILES Then
          Call FindClose(hFileSearch)
          Exit Do
        End If
      End If
    Loop
   
    For i = 0 To nUbound
      If anFoundIndexes(i) = False Then
        With m_audtDirContents(i)
          sFileNames = sFileNames & "Change Type: " & sChangeType & vbNewLine
         
          If .dwFileAttributes And vbDirectory Then
            sFileNames = sFileNames & "  " & sPath & Trim$(.cFileName) & "  [Deleted]" & " [Dir]" & vbNewLine
          Else
            sFileNames = sFileNames & "  " & sPath & Trim$(.cFileName) & "  [Deleted]" & vbNewLine
          End If
        End With
      End If
    Next
   
    FindFilesByName = sFileNames
   
  End If
 
End Function

Private Function FindFilesByTime(ByVal sPath$, InFT As FILETIME, OutFT As FILETIME, ByVal eChangeType As NOTIFY_CHANGE_TYPE) As String
  ' finds files by comparing the last write time with the cached value

  Dim udtFindData As WIN32_FIND_DATA, hFileSearch&, sFileNames$, sChangeType$
 
  sChangeType = ReturnChangeTypeString(eChangeType)
 
     
  ' fix up the path
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

  ' start the search for all files in the folder
  hFileSearch = FindFirstFile(sPath & "*.*", udtFindData)

  If hFileSearch <> INVALID_HANDLE_VALUE Then
    '
    Do
      With udtFindData
        If CompareFileTime(.ftLastWriteTime, InFT) = 1& Then
          sFileNames = sFileNames & "Change Type: " & sChangeType & vbNewLine
         
          sFileNames = sFileNames & "  " & sPath & StripNulls(.cFileName) & vbNewLine
         
          If CompareFileTime(.ftLastWriteTime, OutFT) = 1& Then
            OutFT.dwHighDateTime = .ftLastWriteTime.dwHighDateTime
            OutFT.dwLowDateTime = .ftLastWriteTime.dwLowDateTime
          End If
        ElseIf CompareFileTime(.ftCreationTime, InFT) = 1& Then
          sFileNames = sFileNames & "Change Type: " & sChangeType & vbNewLine
         
          sFileNames = sFileNames & "  " & sPath & StripNulls(.cFileName) & vbNewLine

          If CompareFileTime(.ftCreationTime, OutFT) = 1& Then
            OutFT.dwHighDateTime = .ftCreationTime.dwHighDateTime
            OutFT.dwLowDateTime = .ftCreationTime.dwLowDateTime
          End If
        End If
      End With
           
      If FindNextFile(hFileSearch, udtFindData) = API_FALSE Then
        ' if we get ERROR_NO_MORE_FILES close the search and jump out of the loop
        If Err.LastDllError = ERROR_NO_MORE_FILES Then
          Call FindClose(hFileSearch)
          Exit Do
        End If
      End If
    Loop
   
    FindFilesByTime = sFileNames
   
  End If
 
End Function

Private Sub FillFilesArray(ByVal sPath$) 'As FILETIME
  ' fills the module level array that caches all of the info on each file in the dir
 
  Dim i&, nUbound&, hFileSearch&, sFileNames$
  Dim udtFindData As WIN32_FIND_DATA
 
  Erase m_audtDirContents
 
  nUbound = 100
 
  ReDim m_audtDirContents(nUbound) As WIN32_FIND_DATA
 
  ' fix up the path
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"

  ' start the search for all files in the folder
  hFileSearch = FindFirstFile(sPath & "*.*", udtFindData)

  If hFileSearch <> INVALID_HANDLE_VALUE Then
    '
    Do
      If i > nUbound Then
        nUbound = nUbound + 100
       
        ReDim Preserve m_audtDirContents(nUbound) As WIN32_FIND_DATA
      End If
     
      With udtFindData
        .cFileName = StripNulls(.cFileName)
      End With
     
      ' save the struct to the array
      m_audtDirContents(i) = udtFindData
           
      If FindNextFile(hFileSearch, udtFindData) = API_FALSE Then
        ' if we get ERROR_NO_MORE_FILES close the search and jump out of the loop
        If Err.LastDllError = ERROR_NO_MORE_FILES Then
          Call FindClose(hFileSearch)
          Exit Do
        End If
      End If
     
      i = i + 1
    Loop
  End If
 
  ReDim Preserve m_audtDirContents(i) As WIN32_FIND_DATA
 
End Sub

Private Function ReturnChangeTypeString(ByVal eChangeType As NOTIFY_CHANGE_TYPE) As String

  If (eChangeType And cwdName) > 0 Then ReturnChangeTypeString = "Name"
 
  If (eChangeType And cwdSize) > 0 Then
    If LenB(ReturnChangeTypeString) Then
      ReturnChangeTypeString = ReturnChangeTypeString & " & Size"
    Else
      ReturnChangeTypeString = "Size"
    End If
  End If
 
  If (eChangeType And cwdLastWrite) > 0 Then
    If LenB(ReturnChangeTypeString) Then
      ReturnChangeTypeString = ReturnChangeTypeString & " & Last Write"
    Else
      ReturnChangeTypeString = "Last Write"
    End If
  End If
 
  If (eChangeType And cwdDirName) > 0 Then
    If LenB(ReturnChangeTypeString) Then
      ReturnChangeTypeString = ReturnChangeTypeString & " & Dir Name"
    Else
      ReturnChangeTypeString = "Dir Name"
    End If
  End If
   
End Function

chạy báo lỗi chổ này pác ơi
Private m_audtDirContents() As WIN32_FIND_DATA
Bài này giờ em muốn khi mà mình thao tác trên file trong thư mục giám sát ( sửa, xóa copy ..) nó lưu thông tin trong registry được không pác ? pác giúp em cái ?

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Giám Sát Thư mục

Gửi bàigửi bởi truongphu » T.Năm 06/01/2011 5:43 am

ksnoob đã viết:chạy báo lỗi chổ này pác ơi
Private m_audtDirContents() As WIN32_FIND_DATA


WIN32_FIND_DATA được khai báo trong module, sao lại báo lỗi?
thôi nha, đừng ngớ như thế, code form không đủ

[mod=]Xin đừng hỏi ngoài đề tài ở Box nầy[/mod]
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

Hình đại diện của người dùng
lanlan
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 310
Ngày tham gia: T.Năm 05/06/2008 8:49 am
Been thanked: 1 time

Re: Giám Sát Thư mục

Gửi bàigửi bởi lanlan » T.Hai 19/09/2011 12:36 pm

bác ơi nếu muốn biết user nào thay đổi nữa thì làm thế nào nhỉ và lại có áp dụng được trong thư mục share không ?
cháu cảm ơn bác rất nhiều

thanhbinhit
Thành viên năng nổ
Thành viên năng nổ
Bài viết: 53
Ngày tham gia: T.Sáu 22/05/2009 6:06 pm
Has thanked: 1 time
Been thanked: 5 time

Re: Giám Sát Thư mục

Gửi bàigửi bởi thanhbinhit » T.Hai 19/09/2011 4:17 pm

Nếu đoán không nhầm để biết user nào copy, cut, delete phải tìm cách đọc file .evt trong windows\system32\config. Tìm hiểu thêm về cái này http://www.microsoft.com/downloads/details.aspx?FamilyID=890cd06b-abf8-4c25-91b2-f8d975cf8c07&displaylang=en

Hình đại diện của người dùng
lanlan
Thành viên tâm huyết
Thành viên tâm huyết
Bài viết: 310
Ngày tham gia: T.Năm 05/06/2008 8:49 am
Been thanked: 1 time

Re: Giám Sát Thư mục

Gửi bàigửi bởi lanlan » T.Ba 20/09/2011 8:16 am

có ai có giải pháp cụ thể hơn không nhỉ giup em vớ [-O< i

Hình đại diện của người dùng
truongphu
VIP
VIP
Bài viết: 4756
Ngày tham gia: CN 04/11/2007 10:57 am
Đến từ: Cam Đức, Khánh hòa
Has thanked: 14 time
Been thanked: 509 time

Re: Giám Sát Thư mục

Gửi bàigửi bởi truongphu » T.Ba 20/09/2011 11:27 am

lanlan đã viết:nếu muốn biết user nào thay đổi nữa thì làm thế nào nhỉ và lại có áp dụng được trong thư mục share không ?


câu hỏi nầy thuộc quyền quản trị máy tính
phần mềm nếu không đăng nhập tư cách admin khó chạy được
và để biết các thông tin nầy
bạn phải quen ngôn ngữ WMI, đại loại cũng như vbsript
địa chỉ quen thuộc trên máy tính là winmgmts:\root\cimv2
từ kiếm là InstanceOperationEvent, hay InstanceDeletionEvent..., user name...

WMI sẽ thao tác với eventlog trong mỗi máy và cung cấp thông tin theo điều kiện đưa vào.

code WMI, có thể sửa lại thành code vb6
bạn lan cố thử gun-gồ
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

thanhvu06vl
Thành viên chính thức
Thành viên chính thức
Bài viết: 47
Ngày tham gia: T.Ba 08/04/2008 12:41 pm

Re: Giám Sát Thư mục

Gửi bàigửi bởi thanhvu06vl » T.Năm 28/03/2013 5:39 am

Hiện tại thì chương trình chỉ nhận biết được thư mục gốc . Nay mình muốn khi người sử dụng nhập vào thư mục con , nhưng phần mềm giám sát thư mục nó chỉ báo là có thay đổi thư mục gốc không ( nó có ghi nhận sự thay đổi từ thư mục gốc ). Thực tế từ thư mục gốc có rất nhiều thư mục con , mình muốn thay đổi nhiều thư mục con khác , và nó hiện lên đường dẫn từ thư mục gốc đến các thư mục con. Nếu được xin mời anh chỉ giúp. Xin cảm ơn


Quay về “[VB] Hệ thống - Tập tin - Thư mục và Mạng”

Đang trực tuyến

Đang xem chuyên mục này: Không có thành viên nào trực tuyến.2 khách