说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

请问怎样监视目录的变化

编辑:说三道四文库 发布时间:2017-12-14 01:16
HTML文档下载 WORD文档下载 PDF文档下载
请问怎样监视目录的变化
就是增加和删除目录能监视的到,
比如我 监视c:\111
那么c:\111里增加222的目录和333的目录,我能马上知道并放映到text1.text或list里
list里时时列出c:\111\的目录一增加c:\111\222
list里就多一个222
删掉222
list里就少个222
需要源代码
能用的立即加分

用timer控件
http://www.21code.com/codebase/?pos=down&id=273
http://www.21code.com/codebase/?pos=down&id=274
看看这两个程序
我有相关的源码,要的就留下EMail.
源码如下:
mDef.Bas
-------------
Option Explicit

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, _
        pSource As Any, ByVal dwLength As Long)
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public Const MAX_PATH = 260
Public Const NOERROR = 0

'SHGetSpecialFolderLocation获得某一个特殊的目录的位置,如果函数调用成功返回NOERROR
'或者一个OLE错误
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
                              (ByVal hwndOwner As Long, _
                              ByVal nFolder As SHSpecialFolderIDs, _
                              pidl As Long) As Long

Public Enum SHSpecialFolderIDs      '列出所有Windows下特殊文件夹的ID
    CSIDL_DESKTOP = &H0
    CSIDL_INTERNET = &H1
    CSIDL_PROGRAMS = &H2
    CSIDL_CONTROLS = &H3
    CSIDL_PRINTERS = &H4
    CSIDL_PERSONAL = &H5
    CSIDL_FAVORITES = &H6
    CSIDL_STARTUP = &H7
    CSIDL_RECENT = &H8
    CSIDL_SENDTO = &H9
    CSIDL_BITBUCKET = &HA
    CSIDL_STARTMENU = &HB
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_DRIVES = &H11
    CSIDL_NETWORK = &H12
    CSIDL_NETHOOD = &H13
    CSIDL_FONTS = &H14
    CSIDL_TEMPLATES = &H15
    CSIDL_COMMON_STARTMENU = &H16
    CSIDL_COMMON_PROGRAMS = &H17
    CSIDL_COMMON_STARTUP = &H18
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    CSIDL_APPDATA = &H1A
    CSIDL_PRINTHOOD = &H1B
    CSIDL_ALTSTARTUP = &H1D
    CSIDL_COMMON_ALTSTARTUP = &H1E
    CSIDL_COMMON_FAVORITES = &H1F
    CSIDL_INTERNET_CACHE = &H20
    CSIDL_COOKIES = &H21
    CSIDL_HISTORY = &H22
End Enum

'SHGetPathFromIDList函数将一个Item转换为文件路径
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
                              (ByVal pidl As Long, _
                              ByVal pszPath As String) As Long

'SHGetFileInfoPidl函数获得某个文件对象的信息。
Declare Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pidl As Long, _
                              ByVal dwFileAttributes As Long, _
                              psfib As SHFILEINFOBYTE, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFOBYTE
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName(1 To MAX_PATH) As Byte
    szTypeName(1 To 80) As Byte
End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
                              (ByVal pszPath As String, _
                              ByVal dwFileAttributes As Long, _
                              psfi As SHFILEINFO, _
                              ByVal cbFileInfo As Long, _
                              ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Enum SHGFI_flags
    SHGFI_LARGEICON = &H0
    SHGFI_SMALLICON = &H1
    SHGFI_OPENICON = &H2
    SHGFI_SHELLICONSIZE = &H4
    SHGFI_PIDL = &H8
    SHGFI_USEFILEATTRIBUTES = &H10
    SHGFI_ICON = &H100
    SHGFI_DISPLAYNAME = &H200
    SHGFI_TYPENAME = &H400
    SHGFI_ATTRIBUTES = &H800
    SHGFI_ICONLOCATION = &H1000
    SHGFI_EXETYPE = &H2000
    SHGFI_SYSICONINDEX = &H4000
    SHGFI_LINKOVERLAY = &H8000
    SHGFI_SELECTED = &H10000
End Enum

'根据一个特定文件夹对象的ID获得它的目录pidl
Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long
    Dim pidl As Long
    If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then
        GetPIDLFromFolderID = pidl
    End If
End Function

'这里是根据Pidl获得文件的名称

Public Function GetDisplayNameFromPIDL(pidl As Long) As String
    Dim sfib As SHFILEINFOBYTE
    If SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), SHGFI_PIDL Or SHGFI_DISPLAYNAME) Then
        GetDisplayNameFromPIDL = GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode))
    End If
