作者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