Тема: AHK: Контроль времени за компьютером
Прошу сообщество о помощи. Написал программку для того, чтобы ребёнок за компьютером не мог проводить много времени. Кроме ограничения времени преследовал главную цель - возможность "заработать" время для игры/работы, решая задачи.
Принцип такой: каждый день доступно некоторой время (1 час). Когда заканчивается время, выводится окно на передний план, в котором нужно решать задачи из школьной программы. За каждую правильно решённую задачу начисляется некоторое количество времени, которое можно провести за компьютером.
На текущий момент основная проблема - возможность "снять задачу" (при отключенном диспетчере задач) так: при большой нагрузке системы, например при загрузке компьютера, ребёнок многократно щёлкает по иконке приложения, система полагает, что "приложение не отвечает" и предлагает его снять, чем ребёнок и пользуется.
Вопрос: как сделать, чтобы пользователь не мог снять приложение?
Текст части, написанной на AHK:
#WinActivateForce
#SingleInstance force
;#SingleInstance ignore
;#Persistent ; Keep the script running until the user exits it.
WriteToLog("Start")
Secret := ReadCfg("Secret", "test")
WinTitle := ReadCfg("WinTitle", "Time Control")
MenuItemExit := ReadCfg("MenuItemExit", "Exit")
MarginHeight := ReadCfg("MarginHeight", 140)
MarginWidth := ReadCfg("MarginWidth", 100)
ServerURL := ReadCfg("ServerURL", "http://localhost/tc/tc.php")
Ticks := ReadCfg("Ticks", 60)
Ticks := Ticks * 1000 ; Виртуальная минута в миллисекундах (60000)
NewWidth := A_ScreenWidth - MarginWidth
NewHeight := A_ScreenHeight - MarginHeight
Menu, Tray, NoStandard
Gui, Margin, 0, 0
Gui, -Resize -Border -MaximizeBox -MinimizeBox -SysMenu +ToolWindow +AlwaysOnTop
Gui, Add, ActiveX, w%NewWidth% h%NewHeight% vWB, Shell.Explorer ; The final parameter is the name of the ActiveX component.
UID := ReadCfg("UID")
If (!UID) {
; Если в конфигурации нет идентификатора пользователя, создаю его, давая ему значение текущего времени.
UID := A_NowUTC
; Loop {
RegWrite, REG_SZ, HKCU, SOFTWARE\2S\tc, UID, %UID%
; If (ErrorLevel)
; MsgBox, 0x10, %WinTitle%, Ошибка записи конфигурации, 10
; Else
; Break
; }
}
ServerURL .= "?uid=" . UID
Remain := GetRemain()
Menu, Tray, Tip, Осталось минут: %Remain%
WriteToLog("Remain" . A_Tab . Remain)
WB.Navigate(ServerURL)
While WB.readyState != 4 || WB.document.readyState != "complete" || WB.busy ; wait for the page to load
sleep 100
WriteToLog("Navigate" . A_Tab . ServerURL . A_Tab . StrLen(WB.document.body.innerHTML))
Menu, Tray, Add, Решить..., StartSolve
Menu, Tray, Add, %MenuItemExit%, Quit
Menu, Tray, Default, Решить...
StartTimer(True)
OnMessage(0x0232, "WM_EXITSIZEMOVE") ; Sent one time to a window, after it has exited the moving or sizing modal loop [http://msdn.microsoft.com/en-us/library/windows/desktop/ms632623(v=vs.85).aspx]
OnMessage(0x001c, "WM_ACTIVATEAPP") ; посылается, когда окно другой программы (кроме активного окна) собирается быть активизированным [http://msdn.microsoft.com/en-us/library/windows/desktop/ms632614%28v=vs.85%29.aspx]
Return
GuiClose:
If (Remain > 0) {
Gui, Hide
WriteToLog("GUI Hidden")
}
Return
Quit:
WriteToLog("Try to quit")
StartTimer(False)
Gui, -AlwaysOnTop
InputBox, Password, %WinTitle%, Секретное слово:, hide, 200, 120, , , , 20
If (Password = Secret) {
WriteToLog("Secret ok - Quit")
ExitApp
} Else {
WriteToLog("Secret WRONG")
StartTimer(True)
Gui, +AlwaysOnTop
}
Return
/*
RemoveToolTip:
SetTimer, RemoveToolTip, Off
ToolTip
Return
*/
ActivateWindow:
WriteToLog("Activate GUI")
Gui +HwndMyGuiHwnd
WinActivate, ahk_id %MyGuiHwnd%
Return
; Здесь узнаём количество доступного времени (запрос к серверу, который должен уменьшить,
; если ещё есть что уменьшать, на одну (вируальную) минуту и возвращает оставшееся время.
; Если доступное время кончилось, то принудительно открываем окно для решения задач.
CountTime:
_gv := GUIvisible()
Remain := GetRemain((_gv ? 0 : (Remain > 0 ? 1 : 0))) ; Отсчитываем время, только если интерфейс выключен и есть что отсчитывать.
SetClosableGUI()
If (Remain <= 0) {
Gosub, StartSolve
} Else If (Remain < 4) {
MsgBox, 0x10, %WinTitle%, Осталось минут: %Remain%, % Ticks / (Remain * 2000)
}
WB.document.getElementById("lbTotal").innerHTML := Remain
Menu, Tray, Tip, Осталось минут: %Remain%
If (_gv) {
IfWinNotActive, ahk_id %_gv%
Gosub, ActivateWindow
}
Return
; Запуск браузера для решения (редактирования) задач.
StartSolve:
WriteToLog("Start solve. Remain" . A_Tab . Remain)
SetClosableGUI()
If (!GUIvisible()) {
Gui, Show, Center, %WinTitle%
}
Return
; Обрабатывае событие завершения перемещения окна
; Возвращает окно в центр
WM_EXITSIZEMOVE(wParam, lParam) {
; ToolTip Window Moved!
; SetTimer, RemoveToolTip, 1000
WriteToLog("Try to move window")
Gui, Show, Center
return 0
}
; Обрабатывает событие смены активного окна
; [http://www.firststeps.ru/mfc/winapi/win/r.php?121]
; посылается прикладной программе, чье окно активизируется и прикладной программе, чье окно деактивируется
; Значение wParam. Устанавливает, активизируется ли (true) или деактивизируется (false) окно.
; Через 5 секунд (чтобы успеть переключиться в полнокранный режим, например игрушки) переключается обратно
WM_ACTIVATEAPP(wParam, lParam) {
If (!wParam) {
WriteToLog("Try to switch window")
SetTimer, ActivateWindow, -5000
}
return 0
}
SetClosableGUI() {
global Remain
If (Remain > 0)
Gui, +Border +SysMenu
Else
Gui, -Border -SysMenu
}
; Запрашивает оставшееся время с сервера.
; Параметр DecMin (опциональный) - количество минут, на сколько уменьшить доступное время в базе данных
; 23.01.2014: TODO: Думаю, что каждый раз создавать объект XMLHTTP, чтобы сделать один запрос, а потом этот объект
; удалять - не очень разумно. Наверно, стоит создать этот глобально, и пользоваться им можно не только тут, а
; ещё, например, для хранения конфигурации не в ini-файле, а в xml (может даже на сервере).
GetRemain(DecMin := 0) {
; Запрашиваем данные с сервера.
global ServerURL
WebRequest := ComObjCreate("Msxml2.XMLHTTP")
WebRequest.Open("POST", ServerURL . "&cmd=getStat" . (DecMin ? "&minutes=" . DecMin : ""), False)
try {
WebRequest.Send()
} catch e {
}
If (WebRequest.status = "200") {
xmlElement := WebRequest.responseXML.documentElement
r := xmlElement.getAttribute("Remain") << 0
} Else {
StartTimer(False)
r := WebRequest.status
MsgBox, 0x10, %WinTitle%, Ошибка '%r%'`nпри доступе к серверу: %ServerURL%, 10
r := 0
}
WebRequest := ""
xmlElement := ""
Return r
}
StartTimer(isStart) {
global Ticks
If isStart {
SetTimer, CountTime, %Ticks%
} Else {
SetTimer, CountTime, Off
}
}
ReadCfg(Key, DefaultValue := 0) {
r := ""
RegRead, r, HKCU, SOFTWARE\2S\tc, %Key%
If (ErrorLevel) {
r := DefaultValue
}
Return r
}
GUIvisible() {
Gui +HwndMyGuiHwnd
w := WinExist("ahk_id " . MyGuiHwnd)
Return, w << 0
}
WriteToLog(TextToLog) {
; FileAppend, %A_Now%%A_Tab%%TextToLog%`n, %A_Temp%\tc.log
FileAppend, %A_YYYY%-%A_MM%-%A_DD%_%A_Hour%:%A_Min%:%A_Sec%.%A_MSec%%A_Tab%%TextToLog%`n, %A_Temp%\tc.log
Return
}
P.S.
Часть с заданиями работает на сервере в Интернете и тоже требует усовершенствования. На всё просто не хватает времени/знаний.
Буду рад сотрудничеству в этом проекте.