source: cprs/branches/foia-cprs/CPRS-Chart/uInit.pas@ 594

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

Adding foia-cprs branch

File size: 5.4 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 x := FullToPathPart(Application.ExeName) + 'BORLNDMM.DLL';
73 if AppOutOfDate(x) and FileExists(CPRSUpdate) then RunProgram(CPRSUpdate + ' XFER="' + x + '"');
74end;
75
76{** Timeout Functions **}
77
78function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
79{ this is called for every keyboard event that occurs while running CPRS }
80begin
81 if lParam shr 31 = 1 then timTimeout.ResetTimeout; // on KeyUp only
82 Result := CallNextHookEx(timTimeout.uTimeoutKeyHandle, Code, wParam, lParam);
83end;
84
85function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
86{ this is called for every mouse event that occurs while running CPRS }
87begin
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);
91end;
92
93procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition;
94 AUserAction: TCPRSTimeoutTimerAction);
95begin
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;
112end;
113
114procedure UpdateTimeOutInterval(NewTime: Cardinal);
115begin
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;
125end;
126
127function TimedOut: boolean;
128begin
129 Result := FTimedOut;
130end;
131
132procedure ShutDownTimeOut;
133begin
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;
149end;
150
151{ TCPRSTimeoutTime }
152
153procedure TCPRSTimeoutTimer.ResetTimeout;
154{ this restarts the timer whenever there is a keyboard or mouse event }
155begin
156 Enabled := False;
157 Interval := uTimeoutInterval;
158 Enabled := True;
159end;
160
161procedure TCPRSTimeoutTimer.timTimeoutTimer(Sender: TObject);
162{ when the timer expires, the application is closed after warning the user }
163begin
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;
175end;
176
177initialization
178
179finalization
180 ShutDownTimeOut;
181
182end.
Note: See TracBrowser for help on using the repository browser.