Re: [偽蝦] 既然作者提到在暑假會重改程式

看板Liu (無蝦米輸入法)作者ChrisTorng (ChrisTorng)時間20年前 (2005/06/02 10:38)推噓0(0推 0噓 0→)

留言0則, 0人參與討論串5/6 (看更多)

我先前提到自動偵測加字加詞檔，一旦有變更就立即重載的方法，今天突然想到就拿我的原始碼去參考就好了嘛… 這方法應該不會佔平時 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