source: cprs/branches/tmg-cprs/CPRS-Chart/uInit.pas@ 797

Last change on this file since 797 was 453, checked in by Kevin Toppenberg, 16 years ago

Initial upload of TMG-CPRS 1.0.26.69

File size: 5.4 KB
Line 
1//kt -- Modified with SourceScanner on 8/7/2007
2unit uInit;
3
4interface
5
6uses
7 Forms, Windows, Messages, SysUtils, ExtCtrls, ORSystem;
8
9type
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
18procedure AutoUpdateCheck;
19
20procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition;
21 AUserAction: TCPRSTimeoutTimerAction);
22procedure UpdateTimeOutInterval(NewTime: Cardinal);
23function TimedOut: boolean;
24procedure ShutDownTimeOut;
25
26implementation
27
28uses
29 fTimeout;
30
31type
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
44var
45 timTimeout: TCPRSTimeoutTimer = nil;
46 FTimedOut: boolean = FALSE;
47
48function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward;
49function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward;
50
51procedure AutoUpdateCheck;
52const
53{$IFDEF GroupEncounter}
54 AppHelpFile = 'CPRSGE';
55{$ELSE}
56 AppHelpFile = 'CPRS';
57 WhatsThisHelpFile = 'CPRSWT';
58{$ENDIF}
59
60
61var
62 x, CPRSUpdate :string;
63
64begin
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 + '"');
77end;
78
79{** Timeout Functions **}
80
81function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
82{ this is called for every keyboard event that occurs while running CPRS }
83begin
84 if lParam shr 31 = 1 then timTimeout.ResetTimeout; // on KeyUp only
85 Result := CallNextHookEx(timTimeout.uTimeoutKeyHandle, Code, wParam, lParam);
86end;
87
88function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
89{ this is called for every mouse event that occurs while running CPRS }
90begin
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);
94end;
95
96procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition;
97 AUserAction: TCPRSTimeoutTimerAction);
98begin
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;
115end;
116
117procedure UpdateTimeOutInterval(NewTime: Cardinal);
118begin
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;
128end;
129
130function TimedOut: boolean;
131begin
132 Result := FTimedOut;
133end;
134
135procedure ShutDownTimeOut;
136begin
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;
152end;
153
154{ TCPRSTimeoutTime }
155
156procedure TCPRSTimeoutTimer.ResetTimeout;
157{ this restarts the timer whenever there is a keyboard or mouse event }
158begin
159 Enabled := False;
160 Interval := uTimeoutInterval;
161 Enabled := True;
162end;
163
164procedure TCPRSTimeoutTimer.timTimeoutTimer(Sender: TObject);
165{ when the timer expires, the application is closed after warning the user }
166begin
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;
178end;
179
180initialization
181
182finalization
183 ShutDownTimeOut;
184
185end.
Note: See TracBrowser for help on using the repository browser.