1 | unit uInit;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Forms, Windows, Messages, SysUtils, ExtCtrls, ORSystem;
|
---|
7 |
|
---|
8 | type
|
---|
9 | {$IFDEF GroupEncounter}
|
---|
10 | TCPRSTimeoutTimerCondition = function: boolean;
|
---|
11 | TCPRSTimeoutTimerAction = procedure;
|
---|
12 | {$ELSE}
|
---|
13 | TCPRSTimeoutTimerCondition = function: boolean of object;
|
---|
14 | TCPRSTimeoutTimerAction = procedure of object;
|
---|
15 | {$ENDIF}
|
---|
16 |
|
---|
17 | procedure AutoUpdateCheck;
|
---|
18 |
|
---|
19 | procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition;
|
---|
20 | AUserAction: TCPRSTimeoutTimerAction);
|
---|
21 | procedure UpdateTimeOutInterval(NewTime: Cardinal);
|
---|
22 | function TimedOut: boolean;
|
---|
23 | procedure ShutDownTimeOut;
|
---|
24 |
|
---|
25 | implementation
|
---|
26 |
|
---|
27 | uses
|
---|
28 | fTimeout;
|
---|
29 |
|
---|
30 | type
|
---|
31 | TCPRSTimeoutTimer = class(TTimer)
|
---|
32 | private
|
---|
33 | FHooked: boolean;
|
---|
34 | FUserCondition: TCPRSTimeoutTimerCondition;
|
---|
35 | FUserAction: TCPRSTimeoutTimerAction;
|
---|
36 | uTimeoutInterval: Cardinal;
|
---|
37 | uTimeoutKeyHandle, uTimeoutMouseHandle: HHOOK;
|
---|
38 | protected
|
---|
39 | procedure ResetTimeout;
|
---|
40 | procedure timTimeoutTimer(Sender: TObject);
|
---|
41 | end;
|
---|
42 |
|
---|
43 | var
|
---|
44 | timTimeout: TCPRSTimeoutTimer = nil;
|
---|
45 | FTimedOut: boolean = FALSE;
|
---|
46 |
|
---|
47 | function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward;
|
---|
48 | function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward;
|
---|
49 |
|
---|
50 | procedure AutoUpdateCheck;
|
---|
51 | const
|
---|
52 | {$IFDEF GroupEncounter}
|
---|
53 | AppHelpFile = 'CPRSGE';
|
---|
54 | {$ELSE}
|
---|
55 | AppHelpFile = 'CPRS';
|
---|
56 | WhatsThisHelpFile = 'CPRSWT';
|
---|
57 | {$ENDIF}
|
---|
58 | var
|
---|
59 | x, CPRSUpdate :string;
|
---|
60 |
|
---|
61 | begin
|
---|
62 | CPRSUpdate := RegReadStr(CPRS_REG_GOLD) + 'CPRSUpdate.exe';
|
---|
63 | if not FileExists(CPRSUpdate) then CPRSUpdate := 'CPRSUpdate.exe';
|
---|
64 | x := FullToPathPart(Application.ExeName) + AppHelpFile + '.HLP';
|
---|
65 | if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
|
---|
66 | x := FullToPathPart(Application.ExeName) + AppHelpFile + '.CNT';
|
---|
67 | if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
|
---|
68 | x := FullToPathPart(Application.ExeName) + WhatsThisHelpFile + '.HLP';
|
---|
69 | if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
|
---|
70 | x := FullToPathPart(Application.ExeName) + WhatsThisHelpFile + '.CNT';
|
---|
71 | if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
|
---|
72 | x := FullToPathPart(Application.ExeName) + 'BORLNDMM.DLL';
|
---|
73 | if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
|
---|
74 | end;
|
---|
75 |
|
---|
76 | {** Timeout Functions **}
|
---|
77 |
|
---|
78 | function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
---|
79 | { this is called for every keyboard event that occurs while running CPRS }
|
---|
80 | begin
|
---|
81 | if lParam shr 31 = 1 then timTimeout.ResetTimeout; // on KeyUp only
|
---|
82 | Result := CallNextHookEx(timTimeout.uTimeoutKeyHandle, Code, wParam, lParam);
|
---|
83 | end;
|
---|
84 |
|
---|
85 | function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
|
---|
86 | { this is called for every mouse event that occurs while running CPRS }
|
---|
87 | begin
|
---|
88 | if (Code >= 0) and (wParam > WM_MOUSEFIRST) and (wParam <= WM_MOUSELAST)
|
---|
89 | then timTimeout.ResetTimeout; // all click events
|
---|
90 | Result := CallNextHookEx(timTimeout.uTimeoutMouseHandle, Code, wParam, lParam);
|
---|
91 | end;
|
---|
92 |
|
---|
93 | procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition;
|
---|
94 | AUserAction: TCPRSTimeoutTimerAction);
|
---|
95 | begin
|
---|
96 | if(not assigned(timTimeout)) then
|
---|
97 | begin
|
---|
98 | timTimeOut := TCPRSTimeoutTimer.Create(Application);
|
---|
99 | with timTimeOut do
|
---|
100 | begin
|
---|
101 | OnTimer := timTimeoutTimer;
|
---|
102 | FUserCondition := AUserCondition;
|
---|
103 | FUserAction := AUserAction;
|
---|
104 | uTimeoutInterval := 120000; // initially 2 minutes, will get DTIME after signon
|
---|
105 | uTimeoutKeyHandle := SetWindowsHookEx(WH_KEYBOARD, TimeoutKeyHook, 0, GetCurrentThreadID);
|
---|
106 | uTimeoutMouseHandle := SetWindowsHookEx(WH_MOUSE, TimeoutMouseHook, 0, GetCurrentThreadID);
|
---|
107 | FHooked := TRUE;
|
---|
108 | Interval := uTimeoutInterval;
|
---|
109 | Enabled := True;
|
---|
110 | end;
|
---|
111 | end;
|
---|
112 | end;
|
---|
113 |
|
---|
114 | procedure UpdateTimeOutInterval(NewTime: Cardinal);
|
---|
115 | begin
|
---|
116 | if(assigned(timTimeout)) then
|
---|
117 | begin
|
---|
118 | with timTimeout do
|
---|
119 | begin
|
---|
120 | uTimeoutInterval := NewTime;
|
---|
121 | Interval := uTimeoutInterval;
|
---|
122 | Enabled := True;
|
---|
123 | end;
|
---|
124 | end;
|
---|
125 | end;
|
---|
126 |
|
---|
127 | function TimedOut: boolean;
|
---|
128 | begin
|
---|
129 | Result := FTimedOut;
|
---|
130 | end;
|
---|
131 |
|
---|
132 | procedure ShutDownTimeOut;
|
---|
133 | begin
|
---|
134 | if(assigned(timTimeout)) then
|
---|
135 | begin
|
---|
136 | with timTimeout do
|
---|
137 | begin
|
---|
138 | Enabled := False;
|
---|
139 | if(FHooked) then
|
---|
140 | begin
|
---|
141 | UnhookWindowsHookEx(uTimeoutKeyHandle);
|
---|
142 | UnhookWindowsHookEx(uTimeoutMouseHandle);
|
---|
143 | FHooked := FALSE;
|
---|
144 | end;
|
---|
145 | end;
|
---|
146 | timTimeout.Free;
|
---|
147 | timTimeout := nil;
|
---|
148 | end;
|
---|
149 | end;
|
---|
150 |
|
---|
151 | { TCPRSTimeoutTime }
|
---|
152 |
|
---|
153 | procedure TCPRSTimeoutTimer.ResetTimeout;
|
---|
154 | { this restarts the timer whenever there is a keyboard or mouse event }
|
---|
155 | begin
|
---|
156 | Enabled := False;
|
---|
157 | Interval := uTimeoutInterval;
|
---|
158 | Enabled := True;
|
---|
159 | end;
|
---|
160 |
|
---|
161 | procedure TCPRSTimeoutTimer.timTimeoutTimer(Sender: TObject);
|
---|
162 | { when the timer expires, the application is closed after warning the user }
|
---|
163 | begin
|
---|
164 | Enabled := False;
|
---|
165 | if(assigned(FUserCondition)) then
|
---|
166 | FTimedOut := FUserCondition or AllowTimeout
|
---|
167 | else
|
---|
168 | FTimedOut := AllowTimeout;
|
---|
169 | if FTimedOut then
|
---|
170 | begin
|
---|
171 | if(assigned(FUserAction)) then FUserAction;
|
---|
172 | end
|
---|
173 | else
|
---|
174 | Enabled := True;
|
---|
175 | end;
|
---|
176 |
|
---|
177 | initialization
|
---|
178 |
|
---|
179 | finalization
|
---|
180 | ShutDownTimeOut;
|
---|
181 |
|
---|
182 | end.
|
---|