作者ChrisTorng (ChrisTorng)
看板Liu
标题Re: [伪虾] 既然作者提到在暑假会重改程式
时间Thu Jun 2 10:40:44 2005
我先前提到自动侦测加字加词档，一旦有变更就立即重载的方法，
今天突然想到就拿我的原始码去参考就好了嘛…
这方法应该不会占平时 CPU/硬碟多少时间，不知道 luke 大能不能接受…
chkMonitorLiuBox 在打勾後就设定 tmrRunMonitor enable，Interval 只设 1ms，
tmrRunMonitor 一引发，立刻设 disable，其实只是为了要有 MultiThread 的效果，
不要将主视窗卡死而已，并不是每 1ms 都做一次档案变更检查。
MonitorLiuBox() 会在 MsgWaitForMultipleObjects 的 Do Loop 一直绕而不脱离，
平时以 DoEvents 处理视窗讯息，遇到 WAIT_OBJECT_0 就代表目录内有档案变更，
接下来再次确定 liu.box 有变更之後，就可以处理需要的动作。
底下的程式码当然无法直接运作，有需要的话再看我怎麽提供。
tmrRunMonitor.Interval = 1
Private Sub chkMonitorLiuBox_Click()
Debug.Print "chk start"
If chkMonitorLiuBox.Value = vbChecked Then
If Not FileExist(GetLiuBoxPath) Then
MsgBox "呒虾米加字加词档不存在: " & GetLiuBoxPath, , App.Title
chkMonitorLiuBox.Value = vbUnchecked
Debug.Print "chk end"
Exit Sub
End If
If g_Monitoring Then Exit Sub
tmrRunMonitor.Enabled = True
Else
If Not g_Monitoring Then Exit Sub
g_Quit = True
End If
Debug.Print "chk end"
mnuMonitorLiuBox.Checked = _
IIf(chkMonitorLiuBox.Value = vbChecked, True, False)
End Sub
Private Sub tmrRunMonitor_Timer()
Debug.Print "tmr start"
tmrRunMonitor.Enabled = False
MonitorLiuBox
Debug.Print "tmr end"
End Sub
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 FindNextChangeNotification Lib "kernel32" _
(ByVal hChangeHandle As Long) As Long
Private Declare Function FindCloseChangeNotification Lib "kernel32" _
(ByVal hChangeHandle As Long) As Long
Private Const FILE_NOTIFY_CHANGE_ATTRIBUTES = &H4
'属性改变
Private Const FILE_NOTIFY_CHANGE_DIR_NAME = &H2
'建立 删除 或更名资料夹
Private Const FILE_NOTIFY_CHANGE_FILE_NAME = &H1
'建立 删除 或更名档名
Private Const FILE_NOTIFY_CHANGE_LAST_WRITE = &H10
'档案最後写入时间改变
Private Const FILE_NOTIFY_CHANGE_LAST_ACCESS = &H20
'档案最後存取时间改变
Private Const FILE_NOTIFY_CHANGE_CREATION = &H40
'档案建立时间改变
Private Const FILE_NOTIFY_CHANGE_SECURITY = &H100
'档案或目录的安全属性改变
Private Const FILE_NOTIFY_CHANGE_SIZE = &H8
'档案大小改变
Private Declare Function MsgWaitForMultipleObjects Lib "user32" _
(ByVal nCount As Long, pHandles As Long, ByVal fWaitAll As Long, _
ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
Private Const INFINITE = &HFFFF
Private Const QS_POSTMESSAGE = &H8
Private Const QS_SENDMESSAGE = &H40
Private Const QS_TIMER = &H10
Private Const QS_PAINT = &H20
Private Const QS_KEY = &H1
Private Const QS_HOTKEY = &H80
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_MOUSEMOVE = &H2
Private Const QS_MOUSE = (QS_MOUSEMOVE Or QS_MOUSEBUTTON)
Private Const QS_INPUT = (QS_MOUSE Or QS_KEY)
Private Const QS_ALLEVENTS = (QS_INPUT Or QS_POSTMESSAGE Or QS_TIMER Or _
QS_PAINT Or QS_HOTKEY)
Private Const QS_ALLINPUT = (QS_SENDMESSAGE Or QS_PAINT Or QS_TIMER Or _
QS_POSTMESSAGE Or QS_MOUSEBUTTON Or QS_MOUSEMOVE Or QS_HOTKEY Or _
QS_KEY)
Private Const STATUS_WAIT_0 = &H0&
Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
Private Const INVALID_HANDLE_VALUE = -1
Dim hNotify(2) As Long
Public g_Quit As Boolean
Public g_WindowClose As Boolean
Public g_Monitoring As Boolean
Public Sub MonitorLiuBox()
Dim LiuBoxLastTime As Date
Dim dwResult As Long, nCount As Long
On Error GoTo EndProcess2
Debug.Print "monitor start"
g_Monitoring = True
LiuBoxLastTime = FileDateTime(GetLiuBoxFilePath)
On Error GoTo EndProcess1
hNotify(0) = FindFirstChangeNotification _
(GetLiuBoxPath, 0, FILE_NOTIFY_CHANGE_LAST_WRITE)
If hNotify(0) <> INVALID_HANDLE_VALUE Then
Do
dwResult = MsgWaitForMultipleObjects _
(1, hNotify(0), False, INFINITE, QS_ALLINPUT)
If (dwResult = WAIT_OBJECT_0) Then
If LiuBoxLastTime < FileDateTime(GetLiuBoxFilePath) Then
LiuBoxLastTime = FileDateTime(GetLiuBoxFilePath)
Debug.Print "liu.box changed"
frmMain.cmdReopen_Click
End If
FindNextChangeNotification hNotify(0)
End If
DoEvents
Loop While (Not g_Quit)
End If
If Err.Number <> 0 Then
End If
EndProcess1:
FindCloseChangeNotification hNotify(0)
EndProcess2:
If Not g_WindowClose Then
frmMain.chkMonitorLiuBox.Value = vbUnchecked
End If
g_Quit = False
g_Monitoring = False
Debug.Print "monitor stop"
End Sub
--
ChrisTorng
http://groups.msn.com/ChrisTorng
ChrisTorng 样式讯息记录 V2.1 正式推出
http://groups.msn.com/ChrisTorng/msn6messagelog.msnw
--
※ 发信站: 批踢踢实业坊(ptt.cc)
◆ From: 203.75.28.114