请问各位高手,如果不用timer,怎么对某一个目录进行监控?

ketao_78 2003-04-03 09:49:45
对某个目录监控的意思是说,发现该目录下有文件产生,就把它复制到另外一个目录下,同时产生一个ini文件。
现在关键是如何发现该目录下有文件产生,如何监控,轮循
...全文
100 22 打赏 收藏 转发到动态 举报
写回复
用AI写文章
22 条回复
切换为时间正序
请发表友善的回复…
发表回复
ketao_78 2003-04-04
  • 打赏
  • 举报
回复
谢谢谢谢,我看看先
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
平常很少用api,刚才看看,觉得不太懂,还请给各位高手提携一下
wumy_ld 2003-04-03
  • 打赏
  • 举报
回复
应该可以捕获系统消息的。
wumy_ld 2003-04-03
  • 打赏
  • 举报
回复
"api宝典"?
还请老兄介绍一下!
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
刚才我在api宝典中找到一个函数
findfirstchangenotification
大家有用过此函数没有?
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
up
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
愿闻其详~!
AechoJohn 2003-04-03
  • 打赏
  • 举报
回复
这个得需要监控系统的消息。
蒋宏伟 2003-04-03
  • 打赏
  • 举报
回复
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

#If (WIN32_IE >= &H400) Then
SHCNE_EXTENDED_EVENT = &H4000000
#End If ' WIN32_IE >= &H0400

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 ' LPITEMIDLIST
SHCNF_PATHA = &H1 ' path name
SHCNF_PRINTERA = &H2 ' printer friendly name
SHCNF_DWORD = &H3 ' DWORD
SHCNF_PATHW = &H5 ' path name
SHCNF_PRINTERW = &H6 ' printer friendly name
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 we don't already have a notification going...
If (m_hSHNotify = 0) Then

' Get the pidl for the desktop folder.
m_pidlDesktop = GetPIDLFromFolderID(0, CSIDL_DESKTOP)
If m_pidlDesktop Then

' Fill the one and only PIDLSTRUCT, we're watching
' desktop and all of the it's subfolders, everything...
ps.pidl = m_pidlDesktop
ps.bWatchSubFolders = True

m_hSHNotify = SHChangeNotifyRegister(hWnd, _
SHCNF_TYPE Or SHCNF_IDLIST, _
SHCNE_ALLEVENTS Or SHCNE_INTERRUPT, _
WM_SHNOTIFY, _
1, _
ps)
SHNotify_Register = CBool(m_hSHNotify)

Else
' If something went wrong...
Call CoTaskMemFree(m_pidlDesktop)

End If ' m_pidlDesktop
End If ' (m_hSHNotify = 0)

End Function


Public Function SHNotify_Unregister() As Boolean

' If we have a registered notification handle.
If m_hSHNotify Then
' Unregister it. If the call is successful, zero the handle's variable,
' free and zero the the desktop's pidl.
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(dwEventID As Long) As String
Dim sEvent As String

Select Case dwEventID
Case SHCNE_RENAMEITEM: sEvent = "SHCNE_RENAMEITEM" ' = &H1"
Case SHCNE_CREATE: sEvent = "SHCNE_CREATE" ' = &H2"
Case SHCNE_DELETE: sEvent = "SHCNE_DELETE" ' = &H4"
Case SHCNE_MKDIR: sEvent = "SHCNE_MKDIR" ' = &H8"
Case SHCNE_RMDIR: sEvent = "SHCNE_RMDIR" ' = &H10"
Case SHCNE_MEDIAINSERTED: sEvent = "SHCNE_MEDIAINSERTED" ' = &H20"
Case SHCNE_MEDIAREMOVED: sEvent = "SHCNE_MEDIAREMOVED" ' = &H40"
Case SHCNE_DRIVEREMOVED: sEvent = "SHCNE_DRIVEREMOVED" ' = &H80"
Case SHCNE_DRIVEADD: sEvent = "SHCNE_DRIVEADD" ' = &H100"
Case SHCNE_NETSHARE: sEvent = "SHCNE_NETSHARE" ' = &H200"
Case SHCNE_NETUNSHARE: sEvent = "SHCNE_NETUNSHARE" ' = &H400"
Case SHCNE_ATTRIBUTES: sEvent = "SHCNE_ATTRIBUTES" ' = &H800"
Case SHCNE_UPDATEDIR: sEvent = "SHCNE_UPDATEDIR" ' = &H1000"
Case SHCNE_UPDATEITEM: sEvent = "SHCNE_UPDATEITEM" ' = &H2000"
Case SHCNE_SERVERDISCONNECT: sEvent = "SHCNE_SERVERDISCONNECT" ' = &H4000"
Case SHCNE_UPDATEIMAGE: sEvent = "SHCNE_UPDATEIMAGE" ' = &H8000&"
Case SHCNE_DRIVEADDGUI: sEvent = "SHCNE_DRIVEADDGUI" ' = &H10000"
Case SHCNE_RENAMEFOLDER: sEvent = "SHCNE_RENAMEFOLDER" ' = &H20000"
Case SHCNE_FREESPACE: sEvent = "SHCNE_FREESPACE" ' = &H40000"