End Function

'这里是根据Pidl获得文件的路径及名称

Public Function GetPathFromPIDL(pidl As Long) As String
    Dim sPath As String * MAX_PATH
    If SHGetPathFromIDList(pidl, sPath) Then
        GetPathFromPIDL = GetStrFromBufferA(sPath)
    End If
End Function

Public Function GetStrFromBufferA(sz As String) As String
    If InStr(sz, vbNullChar) Then
        GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    Else
        GetStrFromBufferA = sz
    End If
End Function
续上:

Shell1.Bas
------------------------
Option Explicit

Private m_hSHNotify As Long     '系统消息通告句柄
Private m_pidlDesktop As Long

'定义系统通告的消息值
Public Const WM_SHNOTIFY = &H401

Public Type PIDLSTRUCT
    pidl As Long
    bWatchSubFolders As Long
End Type

Declare Function SHChangeNotifyRegister Lib "shell32" Alias "#2" _
                              (ByVal hWnd As Long, _
                              ByVal uFlags As SHCN_ItemFlags, _
                              ByVal dwEventID As SHCN_EventIDs, _
                              ByVal uMsg As Long, _
                              ByVal cItems As Long, _
                              lpps As PIDLSTRUCT) As Long

Type SHNOTIFYSTRUCT
    dwItem1 As Long
    dwItem2 As Long
End Type

Declare Function SHChangeNotifyDeregister Lib "shell32" Alias "#4" _
        (ByVal hNotify As Long) As Boolean

Declare Sub SHChangeNotify Lib "shell32" _
                        (ByVal wEventId As SHCN_EventIDs, _
                        ByVal uFlags As SHCN_ItemFlags, _
                        ByVal dwItem1 As Long, _
                        ByVal dwItem2 As Long)

Public Enum SHCN_EventIDs
    SHCNE_RENAMEITEM = &H1
    SHCNE_CREATE = &H2
    SHCNE_DELETE = &H4
    SHCNE_MKDIR = &H8
    SHCNE_RMDIR = &H10
    SHCNE_MEDIAINSERTED = &H20
    SHCNE_MEDIAREMOVED = &H40
    SHCNE_DRIVEREMOVED = &H80
    SHCNE_DRIVEADD = &H100
    SHCNE_NETSHARE = &H200
    SHCNE_NETUNSHARE = &H400
    SHCNE_ATTRIBUTES = &H800
    SHCNE_UPDATEDIR = &H1000
    SHCNE_UPDATEITEM = &H2000
    SHCNE_SERVERDISCONNECT = &H4000
    SHCNE_UPDATEIMAGE = &H8000&
    SHCNE_DRIVEADDGUI = &H10000
    SHCNE_RENAMEFOLDER = &H20000
    SHCNE_FREESPACE = &H40000
    SHCNE_ASSOCCHANGED = &H8000000

    SHCNE_DISKEVENTS = &H2381F
    SHCNE_GLOBALEVENTS = &HC0581E0
    SHCNE_ALLEVENTS = &H7FFFFFFF
    SHCNE_INTERRUPT = &H80000000
End Enum

#If (WIN32_IE >= &H400) Then
    Public Const SHCNEE_ORDERCHANGED = &H2
#End If

Public Enum SHCN_ItemFlags
    SHCNF_IDLIST = &H0
    SHCNF_PATHA = &H1
    SHCNF_PRINTERA = &H2
    SHCNF_DWORD = &H3
    SHCNF_PATHW = &H5
    SHCNF_PRINTERW = &H6
    SHCNF_TYPE = &HFF
    SHCNF_FLUSH = &H1000
    SHCNF_FLUSHNOWAIT = &H2000

    #If UNICODE Then
        SHCNF_PATH = SHCNF_PATHW
        SHCNF_PRINTER = SHCNF_PRINTERW
    #Else
        SHCNF_PATH = SHCNF_PATHA
        SHCNF_PRINTER = SHCNF_PRINTERA
    #End If
