Module

uInit

Path

C:\CPRS\CPRS30\uInit.pas

Last Modified

7/15/2014 3:26:44 PM

Initialization Code

initialization

Finalization Code

finalization
  ShutDownTimeOut;

end.

Units Used in Implementation

Name Comments
fTimeout -

Classes

Name Comments
TCPRSTimeoutTimer -

Procedures

Name Owner Declaration Scope Comments
AutoUpdateCheck - procedure AutoUpdateCheck; Interfaced -
InitTimeOut - procedure InitTimeOut(AUserCondition: TCPRSTimeoutTimerCondition; AUserAction: TCPRSTimeoutTimerAction); Interfaced -
ResetTimeout TCPRSTimeoutTimer procedure ResetTimeout; Protected
TCPRSTimeoutTime 

 this restarts the timer whenever there is a keyboard or mouse event
ResumeTimeout - procedure ResumeTimeout; Interfaced -
ShutDownTimeOut - procedure ShutDownTimeOut; Interfaced -
SuspendTimeout - procedure SuspendTimeout; Interfaced -
timTimeoutTimer TCPRSTimeoutTimer procedure timTimeoutTimer(Sender: TObject); Protected When the timer expires, the application is closed after warning the user
UpdateTimeOutInterval - procedure UpdateTimeOutInterval(NewTime: Cardinal); Interfaced -

Functions

Name Owner Declaration Scope Comments
TimedOut - function TimedOut: boolean; Interfaced -
TimeoutKeyHook - function TimeoutKeyHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward; Global
Timeout Functions **

 this is called for every keyboard event that occurs while running CPRS
TimeoutMouseHook - function TimeoutMouseHook(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; StdCall; forward; Global This is called for every mouse event that occurs while running CPRS

Global Variables

Name Type Declaration Comments
FTimedOut Boolean FTimedOut: boolean = FALSE; -
timTimeout TCPRSTimeoutTimer timTimeout: TCPRSTimeoutTimer = nil; -
uSuspended Boolean uSuspended: boolean = False; -


Module Source

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

Module Calls (2 levels)


uInit
 └fTimeout
   ├fAutoSz
   └uCore

Module Called-By (2 levels)


                      uInit
                    fPage┤ 
                 fFrame┤ │ 
                fHSplit┤ │ 
                 fCover┤ │ 
                  fMeds┤ │ 
                    fHP┤ │ 
               fAResize┘ │ 
                fFrame...┤ 
                  fOrders┤ 
                uOrders┤ │ 
                fODBase┤ │ 
              fFrame...┤ │ 
                  rMisc┤ │ 
                uODBase┤ │ 
               fMeds...┤ │ 
              fOrdersDC┤ │ 
              fOrdersCV┤ │ 
                fOMNavA┤ │ 
                 fOMSet┤ │ 
     fOrdersEvntRelease┤ │ 
        fODReleaseEvent┤ │ 
             mEvntDelay┤ │ 
              fODActive┤ │ 
            fOrdersCopy┤ │ 
               fMedCopy┤ │ 
    fActivateDeactivate┘ │ 
          fTemplateDialog┤ 
             fODBase...┤ │ 
             uTemplates┤ │ 
               fDrawers┤ │ 
                 fNotes┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
          fTemplateView┤ │ 
        fReminderDialog┤ │ 
               fSurgery┤ │ 
   fTemplateFieldEditor┤ │ 
        fTemplateFields┤ │ 
                fODAuto┘ │ 
               uReminders┤ 
              fFrame...┤ │ 
            fDrawers...┤ │ 
              fCover...┤ │ 
                 rCover┤ │ 
              fNotes...┤ │ 
           fConsults...┤ │ 
        fTemplateEditor┤ │ 
     fReminderDialog...┤ │ 
          fReminderTree┤ │ 
             rReminders┤ │ 
            fSurgery...┤ │ 
         fRemCoverSheet┘ │ 
                fCover...┤ 
                fNotes...┤ 
                 fProbEdt┤ 
                 fProbs┘ │ 
                 fProbLex┤ 
              fProbs...┤ │ 
            fProbEdt...┘ │ 
                   uSpell┘ 
              fFrame...┤   
              fNotes...┤   
           fConsults...┤   
             fDCSumm...┤   
     fTemplateEditor...┤   
           fSpellNotify┤   
            fSurgery...┤   
fTemplateFieldEditor...┘