#If (WIN32_IE >= &H400) Then
Case SHCNE_EXTENDED_EVENT: sEvent = "SHCNE_EXTENDED_EVENT" ' = &H4000000"
#End If ' WIN32_IE >= &H0400

Case SHCNE_ASSOCCHANGED: sEvent = "SHCNE_ASSOCCHANGED" ' = &H8000000"

Case SHCNE_DISKEVENTS: sEvent = "SHCNE_DISKEVENTS" ' = &H2381F"
Case SHCNE_GLOBALEVENTS: sEvent = "SHCNE_GLOBALEVENTS" ' = &HC0581E0"
Case SHCNE_ALLEVENTS: sEvent = "SHCNE_ALLEVENTS" ' = &H7FFFFFFF"
Case SHCNE_INTERRUPT: sEvent = "SHCNE_INTERRUPT" ' = &H80000000"
End Select

SHNotify_GetEventStr = sEvent

End Function
蒋宏伟 2003-04-03
  • 打赏
  • 举报
回复
Option Explicit

' Brought to you by Brad Martinez
' http://members.aol.com/btmtz/vb
' http://www.mvps.org/ccrp

' Code was written in and formatted for 8pt MS San Serif

' ====================================================================

Declare Function FlashWindow Lib "user32" (ByVal hWnd As Long, ByVal bInvert As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

' Frees memory allocated by the shell (pidls)
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

Public Const MAX_PATH = 260

' Defined as an HRESULT that corresponds to S_OK.
Public Const NOERROR = 0

' Retrieves the location of a special (system) folder.
' Returns NOERROR if successful or an OLE-defined error result otherwise.
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, _
ByVal nFolder As SHSpecialFolderIDs, _
pidl As Long) As Long

' Special folder values for SHGetSpecialFolderLocation and
' SHGetSpecialFolderPath (Shell32.dll v4.71)
Public Enum SHSpecialFolderIDs
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 ' ' DBCS
CSIDL_COMMON_ALTSTARTUP = &H1E ' ' DBCS
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_INTERNET_CACHE = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
End Enum

' Converts an item identifier list to a file system path.
' Returns TRUE if successful or FALSE if an error occurs, for example,
' if the location specified by the pidl parameter is not part of the file system.
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

' Retrieves information about an object in the file system, such as a file,
' a folder, a directory, or a drive root.
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

' If pidl is invalid, SHGetFileInfoPidl can very easily blow up when filling the
' szDisplayName and szTypeName string members of the SHFILEINFO struct
Public Type SHFILEINFOBYTE ' sfib
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 ' shfi
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 ' sfi.hIcon is large icon
SHGFI_SMALLICON = &H1 ' sfi.hIcon is small icon
SHGFI_OPENICON = &H2 ' sfi.hIcon is open icon
SHGFI_SHELLICONSIZE = &H4 ' sfi.hIcon is shell size (not system size), rtns BOOL
SHGFI_PIDL = &H8 ' pszPath is pidl, rtns BOOL
SHGFI_USEFILEATTRIBUTES = &H10 ' pretent pszPath exists, rtns BOOL
SHGFI_ICON = &H100 ' fills sfi.hIcon, rtns BOOL, use DestroyIcon
SHGFI_DISPLAYNAME = &H200 ' isf.szDisplayName is filled, rtns BOOL
SHGFI_TYPENAME = &H400 ' isf.szTypeName is filled, rtns BOOL
SHGFI_ATTRIBUTES = &H800 ' rtns IShellFolder::GetAttributesOf SFGAO_* flags
SHGFI_ICONLOCATION = &H1000 ' fills sfi.szDisplayName with filename
' containing the icon, rtns BOOL
SHGFI_EXETYPE = &H2000 ' rtns two ASCII chars of exe type
SHGFI_SYSICONINDEX = &H4000 ' sfi.iIcon is sys il icon index, rtns hImagelist
SHGFI_LINKOVERLAY = &H8000 ' add shortcut overlay to sfi.hIcon
SHGFI_SELECTED = &H10000 ' sfi.hIcon is selected icon
End Enum
'

