source: cprs/trunk/VA/VA508Accessibility/VA508ScreenReaderDLLLinker.pas@ 1729

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

Upgrade to version 27

File size: 11.9 KB
Line 
1unit VA508ScreenReaderDLLLinker;
2
3interface
4
5 { TODO -oJeremy Merrill -c508 :Add ability to handle multiple instances / multiple appliations to JAWS at the same time -
6will need to use Application.MainForm handle approach, probably need to use different
7registry keys with handle in registry key name. JAWS has a GetAppMainWindow command
8to get the handle. Will need a cleanup command in delphi to make sure we don't leave
9junk in the registry - probably search running apps, and if the main form's handle isn't in
10the registry, delete entries. }
11uses
12 Windows, SysUtils, Forms, Classes, VA508AccessibilityConst;
13
14{$I 'VA508ScreenReaderDLLStandard.inc'}
15
16// Returns true if a link to a screen reader was successful. The first link that
17// is established causes searching to stop.
18// Searches for .SR files in this order:
19// 1) Current machine's Program Files directory
20// 2) \Program Files directory on drive where app resides,
21// if it's different than the current machine's program files directory
22// 3) The directory the application was run from.
23
24function ScreenReaderDLLsExist: boolean;
25function IsScreenReaderSupported(Unload: Boolean): boolean;
26function InitializeScreenReaderLink: boolean;
27procedure CloseScreenReaderLink;
28
29
30type
31 TVA508RegisterCustomBehaviorProc = procedure(BehaviorType: integer; Before, After: PChar); stdcall;
32 TVA508SpeakTextProc = procedure(Text: PChar); stdcall;
33 TVA508IsRunningFunc = function(HighVersion, LowVersion: Word): BOOL; stdcall;
34 TVA508ConfigChangePending = function: boolean; stdcall;
35 TVA508ComponentDataProc = procedure (WindowHandle: HWND;
36 DataStatus: LongInt = DATA_NONE;
37 Caption: PChar = nil;
38 Value: PChar = nil;
39 Data: PChar = nil;
40 ControlType: PChar = nil;
41 State: PChar = nil;
42 Instructions: PChar = nil;
43 ItemInstructions: PChar = nil); stdcall;
44var
45 SRSpeakText: TVA508SpeakTextProc = nil;
46 SRIsRunning: TVA508IsRunningFunc = nil;
47 SRRegisterCustomBehavior: TVA508RegisterCustomBehaviorProc = nil;
48 SRComponentData: TVA508ComponentDataProc = nil;
49 SRConfigChangePending: TVA508ConfigChangePending = nil;
50 ValidSRFiles: TStringList = nil;
51 ExecuteFind: boolean = TRUE;
52 DoInitialize: boolean = TRUE;
53 InitializeResult: boolean = FALSE;
54
55implementation
56
57uses VAUtils, VA508AccessibilityRouter, VA508AccessibilityManager;
58
59const
60 ScreenReaderFileExtension = '.SR';
61 ScreenReaderCommonFilesDir = 'VistA\Common Files\';
62 ScreenReaderSearchSpec = '*' + ScreenReaderFileExtension;
63{$WARNINGS OFF} // Ignore platform specific code warning
64 BadFile = faHidden or faSysFile or faDirectory or faSymLink;
65{$WARNINGS ON}
66
67{$REGION 'Initialize Proc Definition'}
68type
69 TVA508InitializeProc = function(CallBackProc: TComponentDataRequestProc): BOOL; stdcall;
70const
71 TVA508InitializeProcName = 'Initialize';
72var
73 SRInitialize: TVA508InitializeProc = nil;
74
75function Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL; stdcall;
76{$HINTS OFF} // Ignore unused variable hint
77var
78 CompileVerification: TVA508InitializeProc;
79begin
80 CompileVerification := Initialize;
81 Result := FALSE;
82end;
83{$HINTS ON}
84{$ENDREGION}
85
86{$REGION 'ShutDown Proc Definition'}
87type
88 TVA508ShutDownProc = procedure; stdcall;
89const
90 TVA508ShutDownProcName = 'ShutDown';
91var
92 SRShutDown: TVA508ShutDownProc = nil;
93
94procedure ShutDown; stdcall;
95{$HINTS OFF} // Ignore unused variable hint
96var
97 CompileVerification: TVA508ShutDownProc;
98begin
99 CompileVerification := ShutDown;
100end;
101{$HINTS ON}
102{$ENDREGION}
103
104{$REGION 'RegisterCustomBehavior Proc Definition'}
105const
106 TVA508RegisterCustomBehaviorProcName = 'RegisterCustomBehavior';
107
108procedure RegisterCustomBehavior(BehaviorType: integer; Before, After: PChar); stdcall;
109{$HINTS OFF} // Ignore unused variable hint
110var
111 CompileVerification: TVA508RegisterCustomBehaviorProc;
112begin
113 CompileVerification := RegisterCustomBehavior;
114end;
115{$HINTS ON}
116{$ENDREGION}
117
118{$REGION 'ComponentData Proc Definition'}
119const
120 TVA508ComponentDataProcName = 'ComponentData';
121
122procedure ComponentData(WindowHandle: HWND;
123 DataStatus: LongInt = DATA_NONE;
124 Caption: PChar = nil;
125 Value: PChar = nil;
126 Data: PChar = nil;
127 ControlType: PChar = nil;
128 State: PChar = nil;
129 Instructions: PChar = nil;
130 ItemInstructions: PChar = nil); stdcall;
131
132{$HINTS OFF} // Ignore unused variable hint
133var
134 CompileVerification: TVA508ComponentDataProc;
135begin
136 CompileVerification := ComponentData;
137end;
138{$HINTS ON}
139{$ENDREGION}
140
141{$REGION 'SpeakText Proc Definition'}
142const
143 TVA508SpeakTextProcName = 'SpeakText';
144
145procedure SpeakText(Text: PChar); stdcall;
146{$HINTS OFF} // Ignore unused variable hint
147var
148 CompileVerification: TVA508SpeakTextProc;
149begin
150 CompileVerification := SpeakText;
151end;
152{$HINTS ON}
153{$ENDREGION}
154
155{$REGION 'IsRunning Proc Definition'}
156const
157 TVA508IsRunningFuncName = 'IsRunning';
158
159function IsRunning(HighVersion, LowVersion: Word): BOOL; stdcall;
160{$HINTS OFF} // Ignore unused variable hint
161var
162 CompileVerification: TVA508IsRunningFunc;
163begin
164 CompileVerification := IsRunning;
165 Result := FALSE; // avoid compiler warning...
166end;
167{$HINTS ON}
168{$ENDREGION}
169
170{$REGION 'ConfigChangePending Proc Definition'}
171const
172 TVA508ConfigChangePendingName = 'ConfigChangePending';
173
174function ConfigChangePending: boolean; stdcall;
175{$HINTS OFF} // Ignore unused variable hint
176var
177 CompileVerification: TVA508ConfigChangePending;
178begin
179 CompileVerification := ConfigChangePending;
180 Result := FALSE; // avoid compiler warning...
181end;
182{$HINTS ON}
183{$ENDREGION}
184
185var
186 DLLHandle: THandle = 0;
187
188procedure ClearProcPointers;
189begin
190 SRInitialize := nil;
191 SRShutDown := nil;
192 SRRegisterCustomBehavior := nil;
193 SRSpeakText := nil;
194 SRIsRunning := nil;
195 SRComponentData := nil;
196 SRConfigChangePending := nil;
197 DoInitialize := FALSE;
198 InitializeResult := FALSE;
199end;
200
201function InitializeScreenReaderLink: boolean;
202begin
203 if DoInitialize then
204 begin
205 InitializeResult := SRInitialize(ComponentDataRequested);
206 DoInitialize := FALSE;
207 if not InitializeResult then
208 CloseScreenReaderLink;
209 end;
210 Result := InitializeResult;
211end;
212
213procedure CloseScreenReaderLink;
214begin
215 if DLLHandle > HINSTANCE_ERROR then
216 begin
217 SRShutDown;
218 FreeLibrary(DLLHandle);
219 DLLHandle := 0;
220 ClearProcPointers;
221 end;
222end;
223
224procedure LoadScreenReader(index: integer);
225var
226 FileName: string;
227begin
228 FileName := ValidSRFiles[index];
229 DLLHandle := LoadLibrary(PChar(FileName));
230 if DLLHandle > HINSTANCE_ERROR then
231 begin
232 SRInitialize := GetProcAddress(DLLHandle, TVA508InitializeProcName);
233 SRShutDown := GetProcAddress(DLLHandle, TVA508ShutDownProcName);
234 SRRegisterCustomBehavior := GetProcAddress(DLLHandle, TVA508RegisterCustomBehaviorProcName);
235 SRSpeakText := GetProcAddress(DLLHandle, TVA508SpeakTextProcName);
236 SRIsRunning := GetProcAddress(DLLHandle, TVA508IsRunningFuncName);
237 SRComponentData := GetProcAddress(DLLHandle, TVA508ComponentDataProcName);
238 SRConfigChangePending := GetProcAddress(DLLHandle, TVA508ConfigChangePendingName);
239 DoInitialize := TRUE;
240 end;
241end;
242
243function CheckRunning(Unload: boolean; HighVersion, LowVersion: integer): boolean;
244begin
245// Calling IsRunning this way, instead of setting ok to it's result,
246// prevents ok from begin converted to a LongBool at compile time
247 if assigned(SRIsRunning) and SRIsRunning(HighVersion, LowVersion) then
248 Result := TRUE
249 else
250 Result := FALSE;
251 if Unload and (DLLHandle > HINSTANCE_ERROR)then
252 begin
253 FreeLibrary(DLLHandle);
254 DLLHandle := 0;
255 end;
256end;
257
258
259procedure FindScreenReaders;
260var
261 ok: boolean;
262
263 procedure CheckProcs;
264 begin
265 SRInitialize := GetProcAddress(DLLHandle, TVA508InitializeProcName);
266 ok := assigned(SRInitialize);
267 if ok then
268 begin
269 SRShutDown := GetProcAddress(DLLHandle, TVA508ShutDownProcName);
270 ok := assigned(SRShutDown);
271 if ok then
272 begin
273 SRRegisterCustomBehavior := GetProcAddress(DLLHandle, TVA508RegisterCustomBehaviorProcName);
274 ok := assigned(SRRegisterCustomBehavior);
275 if ok then
276 begin
277 SRSpeakText := GetProcAddress(DLLHandle, TVA508SpeakTextProcName);
278 ok := assigned(SRSpeakText);
279 if ok then
280 begin
281 SRIsRunning := GetProcAddress(DLLHandle, TVA508IsRunningFuncName);
282 ok := assigned(SRIsRunning);
283 if ok then
284 begin
285 SRComponentData := GetProcAddress(DLLHandle, TVA508ComponentDataProcName);
286 ok := assigned(SRComponentData);
287 if ok then
288 begin
289 SRConfigChangePending := GetProcAddress(DLLHandle, TVA508ConfigChangePendingName);
290 ok := assigned(SRConfigChangePending);
291 end;
292 end;
293 end;
294 end;
295 end;
296 end;
297 ClearProcPointers;
298 end;
299
300 procedure CheckFile(FileName: string);
301 var
302 idx: integer;
303 begin
304 DLLHandle := 0;
305 ok := FileExists(FileName);
306 if ok then
307 begin
308 ok := FALSE;
309 idx := ValidSRFiles.IndexOf(FileName);
310 if idx < 0 then
311 begin
312 DLLHandle := LoadLibrary(PChar(FileName));
313 if DLLHandle > HINSTANCE_ERROR then
314 begin
315 try
316 CheckProcs;
317 if ok then
318 ValidSRFiles.Add(FileName)
319 finally
320 FreeLibrary(DLLHandle);
321 DLLHandle := 0;
322 end;
323 end;
324 end;
325 end
326 end;
327
328 procedure ScanScreenReaders(dir: string; addCommonFilesPath: boolean = true);
329 var
330 SR: TSearchRec;
331 Done: integer;
332 RootDir: string;
333 begin
334 if dir = '' then exit;
335 RootDir := AppendBackSlash(dir);
336 if addCommonFilesPath then
337 RootDir := RootDir + ScreenReaderCommonFilesDir;
338 Done := FindFirst(RootDir + ScreenReaderSearchSpec, faAnyFile, SR);
339 try
340 while Done = 0 do
341 begin
342 if((SR.Attr and BadFile) = 0) and (CompareText(ExtractFileExt(SR.Name), ScreenReaderFileExtension) = 0) then
343 begin
344 CheckFile(RootDir + SR.Name);
345 end;
346 Done := FindNext(SR);
347 end;
348 finally
349 FindClose(SR);
350 end;
351 end;
352
353begin
354 if ExecuteFind then
355 begin
356 if not assigned(ValidSRFiles) then
357 ValidSRFiles := TStringList.Create;
358 ScanScreenReaders(GetProgramFilesPath);
359 if not ok then
360 ScanScreenReaders(GetAlternateProgramFilesPath);
361 if not ok then
362 ScanScreenReaders(ExtractFilePath(Application.ExeName), FALSE);
363 ExecuteFind := FALSE;
364 end;
365end;
366
367function ScreenReaderDLLsExist: boolean;
368begin
369 FindScreenReaders;
370 Result := (ValidSRFiles.Count > 0);
371end;
372
373function IsScreenReaderSupported(Unload: Boolean): boolean;
374var
375 i: integer;
376 HighVersion, LowVersion: integer;
377begin
378 Result := FALSE;
379 FindScreenReaders;
380 VersionStringSplit(VA508AccessibilityManagerVersion, HighVersion, LowVersion);
381 for I := 0 to ValidSRFiles.Count - 1 do
382 begin
383 LoadScreenReader(i);
384 Result := CheckRunning(Unload, HighVersion, LowVersion);
385 if Result then exit;
386 if not Unload then
387 begin
388 FreeLibrary(DLLHandle);
389 DLLHandle := 0;
390 end;
391 end;
392end;
393
394initialization
395
396finalization
397 CloseScreenReaderLink;
398 if assigned(ValidSRFiles) then
399 FreeAndNil(ValidSRFiles);
400
401end.
Note: See TracBrowser for help on using the repository browser.