End Enum

Public Function SHNotify_Register(hWnd As Long) As Boolean
    Dim ps As PIDLSTRUCT
  
    If (m_hSHNotify = 0) Then
  
        m_pidlDesktop = GetPIDLFromFolderID(0, CSIDL_DESKTOP)
        If m_pidlDesktop Then
      
            ps.pidl = m_pidlDesktop
            ps.bWatchSubFolders = True
      
            '注册Windows监视,将获得的句柄保存到m_hSHNotify中
            m_hSHNotify = SHChangeNotifyRegister(hWnd, SHCNF_TYPE Or SHCNF_IDLIST, _
                                            SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, _
                                            WM_SHNOTIFY, 1, ps)
            SHNotify_Register = CBool(m_hSHNotify)
    
        Else
            Call CoTaskMemFree(m_pidlDesktop)
        End If
    End If
End Function

Public Function SHNotify_Unregister() As Boolean
    If m_hSHNotify Then
        If SHChangeNotifyDeregister(m_hSHNotify) Then
            m_hSHNotify = 0
            Call CoTaskMemFree(m_pidlDesktop)
            m_pidlDesktop = 0
            SHNotify_Unregister = True
        End If
    End If
End Function

Public Function SHNotify_GetEventStr(strPath1, strPath2 As String, dwEventID As Long) As String
    Dim sEvent As String
    
    Select Case dwEventID
        Case SHCNE_RENAMEITEM: sEvent = "重命名文件" + strPath1 + "为" + strPath2
        Case SHCNE_CREATE: sEvent = "建立文件 文件名:" + strPath1
        Case SHCNE_DELETE: sEvent = "删除文件 文件名:" + strPath1: Form1.Text2.Text = sEvent
        Case SHCNE_MKDIR: sEvent = "新建目录 目录名:" + strPath1
        Case SHCNE_RMDIR: sEvent = "删除目录 目录名:" + strPath1
        Case SHCNE_MEDIAINSERTED: sEvent = strPath1 + "中插入可移动存储介质"
        Case SHCNE_MEDIAREMOVED: sEvent = strPath1 + "中移去可移动存储介质"
        Case SHCNE_DRIVEREMOVED: sEvent = "移去驱动器" + strPath1
        Case SHCNE_DRIVEADD: sEvent = "添加驱动器" + strPath1
        Case SHCNE_NETSHARE: sEvent = "改变目录" + strPath1 + "的共享属性"
        Case SHCNE_UPDATEDIR: sEvent = "更新目录" + strPath1
        Case SHCNE_UPDATEITEM: sEvent = "更新文件 文件名:" + strPath1
        Case SHCNE_SERVERDISCONNECT: sEvent = "断开与服务器的连" + strPath1 + "  " + strPath2
        Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE"
        Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI"
        Case SHCNE_RENAMEFOLDER: sEvent = "重命名文件夹" + strPath1 + "为" + strPath2
        Case SHCNE_FREESPACE: sEvent = "磁盘空间大小改变"
    
        Case SHCNE_ASSOCCHANGED: sEvent = "改变文件关联"
    End Select
  
    SHNotify_GetEventStr = sEvent
End Function
-----------
mSub.Bas
------------------------
Option Explicit

Private Const WM_NCDESTROY = &H82
Private Const GWL_WNDPROC = (-4)
Private Const OLDWNDPROC = "OldWndProc"

Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal _
        hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal _
        hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal _
        hWnd As Long, ByVal lpString As String) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
        (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long

Public Function SubClass(hWnd As Long) As Boolean
    Dim lpfnOld As Long
    Dim fSuccess As Boolean
  
    If (GetProp(hWnd, OLDWNDPROC) = 0) Then
        lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
        If lpfnOld Then
            fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
        End If
    End If
  
    If fSuccess Then
        SubClass = True
    Else
        If lpfnOld Then Call UnSubClass(hWnd)
        MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical
    End If
End Function

Public Function UnSubClass(hWnd As Long) As Boolean
    Dim lpfnOld As Long
  
    lpfnOld = GetProp(hWnd, OLDWNDPROC)
    If lpfnOld Then
        If RemoveProp(hWnd, OLDWNDPROC) Then
            UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
        End If
    End If
End Function

Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As _
        Long, ByVal lParam As Long) As Long
    Select Case uMsg
        Case WM_SHNOTIFY        '处理系统消息通告函数
            Call Form1.NotificationReceipt(wParam, lParam)
        Case WM_NCDESTROY
            Call UnSubClass(hWnd)
            MsgBox "Unubclassed &H" & Hex(hWnd), vbCritical, "WndProc Error"
    End Select
    
    WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
