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