' Returns an absolute pidl (realtive to the desktop) from a special folder's ID.
' (calling proc is responsible for freeing the pidl)

' hOwner - handle of window that will own any displayed msg boxes
' nFolder - special folder ID

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

' If successful returns the specified absolute pidl's displayname,
' returns an empty string otherwise.

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

' Returns a path from only an absolute pidl (relative to the desktop)

Public Function GetPathFromPIDL(pidl As Long) As String
Dim sPath As String * MAX_PATH
If SHGetPathFromIDList(pidl, sPath) Then ' rtns TRUE (1) if successful, FALSE (0) if not
GetPathFromPIDL = GetStrFromBufferA(sPath)
End If
End Function

' Returns the string before first null char encountered (if any) from an ANSII string.

Public Function GetStrFromBufferA(sz As String) As String
If InStr(sz, vbNullChar) Then
GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
Else
' If sz had no null char, the Left$ function
' above would return a zero length string ("").
GetStrFromBufferA = sz
End If
End Function
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
SHChangeNotifyRegister
这个函数我在msdn上找不到帮助
蒋宏伟 2003-04-03
  • 打赏
  • 举报
回复
form1 一个timer,一个text
Option Explicit
'
' Brought to you by Brad Martinez
' http://members.aol.com/btmtz/vb
' http://www.mvps.org/ccrp
'
' Code was written in and formatted for 8pt MS San Serif
'
' ====================================================================
' Demonstrates how to receive shell change notifications (ala "what happens when the
' SHChangeNotify API is called?")
'
' Interpretation of the shell's undocumented functions SHChangeNotifyRegister (ordinal 2)
' and SHChangeNotifyDeregister (ordinal 4) would not have been possible without the
' assistance of James Holderness. For a complete (and probably more accurate) overview
' of shell change notifcations, please refer to James' "Shell Notifications" page at
' http://www.geocities.com/SiliconValley/4942/
' ====================================================================
'

Private Sub Form_Load()
If SubClass(hWnd) Then
If IsIDE Then
Text1 = "**IMPORTANT**" & vbCrLf & _
"本窗口为 subclassed.不要用VB 的结束按钮或" & vbCrLf & _
"结束菜单命令\或关闭VB来关闭它,只能通过它自" & vbCrLf & _
"己的系统菜单关闭它." & vbCrLf & vbCrLf & Text1

End If
Call SHNotify_Register(hWnd)
Else
Text1 = "Uh..., it's supposed to work... :-)"
End If
Move Screen.Width - Width, Screen.Height - Height
End Sub

Private Function IsIDE() As Boolean
On Error GoTo Out
Debug.Print 1 / 0
Out:
IsIDE = Err
End Function

Private Sub Form_Unload(Cancel As Integer)
Call SHNotify_Unregister
Call UnSubClass(hWnd)
End Sub

Private Sub Form_Resize()
On Error GoTo Out
Text1.Move 0, 0, ScaleWidth, ScaleHeight
Out:
End Sub

Public Sub NotificationReceipt(wParam As Long, lParam As Long)
Dim sOut As String
Dim shns As SHNOTIFYSTRUCT

sOut = SHNotify_GetEventStr(lParam) & vbCrLf

' Fill the SHNOTIFYSTRUCT from it's pointer.
MoveMemory shns, ByVal wParam, Len(shns)

' lParam is the ID of the notication event, one of the SHCN_EventIDs.
Select Case lParam

' ================================================================
' For the SHCNE_FREESPACE event, dwItem1 points to what looks like a 10 byte
' struct. The first two bytes are the size of the struct, and the next two members
' equate to SHChangeNotify's dwItem1 and dwItem2 params. The dwItem1 member
' is a bitfield indicating which drive(s) had it's (their) free space changed. The bitfield
' is identical to the bitfield returned from a GetLogicalDrives call, i.e, bit 0 = A:\, bit
' 1 = B:\, 2, = C:\, etc. Since VB does DWORD alignment when MoveMemory'ing
' to a struct, we'll extract the bitfield directly from it's memory location.
Case SHCNE_FREESPACE
Dim dwDriveBits As Long
Dim wHighBit As Integer
Dim wBit As Integer