End Function
上面这段代码我有,它的功能太强了,我用不到,其实我只要一段很简单的程序就ok了,不过也谢谢了
我的mail是admint@163.com
如果合用,我会加分的
Private Sub Timer1_Timer()
    Dim tStr As String
    Dim tDir As String
    tDir = Dir("c:\111\*.*", vbDirectory)
    Do While tDir <> ""
        If tDir <> "" Then
            tStr = tStr & vbCrLf & tDir
        End If
        tDir = Dir
    Loop
    If Me.Text1 <> tStr Then Me.Text1 = tStr
End Sub

找的时候会找到“.”和“..”,这两个是当前目录和上级目录的意思
如果没有用可以用代码屏蔽掉
顺便说一下,这个目录要是有很多子目录这个方法有点太慢了。
我试试,谢谢
如果能用,我就给分
目录数不会多于60
360发布企业版4.0 可自定义软件白名单 不要总是依赖机器 MongoDB扩展彰显分片功夫 Dell与HP的OpenStack的战略:渠道对抗SLA 路况电台王雷:未来车载系统会是Android的天下 移动周报:2012移动开发工具系列盘点 谷歌不愿错失机会 Android或不再成它人独享 黑客文化:Facebook公布2012年Hackathon大赛顶级“黑客作品” 中国移动音乐开放平台正式对外开放 GitLab 4.0发布 更好地支持PostgreSQL 傻瓜式移动应用开发平台:专访摩讯创始人赵健 日本DeNA进军中国智能电视,与海信战略合作 扎克伯格不仅为Poke编码,而且还“献声” Wordament:首款支持Xbox Live成就的iPhone游戏 使用Storm实现实时大数据分析! 孙博凯:微软日益开放,Windows Azure更加拥抱开源 大数据计算:如何仅用1.5KB内存计算十亿个不同的对象 我们为什么爱EC2和S3却彻底抛弃EBS 不畏Surface:诺基亚明年或推Windows平板 Linus Torvalds:用户程序被破坏永远是Kernel的问题! Python高效编程技巧 苹果加速硬件迭代 iPad5原型机曝光 宏碁推99美金平板 价格创历史新低 黑莓10全键盘版代号N系列,谍照泄露! 那些年我们用过的互联网产品 QQ亿级业务演变:从文件、音视频说起 少年企鹅的成长之旅:QQ体验设计发展史 全球超算Top 500:Linux已占93.8%,Windows或将消失 AWS东部地区再次发生宕机 Netflix等网站受影响 2012年全球最美的十个数据中心 CodeCards:程序员电子贺卡DIY项目 微软首席战略官Craig Mundie将于2014年退休 我可以把ACCESS数据库的表导出到SQL SERVER中吗? 图片存在目录与存在数据库各有什么优缺点呢? 点击这个框架中的网页能够打印另一个框架中的内容吗 求救~!!!! 请问如何将台式机硬盘上的内容copy到笔记本的硬盘上?? ADO数据集的服务器游标的使用问题 为什么我在发布Delphi程序时总出现Error1324错误 快来救救我的硬盘呀 mydatastore.update() 返回 -1 如何知道出什么错? 如何获得当前光标所在程序的edit框的handle? [ 请教 ] 关于FREE风格的数据窗口的显示问题! 这个存储过程怎么写呀? 如何添加新函数?急!急!急! 我在网上把一副图片设为背景,我不知道他的文件名,我现在想把它找出来,请问如何办到。在右键-属性-背景中他的名称是“Internet Explo 请高手指点。 vb函数使用的问题 简单两台机对连问题 做斑竹、做会员就可以领工资(RMB)! jsp中session跨war包调用问题 PB画图问题 请各位搞WEB挖掘的朋友都留个联系方式 如何指定 记录集的游标类型,大侠请进,小弟急用(内附代码)!!! 请投上一票! mssql一个很奇怪的问题,如何解决啊!“键列信息不足或不正确,更新影响到多行” 天杀的3721,大家进来共同讨伐这有史以来最恶心的XXX,进来都有分 c写的cgi怎么获得表单中某个下拉菜单的value和text.在线等 哪有VC的SP5下载? 要实现这样的功能,SQL该如何写(急,在线等待)? 哪里可以找到string.format的格式说明啊? 【无限祝福】:璇玑、大力相知相伴 查找数据库的问题。。。。。 在asp.net中怎么调用第二个窗体呀???请教大家帮我。thanks ,中秋快乐 Jsp保存时出错 Response.Write rs("ans")中間的rs 能否在FTP站点里上传文件夹? 教师节快乐!发了2000多,不够塞牙缝! 一个菜鸟问关于公共对话框组件的问题 大家快来给找错误呀!!!高分回报!!! 用c如何调用java程序? 导入导出问题? 遇到一个问题:Domino数据库的最大尺寸是如何定义的? 各高手~!!!XP变成了哑吧?? XML文件中如何存放image(二进制)(SQL Server 2000)类型的数据, 如何在C++中使用Switch中的条件来选择某个控件?? ASP的问题。帮帮偶吧。 硬盘安装mandrake9.1,进入图形界面出问题。 ??报表 关于自考的几点疑问 在xxx.aspx.cs文件里面如何实现向客户端写文件下载? 人件里面的家具警察是指什么人啊? 急急急!!!救命啊~~!!阵列坏了,只有前一天的完整数据备份,可是恢复时报‘一致性错误’?? 东大距是啥?还有冲日等天文名词. 阅读80篇超值升级版五年级第27篇第2.3,4,5题,拜托了,今晚就要用 小学语文阅读训练80篇超值升级版五年级第64篇答案 无种子但有输导组织的生物是什么? 超值升级版小学语文阅读训练80篇五年级下训练12的答案, 阅读80篇五年级语文第30篇答案 自行车骑的时候不倒的物理原理是什么? 自行车骑的时候为什么不倒?为什么自行车停下时会倒,而骑的时候不会倒? 为什么自行车骑起来不倒,停下来会倒? 自行车骑着不倒的原理? 为什么自行车骑快才不会倒? 斯诺登新照:在莫斯科乘游览船 未戴眼秘鲁组成新内阁日媒说日本也是美国谍报对象斯诺登在俄觅得网站工作 11月1日开以色列再次兴建犹太人定居点 被指破坏中美旅游行业业者看好赴美自驾游前景约旦河西岸推进环保 巴以或实现“环境巴官员称以色列炮击加沙地带 一名武装万圣节作掩护 女子藏毒南瓜闯加拿大海万圣节作掩护 女子藏毒南瓜闯加拿大海俄八旬老汉野外斗熊 被摔下悬崖后逃出美国务卿访问埃及 美将与埃过渡政府合关说案约询7人 挖出意想不到的事台前“国防副部长”:2020年前两岸黄世铭回应被逼下台:没有错坚持到底马鞍山市1至9月招标采购增收节支20马鞍山长江公路大桥本月将迎多项节点马鞍山市民生工程进展快成效好友谊关下唱响中越友谊之歌 记2013韩防长:如遇朝鲜远程火炮威胁 将采取巴基斯坦塔利班任命临时首领 前首领被台湾福懋油造假 胡志强痛批:商人沦落英雄嗔惟武独尊大儒草根领主官场子弟苏俄再起修真在1986年后网游三国之权倾天下白袍巫师三国求生记网游之混迹在美女公会白银旅游弥勒旅游驻马店旅游青藏线旅游蔚县旅游斗门旅游屏东旅游莱芜旅游和田旅游毕节旅游巴音布鲁克旅游
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