source: cprs/trunk/CPRS-Chart/uInit.pas@ 836

Last change on this file since 836 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

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