MoveMemory dwDriveBits, ByVal shns.dwItem1 + 2, 4

' Get the zero based position of the highest bit set in the bitmask
' (essentially determining the value's highest complete power of 2).
' Use floating point division (we want the exact values from the Logs)
' and remove the fractional value (the fraction indicates the value of
' the last incomplete power of 2, which means the bit isn't set).
wHighBit = Int(Log(dwDriveBits) / Log(2))

For wBit = 0 To wHighBit
' If the bit is set...
If (2 ^ wBit) And dwDriveBits Then

' The bit is set, get it's drive string
sOut = sOut & Chr$(vbKeyA + wBit) & ":\" & vbCrLf

End If
Next

' ================================================================
' shns.dwItem1 also points to a 10 byte struct. The struct's second member (after the
' struct's first WORD size member) points to the system imagelist index of the image
' that was updated.
Case SHCNE_UPDATEIMAGE
Dim iImage As Long

MoveMemory iImage, ByVal shns.dwItem1 + 2, 4
sOut = sOut & "Index of image in system imagelist: " & iImage & vbCrLf

' ================================================================
' Everything else except SHCNE_ATTRIBUTES is the pidl(s) of the changed item(s).
' For SHCNE_ATTRIBUTES, neither item is used. See the description of the values
' for the wEventId parameter of the SHChangeNotify API function for more info.
Case Else
Dim sDisplayname As String

If shns.dwItem1 Then
sDisplayname = GetDisplayNameFromPIDL(shns.dwItem1)
If Len(sDisplayname) Then
sOut = sOut & "first item displayname: " & sDisplayname & vbCrLf
sOut = sOut & "first item path: " & GetPathFromPIDL(shns.dwItem1) & vbCrLf
Else
sOut = sOut & "first item is invalid" & vbCrLf
End If
End If

If shns.dwItem2 Then
sDisplayname = GetDisplayNameFromPIDL(shns.dwItem2)
If Len(sDisplayname) Then
sOut = sOut & "second item displayname: " & sDisplayname & vbCrLf
sOut = sOut & "second item path: " & GetPathFromPIDL(shns.dwItem2) & vbCrLf
Else
sOut = sOut & "second item is invalid" & vbCrLf
End If
End If

End Select

Text1 = Text1 & sOut & vbCrLf
Text1.SelStart = Len(Text1)
tmrFlashMe = True

End Sub

Private Sub tmrFlashMe_Timer() ' initial settings: Interval = 1, Enabled = False
Static nCount As Integer

If nCount = 0 Then tmrFlashMe.Interval = 200
nCount = nCount + 1
Call FlashWindow(hWnd, True)

' Reset everything after 3 flash cycles
If nCount = 6 Then
nCount = 0
tmrFlashMe.Interval = 1
tmrFlashMe = False
End If

End Sub




模块1:

Option Explicit


Private Const WM_NCDESTROY = &H82

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 Const GWL_WNDPROC = (-4)

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

Private Const OLDWNDPROC = "OldWndProc"
'

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
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
谢谢,我把邮箱告诉你把
能发几个代码实例给我看看么?
online 2003-04-03
  • 打赏
  • 举报
回复
利用Windows的未公开函数SHChangeNotifyRegister实现文件目录操作即时监视程序可以监视在Explore中的重命名、新建、删除文件或目录;改变文件关联;插入、取出CD和添加删除网络共享都可以被该程序记录下来

代码太多了有个例子
online@ourfly.com
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
to bdxzq(思考) :
您好,能给出具体代码吗?
如果不太方便,能给个思路吗?
我的电子邮箱是ke.tao@axisoft.com.hk
思考 2003-04-03
  • 打赏
  • 举报
回复
不用timer控件,用api了
思考 2003-04-03
  • 打赏
  • 举报
回复
我有,只要文件夹内文件有变化(包括文件日期、文件名、文件多少),就能立刻知道。
ketao 2003-04-03
  • 打赏
  • 举报
回复
upupuopuououou
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
timer是简单,但是必须不断的轮循,可能会影响效率,而且没有文件产生的时候也会不断的产生动作,而用api捕获消息的话,我觉得就不会这样了,

欢迎各位高手不断的提出意见~!
ketao_78 2003-04-03
  • 打赏
  • 举报
回复
to AechoJohn(江江)
这个方法不错,我再研究研究
加载更多回复(2)

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