source: cprs/trunk/VA/VA508Accessibility/JAWS/JAWSImplementation.pas@ 1071

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

Upgrade to version 27

File size: 44.2 KB
Line 
1unit JAWSImplementation;
2
3interface
4{ DONE -oJeremy Merrill -c508 :
5Add something that prevents overwriting of the script files if another
6app is running that's using the JAWS DLL }
7{ TODO -oJeremy Merrill -c508 : Add check in here to look at script version in JSS file }
8{ DONE -oJeremy Merrill -c508 :
9Replace registry communication with multiple windows - save strings in the window titles
10Use EnumerateChildWindows jaws script function in place of the FindWindow function
11that's being used right now.- EnumerateChildWindows with a window handle of 0
12enumerates all windows on the desktop. Will have to use the first part of the window
13title as an ID, and the last part as the string values. Will need to check for a maximum
14string lenght, probably have to use multiple windows for long text.
15Will also beed to have a global window shared by muiltiple instances of the JAWS.SR DLL. }
16{ DONE -oJeremy Merrill -c508 :
17Need to add version checking to TVA508AccessibilityManager component
18and JAWS.DLL. Warning needs to display just like JAWS.DLL and JAWS. }
19uses SysUtils, Windows, Classes, Registry, StrUtils, Forms, Dialogs,
20 ExtCtrls, VAUtils, DateUtils, PSApi, IniFiles, ActiveX,
21 SHFolder, ShellAPI, VA508AccessibilityConst;
22
23{$I 'VA508ScreenReaderDLLStandard.inc'}
24
25{ DONE -oJeremy Merrill -c508 :Figure out why Delphi IDE is loading the DLL when JAWS is running -
26probably has something to do with the VA508 package being installed -
27need to test for csDesigning some place that we're not testing for (maybe?)}
28
29exports Initialize, ShutDown, RegisterCustomBehavior, ComponentData,
30 SpeakText, IsRunning, ConfigChangePending;
31
32implementation
33
34uses fVA508HiddenJawsMainWindow, FSAPILib_TLB, ComObj;
35
36const
37// JAWS_REQUIRED_VERSION = '7.10.500'; in VA508AccessibilityConst unit
38 JAWS_COM_OBJECT_VERSION = '8.0.2173';
39
40 VA508_REG_PARAM_KEY = 'Software\Vista\508\JAWS';
41
42 VA508_REG_COMPONENT_CAPTION = 'Caption';
43 VA508_REG_COMPONENT_VALUE = 'Value';
44 VA508_REG_COMPONENT_CONTROL_TYPE = 'ControlType';
45 VA508_REG_COMPONENT_STATE = 'State';
46 VA508_REG_COMPONENT_INSTRUCTIONS = 'Instructions';
47 VA508_REG_COMPONENT_ITEM_INSTRUCTIONS = 'ItemInstructions';
48 VA508_REG_COMPONENT_DATA_STATUS = 'DataStatus';
49
50 VA508_ERRORS_SHOWN_STATE = 'ErrorsShown';
51
52 RELOAD_CONFIG_SCRIPT = 'VA508Reload';
53
54 SLASH = '\';
55{ TODO -oJeremy Merrill -c508 :
56Change APP_DATA so that "application data" isn't used - Windows Vista
57doesn't use this value - get data from Windows API call }
58 APP_DATA = SLASH + 'application data' + SLASH;
59 JAWS_COMMON_SCRIPT_PATH_TEXT = '\freedom scientific\jaws\';
60 JAWS_COMMON_SCRIPT_PATH_TEXT_LEN = length(JAWS_COMMON_SCRIPT_PATH_TEXT);
61
62type
63 TCompareType = (jcPrior, jcINI, jcLineItems, jcVersion, jcScriptMerge);
64
65 TFileInfo = record
66 AppFile: boolean;
67 Ext: string;
68 CompareType: TCompareType;
69 Required: boolean;
70 Compile: boolean;
71 end;
72
73const
74 JAWS_SCRIPT_NAME = 'VA508JAWS';
75
76 JAWS_SCRIPT_VERSION = 'VA508_Script_Version';
77 CompiledScriptFileExtension = '.JSB';
78 ScriptFileExtension = '.JSS';
79 ScriptDocExtension = '.JSD';
80 ConfigFileExtension = '.JCF';
81 KeyMapExtension = '.JKM';
82 DictionaryFileExtension = '.JDF';
83
84 FileInfo: array[1..6] of TFileInfo = (
85 (AppFile: FALSE; Ext: ScriptFileExtension; CompareType: jcVersion; Required: TRUE; Compile: TRUE),
86 (AppFile: FALSE; Ext: ScriptDocExtension; CompareType: jcPrior; Required: TRUE; Compile: FALSE),
87 (AppFile: TRUE; Ext: ScriptFileExtension; CompareType: jcScriptMerge; Required: TRUE; Compile: TRUE),
88 (AppFile: TRUE; Ext: ConfigFileExtension; CompareType: jcINI; Required: TRUE; Compile: FALSE),
89 (AppFile: TRUE; Ext: DictionaryFileExtension; CompareType: jcLineItems; Required: FALSE; Compile: FALSE),
90 (AppFile: TRUE; Ext: KeyMapExtension; CompareType: jcINI; Required: FALSE; Compile: FALSE));
91
92 JAWS_VERSION_ERROR = ERROR_INTRO +
93 'The Accessibility Framework can only communicate with JAWS ' + JAWS_REQUIRED_VERSION + CRLF +
94 'or later versions. Please update your version of JAWS to a minimum of' + CRLF +
95 JAWS_REQUIRED_VERSION + ', or preferably the most recent release, to allow the Accessibility' + CRLF +
96 'Framework to communicate with JAWS. If you are getting this message' + CRLF +
97 'and you already have a compatible version of JAWS, please contact your' + CRLF +
98 'system administrator, and request that they run, with administrator rights,' + CRLF +
99 'the JAWSUpdate application located in the \Program Files\VistA\' + CRLF +
100 'Common Files directory. JAWSUpdate is not required for JAWS' + CRLF +
101 'versions ' + JAWS_COM_OBJECT_VERSION + ' and above.' + CRLF;
102
103 JAWS_FILE_ERROR = ERROR_INTRO +
104 'The JAWS interface with the Accessibility Framework requires the ability' + CRLF +
105 'to write files to the hard disk, but the following error is occurring trying to' + CRLF +
106 'write to the disk:' + CRLF + '%s' + CRLF +
107 'Please contact your system administrator in order to ensure that your ' + CRLF +
108 'security privileges allow you to write files to the hard disk.' + CRLF +
109 'If you are sure you have these privileges, your hard disk may be full. Until' + CRLF +
110 'this problem is resolved, the Accessibility Framework will not be able to' + CRLF +
111 'communicate with JAWS.';
112
113 JAWS_USER_MISSMATCH_ERROR = ERROR_INTRO +
114 'An error has been detected in the state of JAWS that will not allow the' + CRLF +
115 'Accessibility Framework to communicate with JAWS until JAWS is shut' + CRLF +
116 'down and restarted. Please restart JAWS at this time.';
117
118 DLL_VERSION_ERROR = ERROR_INTRO +
119 'The Accessibility Framework is at version %s, but the required JAWS' + CRLF +
120 'support files are only at version %s. The new support files should have' + CRLF +
121 'been released with the latest version of the software you are currently' + CRLF +
122 'running. The Accessibility Framework will not be able to communicate' + CRLF +
123 'with JAWS until these support files are installed. Please contact your' + CRLF +
124 'system administrator for assistance.';
125
126 JAWS_ERROR_VERSION = 1;
127 JAWS_ERROR_FILE_IO = 2;
128 JAWS_ERROR_USER_PROBLEM = 3;
129 DLL_ERROR_VERSION = 4;
130
131 JAWS_ERROR_COUNT = 4;
132
133 JAWS_RELOAD_DELAY = 500;
134
135var
136 JAWSErrorMessage: array[1..JAWS_ERROR_COUNT] of string = (JAWS_VERSION_ERROR, JAWS_FILE_ERROR,
137 JAWS_USER_MISSMATCH_ERROR, DLL_VERSION_ERROR);
138
139 JAWSErrorsShown: array[1..JAWS_ERROR_COUNT] of boolean = (FALSE, FALSE, FALSE, FALSE);
140
141type
142 TJAWSSayString = function(StringToSpeak: PChar; Interrupt: BOOL): BOOL; stdcall;
143 TJAWSRunScript = function(ScriptName: PChar): BOOL; stdcall;
144
145 TStartupID = record
146 Handle: HWND;
147 InstanceID: Integer;
148 MsgID: Integer;
149 end;
150
151 TJAWSManager = class
152 strict private
153 FRequiredFilesFound: boolean;
154 FMainForm: TfrmVA508HiddenJawsMainWindow;
155 FWasShutdown: boolean;
156 FJAWSFileError: string;
157 FDictionaryFileName: string;
158 FConfigFile: string;
159 FKeyMapFile: string;
160 FMasterApp: string;
161 FRootScriptFileName: string;
162 FRootScriptAppFileName: string;
163 FDefaultScriptDir: string;
164 FUserStriptDir: string;
165 FKeyMapINIFile: TINIFile;
166 FKeyMapINIFileModified: boolean;
167 FAssignedKeys: TStringList;
168 FConfigINIFile: TINIFile;
169 FConfigINIFileModified: boolean;
170 FDictionaryFile: TStringList;
171 FDictionaryFileModified: boolean;
172 FCompiler: string;
173 JAWSAPI: IJawsApi;
174 private
175 procedure ShutDown;
176 procedure MakeFileWritable(FileName: string);
177 procedure LaunchMasterApplication;
178 procedure KillINIFiles(Sender: TObject);
179 procedure ReloadConfiguration;
180 public
181 constructor Create;
182 destructor Destroy; override;
183 class procedure ShowError(ErrorNumber: integer); overload;
184 class procedure ShowError(ErrorNumber: integer; data: array of const); overload;
185 class function GetPathFromJAWS(PathID: integer; DoLowerCase: boolean = TRUE): string;
186 class function GetJAWSWindow: HWnd;
187 class function IsRunning(HighVersion, LowVersion: Word): BOOL;
188 function Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL;
189 procedure SendComponentData(WindowHandle: HWND; DataStatus: LongInt; Caption, Value, Data,
190 ControlType, State, Instructions, ItemInstructions: PChar);
191 procedure SpeakText(Text: PChar);
192 procedure RegisterCustomBehavior(Before, After: string; Action: integer);
193 class function JAWSVersionOK: boolean;
194 class function JAWSTalking2CurrentUser: boolean;
195 function FileErrorExists: boolean;
196 property RequiredFilesFound: boolean read FRequiredFilesFound;
197 property MainForm: TfrmVA508HiddenJawsMainWindow read FMainForm;
198 end;
199
200var
201 JAWSManager: TJAWSManager = nil;
202 DLLMessageID: UINT = 0;
203
204procedure EnsureManager;
205begin
206 if not assigned(JAWSManager) then
207 JAWSManager := TJAWSManager.Create;
208end;
209
210// Checks to see if the screen reader is currently running
211function IsRunning(HighVersion, LowVersion: Word): BOOL; stdcall;
212begin
213 Result := TJAWSManager.IsRunning(HighVersion, LowVersion);
214end;
215
216// Executed after IsRunning returns TRUE, when the DLL is accepted as the screen reader of choice
217function Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL; stdcall;
218begin
219 EnsureManager;
220 Result := JAWSManager.Initialize(ComponentCallBackProc);
221end;
222
223// Executed when the DLL is unloaded or screen reader is no longer needed
224procedure ShutDown; stdcall;
225begin
226 if assigned(JAWSManager) then
227 begin
228 JAWSManager.ShutDown;
229 FreeAndNil(JAWSManager);
230 end;
231end;
232
233function ConfigChangePending: boolean; stdcall;
234begin
235 Result := FALSE;
236 if assigned(JAWSManager) and assigned(JAWSManager.MainForm) and
237 (JAWSManager.MainForm.ConfigChangePending) then
238 Result := TRUE;
239end;
240
241// Returns Component Data as requested by the screen reader
242procedure ComponentData(WindowHandle: HWND;
243 DataStatus: LongInt = DATA_NONE;
244 Caption: PChar = nil;
245 Value: PChar = nil;
246 Data: PChar = nil;
247 ControlType: PChar = nil;
248 State: PChar = nil;
249 Instructions: PChar = nil;
250 ItemInstructions: PChar = nil); stdcall;
251begin
252 EnsureManager;
253 JAWSManager.SendComponentData(WindowHandle, DataStatus, Caption, Value, Data, ControlType, State,
254 Instructions, ItemInstructions);
255end;
256
257// Instructs the Screen Reader to say the specified text
258procedure SpeakText(Text: PChar); stdcall;
259begin
260 EnsureManager;
261 JAWSManager.SpeakText(Text);
262end;
263
264procedure RegisterCustomBehavior(BehaviorType: integer; Before, After: PChar);
265begin
266 EnsureManager;
267 JAWSManager.RegisterCustomBehavior(Before, After, BehaviorType);
268end;
269
270{ TJAWSManager }
271
272const
273{$WARNINGS OFF} // Don't care about platform specific warning
274 NON_WRITABLE_FILE_ATTRIB = faReadOnly or faHidden;
275{$WARNINGS ON}
276 WRITABLE_FILE_ATTRIB = faAnyFile and (not NON_WRITABLE_FILE_ATTRIB);
277
278procedure TJAWSManager.MakeFileWritable(FileName: string);
279var
280 Attrib: integer;
281begin
282 {$WARNINGS OFF} // Don't care about platform specific warning
283 Attrib := FileGetAttr(FileName);
284 {$WARNINGS ON}
285 if (Attrib and NON_WRITABLE_FILE_ATTRIB) <> 0 then
286 begin
287 Attrib := Attrib and WRITABLE_FILE_ATTRIB;
288 {$WARNINGS OFF} // Don't care about platform specific warning
289 if FileSetAttr(FileName, Attrib) <> 0 then
290 {$WARNINGS ON}
291 FJAWSFileError := 'Could not change read-only attribute of file "' + FileName + '"';
292 end;
293end;
294
295var
296 JAWSMsgID: UINT = 0;
297
298const
299 JAWS_MESSAGE_ID = 'JW_GET_FILE_PATH';
300 // version is in directory after JAWS \Freedom Scientific\JAWS\*.*\...
301 JAWS_PATH_ID_APPLICATION = 0;
302 JAWS_PATH_ID_USER_SCRIPT_FILES = 1;
303 JAWS_PATH_ID_JAWS_DEFAULT_SCRIPT_FILES = 2;
304// 0 = C:\Program Files\Freedom Scientific\JAWS\8.0\jfw.INI
305// 1 = D:\Documents and Settings\vhaislmerrij\Application Data\Freedom Scientific\JAWS\8.0\USER.INI
306// 2 = D:\Documents and Settings\All Users\Application Data\Freedom Scientific\JAWS\8.0\Settings\enu\DEFAULT.SBL
307
308class function TJAWSManager.GetPathFromJAWS(PathID: integer; DoLowerCase: boolean = TRUE): string;
309var
310 atm: ATOM;
311 len: integer;
312 path: string;
313 JAWSWindow: HWnd;
314begin
315 JAWSWindow := GetJAWSWindow;
316 if JAWSMsgID = 0 then
317 JAWSMsgID := RegisterWindowMessage(JAWS_MESSAGE_ID);
318 Result := '';
319 atm := SendMessage(JAWSWindow, JAWSMsgID, PathID, 0);
320 if atm <> 0 then
321 begin
322 SetLength(path, MAX_PATH * 2);
323 len := GlobalGetAtomName(atm, PChar(path), MAX_PATH * 2);
324 GlobalDeleteAtom(atm);
325 if len > 0 then
326 begin
327 SetLength(path, len);
328 Result := ExtractFilePath(path);
329 if DoLowerCase then
330 Result := LowerCase(Result);
331 end;
332 end;
333end;
334
335
336constructor TJAWSManager.Create;
337const
338 COMPILER_FILENAME = 'scompile.exe';
339 JAWS_APP_NAME = 'VA508APP';
340 JAWSMasterApp = 'VA508JAWSDispatcher.exe';
341
342 procedure FindCompiler;
343 var
344 compiler: string;
345
346 begin
347 compiler := GetPathFromJAWS(JAWS_PATH_ID_APPLICATION);
348 compiler := AppendBackSlash(compiler) + COMPILER_FILENAME;
349 if FileExists(compiler) then
350 FCompiler := compiler;
351 end;
352
353 procedure FindJAWSRequiredFiles;
354 var
355 Path: string;
356 i: integer;
357 FileName: string;
358 info: TFileInfo;
359
360 begin
361 SetLength(Path, MAX_PATH);
362 SetLength(Path, GetModuleFileName(HInstance, PChar(Path), Length(Path)));
363 Path := ExtractFilePath(Path);
364 Path := AppendBackSlash(Path);
365 // look for the script files in the same directory as this DLL
366 FRootScriptFileName := Path + JAWS_SCRIPT_NAME;
367 FRootScriptAppFileName := Path + JAWS_APP_NAME;
368 FRequiredFilesFound := TRUE;
369 for i := low(FileInfo) to high(FileInfo) do
370 begin
371 info := FileInfo[i];
372 if info.Required then
373 begin
374 if info.AppFile then
375 FileName := FRootScriptAppFileName + info.Ext
376 else
377 FileName := FRootScriptFileName + info.Ext;
378 if not FileExists(FileName) then
379 begin
380 FRequiredFilesFound := FALSE;
381 break;
382 end;
383 end;
384 end;
385 if FRequiredFilesFound then
386 begin
387 FMasterApp := Path + JAWSMasterApp;
388 FRequiredFilesFound := FileExists(FMasterApp);
389 end;
390 if FRequiredFilesFound then
391 begin
392 FDefaultScriptDir := lowercase(GetPathFromJAWS(JAWS_PATH_ID_JAWS_DEFAULT_SCRIPT_FILES));
393 FRequiredFilesFound := (pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FDefaultScriptDir) > 0);
394 end;
395 if FRequiredFilesFound then
396 begin
397 FUserStriptDir := lowercase(GetPathFromJAWS(JAWS_PATH_ID_USER_SCRIPT_FILES));
398 FRequiredFilesFound := (pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FUserStriptDir) > 0);
399 end;
400 end;
401
402begin
403 FindCompiler;
404 if FCompiler <> '' then
405 FindJAWSRequiredFiles;
406end;
407
408destructor TJAWSManager.Destroy;
409begin
410 ShutDown;
411 inherited;
412end;
413
414function TJAWSManager.FileErrorExists: boolean;
415begin
416 Result := (FJAWSFileError <> '');
417end;
418
419
420class function TJAWSManager.GetJAWSWindow: HWnd;
421const
422 VISIBLE_WINDOW_CLASS: PChar = 'JFWUI2';
423 VISIBLE_WINDOW_TITLE: PChar = 'JAWS';
424 VISIBLE_WINDOW_TITLE2: PChar = 'Remote JAWS';
425
426begin
427 Result := FindWindow(VISIBLE_WINDOW_CLASS, VISIBLE_WINDOW_TITLE);
428 if Result = 0 then
429 Result := FindWindow(VISIBLE_WINDOW_CLASS, VISIBLE_WINDOW_TITLE2);
430end;
431
432function TJAWSManager.Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL;
433var
434 DestPath: string;
435 ScriptFileChanges: boolean;
436 LastFileUpdated: boolean;
437 CompileCommands: TStringList;
438 AppScriptNeedsFunction: boolean;
439 AppNeedsUseLine: boolean;
440 AppUseLine: string;
441 AppStartFunctionLine: integer;
442
443 procedure EnsureWindow;
444 begin
445 if not assigned(FMainForm) then
446 FMainForm := TfrmVA508HiddenJawsMainWindow.Create(nil);
447 FMainForm.ComponentDataCallBackProc := ComponentCallBackProc;
448 FMainForm.ConfigReloadProc := ReloadConfiguration;
449 FMainForm.HandleNeeded;
450 Application.ProcessMessages;
451 end;
452
453
454 function GetVersion(FileName: string): integer;
455 var
456 list: TStringList;
457
458 p,i: integer;
459 line: string;
460 working: boolean;
461 begin
462 Result := 0;
463 list := TStringList.Create;
464 try
465 list.LoadFromFile(FileName);
466 i := 0;
467 working := TRUE;
468 while working and (i < list.Count) do
469 begin
470 line := list[i];
471 p := pos('=', line);
472 if p > 0 then
473 begin
474 if trim(copy(line,1,p-1)) = JAWS_SCRIPT_VERSION then
475 begin
476 line := trim(copy(line,p+1,MaxInt));
477 if copy(line,length(line), 1) = ',' then
478 delete(line,length(line),1);
479 Result := StrToIntDef(line, 0);
480 working := FALSE;
481 end;
482 end;
483 inc(i);
484 end;
485 finally
486 list.Free;
487 end;
488 end;
489
490 function VersionDifferent(FromFile, ToFile: string): boolean;
491 var
492 FromVersion, ToVersion: integer;
493 begin
494 FromVersion := GetVersion(FromFile);
495 ToVersion := GetVersion(ToFile);
496 Result := (FromVersion > ToVersion);
497 end;
498
499 function LineItemUpdateNeeded(FromFile, ToFile: string): boolean;
500 var
501 fromList, toList: TStringList;
502 i, idx: integer;
503 line: string;
504 begin
505 Result := FALSE;
506 fromList := TStringList.Create;
507 toList := TStringList.Create;
508 try
509 fromList.LoadFromFile(FromFile);
510 toList.LoadFromFile(toFile);
511 for i := 0 to fromList.Count - 1 do
512 begin
513 line := fromList[i];
514 if trim(line) <> '' then
515 begin
516 idx := toList.IndexOf(line);
517 if idx < 0 then
518 begin
519 Result := TRUE;
520 break;
521 end;
522 end;
523 end;
524 finally
525 toList.Free;
526 fromList.Free;
527 end;
528 end;
529
530 function INIUpdateNeeded(FromFile, ToFile: string): boolean;
531 var
532 FromINIFile, ToINIFile: TIniFile;
533 Sections, Values: TStringList;
534 i, j: integer;
535 section, key, val1, val2: string;
536 begin
537 Result := FALSE;
538 Sections := TStringList.Create;
539 Values := TStringList.Create;
540 try
541 FromINIFile := TIniFile.Create(FromFile);
542 try
543 ToINIFile := TIniFile.Create(ToFile);
544 try
545 FromINIFile.ReadSections(Sections);
546 for i := 0 to Sections.count-1 do
547 begin
548 section := Sections[i];
549 FromINIFile.ReadSectionValues(section, Values);
550 for j := 0 to Values.Count - 1 do
551 begin
552 key := Values.Names[j];
553 val1 := Values.ValueFromIndex[j];
554 val2 := ToINIFile.ReadString(Section, key, '');
555 result := (val1 <> val2);
556 if Result then
557 break;
558 end;
559 if Result then
560 break;
561 end;
562 finally
563 ToINIFile.Free;
564 end;
565 finally
566 FromINIFile.Free;
567 end;
568 finally
569 Sections.Free;
570 Values.Free;
571 end;
572 end;
573
574 function IsUseLine(data: string): boolean;
575 var
576 p: integer;
577 begin
578 Result := (copy(data,1,4) = 'use ');
579 if Result then
580 begin
581 Result := FALSE;
582 p := pos('"', data);
583 if p > 0 then
584 begin
585 p := posEX('"', data, p+1);
586 if p = length(data) then
587 Result := TRUE;
588 end;
589 end;
590 end;
591
592 function IsFunctionLine(data: string): boolean;
593 var
594 p1, p2: integer;
595 line: string;
596 begin
597 Result := FALSE;
598 line := data;
599 p1 := pos(' ', line);
600 if (p1 > 0) then
601 begin
602 if copy(line,1,p1-1) = 'script' then
603 Result := true
604 else
605 begin
606 p2 := posEx(' ', line, p1+1);
607 if p2 > 0 then
608 begin
609 line := copy(line, p1+1, p2-p1-1);
610 if (line = 'function') then
611 Result := TRUE;
612 end;
613 end;
614 end;
615 end;
616
617 function CheckForUseLineAndFunction(FromFile, ToFile: string): boolean;
618 var
619 FromData: TStringList;
620 ToData: TStringList;
621 UseLine: string;
622 i: integer;
623 line: string;
624
625 begin
626 Result := FALSE;
627 FromData := TStringList.create;
628 ToData := TStringList.create;
629 try
630 UseLine := '';
631 AppUseLine := '';
632 AppStartFunctionLine := -1;
633 FromData.LoadFromFile(FromFile);
634 for i := 0 to FromData.Count - 1 do
635 begin
636 line := lowerCase(trim(FromData[i]));
637 if (UseLine = '') and IsUseLine(line) then
638 begin
639 UseLine := line;
640 AppUseLine := FromData[i];
641 end
642 else
643 if (AppStartFunctionLine < 0) and IsFunctionLine(line) then
644 AppStartFunctionLine := i;
645 if (UseLine <> '') and (AppStartFunctionLine >= 0) then break;
646 end;
647 if (UseLine = '') or (AppStartFunctionLine < 0) then exit;
648
649 AppNeedsUseLine := TRUE;
650 AppScriptNeedsFunction := TRUE;
651 ToData.LoadFromFile(ToFile);
652 for i := 0 to ToData.Count - 1 do
653 begin
654 line := lowerCase(trim(ToData[i]));
655 if AppNeedsUseLine and IsUseLine(line) and (line = UseLine) then
656 AppNeedsUseLine := FALSE
657 else
658 if AppScriptNeedsFunction and IsFunctionLine(line) then
659 AppScriptNeedsFunction := FALSE;
660 if (not AppNeedsUseLine) and (not AppScriptNeedsFunction) then break;
661 end;
662 if AppNeedsUseLine or AppScriptNeedsFunction then
663 Result := TRUE;
664 finally
665 FromData.free;
666 ToData.free;
667 end;
668 end;
669
670 function UpdateNeeded(FromFile, ToFile: string; CompareType: TCompareType): boolean;
671 begin
672 Result := TRUE;
673 try
674 case CompareType of
675 jcScriptMerge: Result := CheckForUseLineAndFunction(FromFile, ToFile);
676 jcPrior: Result := LastFileUpdated;
677 jcVersion: Result := VersionDifferent(FromFile, ToFile);
678 jcINI: Result := INIUpdateNeeded(FromFile, ToFile);
679 jcLineItems: Result := LineItemUpdateNeeded(FromFile, ToFile);
680 end;
681 except
682 on E: Exception do
683 FJAWSFileError := E.Message;
684 end;
685 end;
686
687 procedure INIFileUpdate(FromFile, ToFile: String);
688 var
689 FromINIFile, ToINIFile: TIniFile;
690 Sections, Values: TStringList;
691 i, j: integer;
692 section, key, val1, val2: string;
693 modified: boolean;
694 begin
695 modified := FALSE;
696 Sections := TStringList.Create;
697 Values := TStringList.Create;
698 try
699 FromINIFile := TIniFile.Create(FromFile);
700 try
701 ToINIFile := TIniFile.Create(ToFile);
702 try
703 FromINIFile.ReadSections(Sections);
704 for i := 0 to Sections.count-1 do
705 begin
706 section := Sections[i];
707 FromINIFile.ReadSectionValues(section, Values);
708 for j := 0 to Values.Count - 1 do
709 begin
710 key := Values.Names[j];
711 val1 := Values.ValueFromIndex[j];
712 val2 := ToINIFile.ReadString(Section, key, '');
713 if (val1 <> val2) then
714 begin
715 ToINIFile.WriteString(section, key, val1);
716 modified := TRUE;
717 end;
718 end;
719 end;
720 finally
721 if modified then
722 ToINIFile.UpdateFile();
723 ToINIFile.Free;
724 end;
725 finally
726 FromINIFile.Free;
727 end;
728 finally
729 Sections.Free;
730 Values.Free;
731 end;
732 end;
733
734 procedure LineItemFileUpdate(FromFile, ToFile: string);
735 var
736 fromList, toList: TStringList;
737 i, idx: integer;
738 line: string;
739 modified: boolean;
740 begin
741 modified := FALSE;
742 fromList := TStringList.Create;
743 toList := TStringList.Create;
744 try
745 fromList.LoadFromFile(FromFile);
746 toList.LoadFromFile(toFile);
747 for i := 0 to fromList.Count - 1 do
748 begin
749 line := fromList[i];
750 if trim(line) <> '' then
751 begin
752 idx := toList.IndexOf(line);
753 if idx < 0 then
754 begin
755 toList.Add(line);
756 modified := TRUE;
757 end;
758 end;
759 end;
760 finally
761 if Modified then
762 toList.SaveToFile(ToFile);
763 toList.Free;
764 fromList.Free;
765 end;
766 end;
767
768 procedure DeleteCompiledFile(ToFile: string);
769 var
770 CompiledFile: string;
771 begin
772 CompiledFile := copy(ToFile, 1, length(ToFile) - length(ExtractFileExt(ToFile)));
773 CompiledFile := CompiledFile + CompiledScriptFileExtension;
774 if FileExists(CompiledFile) then
775 begin
776 MakeFileWritable(CompiledFile);
777 DeleteFile(PChar(CompiledFile));
778 end;
779 end;
780
781 function DoScriptMerge(FromFile, ToFile: string): boolean;
782 var
783 BackupFile: string;
784 FromData: TStringList;
785 ToData: TStringList;
786 i, idx: integer;
787 ExitCode: integer;
788 begin
789 Result := TRUE;
790 BackupFile := ToFile + '.BACKUP';
791 if FileExists(BackupFile) then
792 begin
793 MakeFileWritable(BackupFile);
794 DeleteFile(PChar(BackupFile));
795 end;
796 DeleteCompiledFile(ToFile);
797 CopyFile(PChar(ToFile), PChar(BackupFile), FALSE);
798 MakeFileWritable(ToFile);
799 FromData := TStringList.create;
800 ToData := TStringList.create;
801 try
802 ToData.LoadFromFile(ToFile);
803 if AppNeedsUseLine then
804 ToData.Insert(0, AppUseLine);
805 if AppScriptNeedsFunction then
806 begin
807 FromData.LoadFromFile(FromFile);
808 ToData.Insert(1,'');
809 idx := 2;
810 for i := AppStartFunctionLine to FromData.Count - 1 do
811 begin
812 ToData.Insert(idx, FromData[i]);
813 inc(idx);
814 end;
815 ToData.Insert(idx,'');
816 end;
817 if not assigned(JAWSAPI) then
818 JAWSAPI := CoJawsApi.Create;
819 ToData.SaveToFile(ToFile);
820 ExitCode := ExecuteAndWait('"' + FCompiler + '"', '"' + ToFile + '"');
821 JAWSAPI.StopSpeech;
822 if ExitCode = 0 then // compile succeeded!
823 ReloadConfiguration
824 else
825 Result := FALSE; // compile failed - just copy the new one
826 finally
827 FromData.free;
828 ToData.free;
829 end;
830 end;
831
832 procedure UpdateFile(FromFile, ToFile: string; info: TFileInfo);
833 var
834 DoCopy: boolean;
835 error: boolean;
836 CheckOverwrite: boolean;
837 begin
838 DoCopy := FALSE;
839 if FileExists(ToFile) then
840 begin
841 MakeFileWritable(ToFile);
842 CheckOverwrite := TRUE;
843 try
844 case info.CompareType of
845 jcScriptMerge: if not DoScriptMerge(FromFile, ToFile) then DoCopy := TRUE;
846 jcPrior, jcVersion: DoCopy := TRUE;
847 jcINI: INIFileUpdate(FromFile, ToFile);
848 jcLineItems: LineItemFileUpdate(FromFile, ToFile);
849 end;
850 except
851 on E: Exception do
852 FJAWSFileError := E.Message;
853 end;
854 end
855 else
856 begin
857 CheckOverwrite := FALSE;
858 DoCopy := TRUE;
859 end;
860 if DoCopy then
861 begin
862 error := FALSE;
863 if not CopyFile(PChar(FromFile), PChar(Tofile), FALSE) then
864 error := TRUE;
865 if (not error) and (not FileExists(ToFile)) then
866 error := TRUE;
867 if (not error) and CheckOverwrite and (info.CompareType <> jcPrior) and
868 UpdateNeeded(FromFile, ToFile, info.CompareType) then
869 error := TRUE;
870 if error and (not FileErrorExists) then
871 FJAWSFileError := 'Error copying "' + FromFile + '" to' + CRLF + '"' + ToFile + '".';
872 if (not error) and (info.Compile) then
873 begin
874 DeleteCompiledFile(ToFile);
875 CompileCommands.Add('"' + ToFile + '"');
876 end;
877 end;
878 end;
879
880 procedure EnsureJAWSScriptsAreUpToDate;
881 var
882 DestFile, FromFile, ToFile, AppName, ext: string;
883 idx1, idx2, i: integer;
884 DoUpdate: boolean;
885 info: TFileInfo;
886
887 begin
888 AppName := ExtractFileName(ParamStr(0));
889 ext := ExtractFileExt(AppName);
890 AppName := LeftStr(AppName, length(AppName) - Length(ext));
891 DestPath := '';
892 idx1 := pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FUserStriptDir);
893 idx2 := pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FDefaultScriptDir);
894 if (idx1 > 0) and (idx2 > 0) then
895 begin
896 DestPath := copy(FUserStriptDir,1,idx1-1) + copy(FDefaultScriptDir, idx2, MaxInt);
897 DestFile := DestPath + AppName;
898 FDictionaryFileName := DestFile + DictionaryFileExtension;
899 FConfigFile := DestFile + ConfigFileExtension;
900 FKeyMapFile := DestFile + KeyMapExtension;
901 LastFileUpdated := FALSE;
902 for i := low(FileInfo) to high(FileInfo) do
903 begin
904 info := FileInfo[i];
905 if info.AppFile then
906 begin
907 FromFile := FRootScriptAppFileName + info.Ext;
908 ToFile := DestFile + info.Ext;
909 end
910 else
911 begin
912 FromFile := FRootScriptFileName + info.Ext;
913 ToFile := DestPath + JAWS_SCRIPT_NAME + info.Ext;
914 end;
915 if not FileExists(FromFile) then continue;
916 if FileExists(ToFile) then
917 begin
918 DoUpdate := UpdateNeeded(FromFile, ToFile, info.CompareType);
919 if DoUpdate then
920 MakeFileWritable(ToFile);
921 end
922 else
923 DoUpdate := TRUE;
924 LastFileUpdated := DoUpdate;
925 if DoUpdate and (not FileErrorExists) then
926 begin
927 UpdateFile(FromFile, ToFile, info);
928 ScriptFileChanges := TRUE;
929 end;
930 if FileErrorExists then
931 break;
932 end;
933 end
934 else
935 FJAWSFileError := 'Unknown File Error'; // should never happen - condition checked previously
936 end;
937
938 procedure DoCompiles;
939 var
940 i: integer;
941 begin
942 if not assigned(JAWSAPI) then
943 JAWSAPI := CoJawsApi.Create;
944 for i := 0 to CompileCommands.Count - 1 do
945 begin
946 ExecuteAndWait('"' + FCompiler + '"', CompileCommands[i]);
947 JAWSAPI.StopSpeech;
948 end;
949 ReloadConfiguration;
950 end;
951
952begin
953 Result := FALSE;
954 ScriptFileChanges := FALSE;
955 if JAWSManager.RequiredFilesFound then
956 begin
957 FJAWSFileError := '';
958 CompileCommands := TStringList.Create;
959 try
960 EnsureJAWSScriptsAreUpToDate;
961 if CompileCommands.Count > 0 then
962 DoCompiles;
963 finally
964 CompileCommands.Free;
965 end;
966 if FileErrorExists then
967 ShowError(JAWS_ERROR_FILE_IO, [FJAWSFileError])
968 else if JAWSTalking2CurrentUser then
969 begin
970 EnsureWindow;
971 LaunchMasterApplication;
972 if ScriptFileChanges then
973 begin
974 FMainForm.ConfigReloadNeeded;
975 end;
976 Result := TRUE;
977 end;
978 end;
979end;
980
981class function TJAWSManager.IsRunning(HighVersion, LowVersion: Word): BOOL;
982
983 function ComponentVersionSupported: boolean;
984 var
985 SupportedHighVersion, SupportedLowVersion: integer;
986 FileName, newVersion, convertedVersion, currentVersion: string;
987 addr: pointer;
988
989 begin
990 addr := @TJAWSManager.IsRunning;
991 FileName := GetDLLFileName(addr);
992 currentVersion := FileVersionValue(FileName, FILE_VER_FILEVERSION);
993 VersionStringSplit(currentVersion, SupportedHighVersion, SupportedLowVersion);
994 Result := FALSE;
995 if (HighVersion < SupportedHighVersion) then
996 Result := TRUE
997 else
998 if (HighVersion = SupportedHighVersion) and
999 (LowVersion <= SupportedLowVersion) then
1000 Result := TRUE;
1001 if not Result then
1002 begin
1003 newVersion := IntToStr(HighVersion) + '.' + IntToStr(LowVersion);
1004 convertedVersion := IntToStr(SupportedHighVersion) + '.' + IntToStr(SupportedLowVersion);
1005 ShowError(DLL_ERROR_VERSION, [newVersion, convertedVersion]);
1006 end;
1007 end;
1008
1009begin
1010 Result := (GetJAWSWindow <> 0);
1011 if Result then
1012 Result := ComponentVersionSupported;
1013 if Result then
1014 Result := JAWSVersionOK;
1015 if Result then
1016 begin
1017 EnsureManager;
1018 with JAWSManager do
1019 Result := RequiredFilesFound;
1020 end;
1021end;
1022
1023class function TJAWSManager.JAWSTalking2CurrentUser: boolean;
1024var
1025 CurrentUserPath: string;
1026 WhatJAWSThinks: string;
1027
1028 procedure Fix(var path: string);
1029 var
1030 idx: integer;
1031 begin
1032 idx := pos(APP_DATA, lowercase(path));
1033 if idx > 0 then
1034 path := LeftStr(path,idx-1);
1035 idx := length(path);
1036 while (idx > 0) and (path[idx] <> '\') do dec(idx);
1037 delete(path,1,idx);
1038 end;
1039
1040 function UserProblemExists: boolean;
1041 begin
1042 CurrentUserPath := GetSpecialFolderPath(CSIDL_APPDATA);
1043 WhatJAWSThinks := GetPathFromJAWS(JAWS_PATH_ID_USER_SCRIPT_FILES, FALSE);
1044 fix(CurrentUserPath);
1045 fix(WhatJAWSThinks);
1046 Result := (lowercase(CurrentUserPath) <> lowercase(WhatJAWSThinks));
1047 end;
1048
1049begin
1050 if UserProblemExists then
1051 begin
1052 ShowError(JAWS_ERROR_USER_PROBLEM);
1053 Result := FALSE;
1054 end
1055 else
1056 Result := TRUE;
1057end;
1058
1059class function TJAWSManager.JAWSVersionOK: boolean;
1060var
1061 JFileVersion: string;
1062 JFile: string;
1063
1064 function OlderVersionOKIfCOMObjectInstalled: boolean;
1065 var
1066 api: IJawsApi;
1067 begin
1068 Result := VersionOK(JAWS_REQUIRED_VERSION, JFileVersion);
1069 if Result then
1070 begin
1071 try
1072 try
1073 api := CoJawsApi.Create;
1074 except
1075 Result := FALSE;
1076 end;
1077 finally
1078 api := nil;
1079 end;
1080 end;
1081 end;
1082
1083begin
1084 JFile := GetPathFromJAWS(JAWS_PATH_ID_APPLICATION);//JAWS_PATH_ID_USER_SCRIPT_FILES);
1085 JFile := AppendBackSlash(JFile) + JAWS_APPLICATION_FILENAME;
1086 if FileExists(JFile) then
1087 begin
1088 JFileVersion := FileVersionValue(JFile, FILE_VER_FILEVERSION);
1089 Result := VersionOK(JAWS_COM_OBJECT_VERSION, JFileVersion);
1090 if not Result then
1091 Result := OlderVersionOKIfCOMObjectInstalled;
1092 end
1093 else
1094 begin
1095// if file not found, then assume a future version where the exe was moved
1096// to a different location
1097 Result := TRUE;
1098 end;
1099 if not Result then
1100 ShowError(JAWS_ERROR_VERSION);
1101end;
1102
1103procedure TJAWSManager.KillINIFiles(Sender: TObject);
1104begin
1105 if assigned(FDictionaryFile) then
1106 begin
1107 if FDictionaryFileModified then
1108 begin
1109 MakeFileWritable(FDictionaryFileName);
1110 FDictionaryFile.SaveToFile(FDictionaryFileName);
1111 end;
1112 FreeAndNil(FDictionaryFile);
1113 end;
1114
1115 if assigned(FConfigINIFile) then
1116 begin
1117 if FConfigINIFileModified then
1118 begin
1119 FConfigINIFile.UpdateFile;
1120 end;
1121 FreeAndNil(FConfigINIFile);
1122 end;
1123
1124 if assigned(FKeyMapINIFile) then
1125 begin
1126 if FKeyMapINIFileModified then
1127 begin
1128 FKeyMapINIFile.UpdateFile;
1129 end;
1130 FreeAndNil(FKeyMapINIFile);
1131 end;
1132
1133 if assigned(FAssignedKeys) then
1134 FreeAndNil(FAssignedKeys);
1135end;
1136
1137procedure TJAWSManager.LaunchMasterApplication;
1138begin
1139 if FileExists(FMasterApp) then
1140 ShellExecute(0, PChar('open'), PChar(FMasterApp), nil,
1141 PChar(ExtractFilePath(FMasterApp)), SW_SHOWNA);
1142end;
1143
1144
1145procedure TJAWSManager.RegisterCustomBehavior(Before, After: string;
1146 Action: integer);
1147
1148const
1149 WindowClassesSection = 'WindowClasses';
1150 MSAAClassesSection = 'MSAAClasses';
1151 DICT_DELIM: char = Char($2E);
1152 CommonKeysSection = 'Common Keys';
1153 CustomCommandHelpSection = 'Custom Command Help';
1154 KeyCommand = 'VA508SendCustomCommand(';
1155 KeyCommandLen = length(KeyCommand);
1156
1157var
1158 modified: boolean;
1159
1160 procedure Add2INIFile(var INIFile: TINIFile; var FileModified: boolean;
1161 FileName, SectionName, Data, Value: string);
1162 var
1163 oldValue: string;
1164
1165 begin
1166 if not assigned(INIFile) then
1167 begin
1168 MakeFileWritable(FileName);
1169 INIFile := TINIFile.Create(FileName);
1170 FileModified := FALSE;
1171 end;
1172 OldValue := INIFile.ReadString(SectionName, Data, '');
1173 if OldValue <> Value then
1174 begin
1175 INIFile.WriteString(SectionName, Data, Value);
1176 modified := TRUE;
1177 FileModified := TRUE;
1178 end;
1179 end;
1180
1181 procedure RemoveFromINIFile(var INIFile: TINIFile; var FileModified: boolean;
1182 FileName, SectionName, Data: string);
1183 var
1184 oldValue: string;
1185
1186 begin
1187 if not assigned(INIFile) then
1188 begin
1189 MakeFileWritable(FileName);
1190 INIFile := TINIFile.Create(FileName);
1191 FileModified := FALSE;
1192 end;
1193 OldValue := INIFile.ReadString(SectionName, Data, '');
1194 if OldValue <> '' then
1195 begin
1196 INIFile.DeleteKey(SectionName, Data);
1197 modified := TRUE;
1198 FileModified := TRUE;
1199 end;
1200 end;
1201
1202 procedure RegisterCustomClassChange;
1203 begin
1204 Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
1205 WindowClassesSection, Before, After);
1206 end;
1207
1208 procedure RegisterMSAAClassChange;
1209 begin
1210 Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
1211 MSAAClassesSection, Before, '1');
1212 end;
1213
1214 procedure RegisterCustomKeyMapping;
1215 begin
1216 Add2INIFile(FKeyMapINIFile, FKeyMapINIFileModified, FKeyMapFile,
1217 CommonKeysSection, Before, KeyCommand + after + ')');
1218 if not assigned(FAssignedKeys) then
1219 FAssignedKeys := TStringList.Create;
1220 FAssignedKeys.Add(Before);
1221 end;
1222
1223 procedure RegisterCustomKeyDescription;
1224 begin
1225 Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
1226 CustomCommandHelpSection, Before, After);
1227 end;
1228
1229 procedure DecodeLine(line: string; var before1, after1: string);
1230 var
1231 i, j, len: integer;
1232 begin
1233 before1 := '';
1234 after1 := '';
1235 len := length(line);
1236 if (len < 2) or (line[1] <> DICT_DELIM) then exit;
1237 i := 2;
1238 while (i < len) and (line[i] <> DICT_DELIM) do inc(i);
1239 before1 := copy(line,2,i-2);
1240 j := i + 1;
1241 while (j <= len) and (line[j] <> DICT_DELIM) do inc(j);
1242 after1 := copy(line,i+1,j-i-1);
1243 end;
1244
1245 procedure RegisterCustomDictionaryChange;
1246 var
1247 i, idx: integer;
1248 line, before1, after1: string;
1249 add: boolean;
1250 begin
1251 if not assigned(FDictionaryFile) then
1252 begin
1253 FDictionaryFile := TStringList.Create;
1254 FDictionaryFileModified := FALSE;
1255 if FileExists(FDictionaryFileName) then
1256 FDictionaryFile.LoadFromFile(FDictionaryFileName);
1257 end;
1258
1259 add := TRUE;
1260 idx := -1;
1261 for I := 0 to FDictionaryFile.Count - 1 do
1262 begin
1263 line := FDictionaryFile[i];
1264 DecodeLine(line, before1, after1);
1265 if (before1 = Before) then
1266 begin
1267 idx := i;
1268 if after1 = after then
1269 add := false;
1270 break;
1271 end;
1272 end;
1273 if add then
1274 begin
1275 line := DICT_DELIM + Before + DICT_DELIM + after + DICT_DELIM;
1276 if idx < 0 then
1277 FDictionaryFile.Add(line)
1278 else
1279 FDictionaryFile[idx] := line;
1280 modified := TRUE;
1281 FDictionaryFileModified := TRUE;
1282 end;
1283 end;
1284
1285 procedure RemoveComponentClass;
1286 begin
1287 RemoveFromINIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
1288 WindowClassesSection, Before);
1289 end;
1290
1291 procedure RemoveMSAAClass;
1292 begin
1293 RemoveFromINIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
1294 MSAAClassesSection, Before);
1295 end;
1296
1297 procedure PurgeKeyMappings;
1298 var
1299 i: integer;
1300 name, value: string;
1301 keys: TStringList;
1302 delete: boolean;
1303 begin
1304 if not assigned(FKeyMapINIFile) then
1305 begin
1306 MakeFileWritable(FKeyMapFile);
1307 FKeyMapINIFile := TINIFile.Create(FKeyMapFile);
1308 FKeyMapINIFileModified := FALSE;
1309 end;
1310 keys := TStringList.Create;
1311 try
1312 FKeyMapINIFile.ReadSectionValues(CommonKeysSection, keys);
1313 for i := keys.Count - 1 downto 0 do
1314 begin
1315 value := copy(keys.ValueFromIndex[i],1,KeyCommandLen);
1316 if value = KeyCommand then
1317 begin
1318 name := keys.Names[i];
1319 delete := (not assigned(FAssignedKeys));
1320 if not delete then
1321 delete := (FAssignedKeys.IndexOf(name) < 0);
1322 if delete then
1323 begin
1324 FKeyMapINIFile.DeleteKey(CommonKeysSection, name);
1325 FKeyMapINIFileModified := TRUE;
1326 modified := TRUE;
1327 end;
1328 end;
1329 end;
1330 finally
1331 keys.Free;
1332 end;
1333 end;
1334
1335begin
1336{ TODO : check file io errors when updating config files }
1337 modified := FALSE;
1338 case Action of
1339 BEHAVIOR_ADD_DICTIONARY_CHANGE: RegisterCustomDictionaryChange;
1340 BEHAVIOR_ADD_COMPONENT_CLASS: RegisterCustomClassChange;
1341 BEHAVIOR_ADD_COMPONENT_MSAA: RegisterMSAAClassChange;
1342 BEHAVIOR_ADD_CUSTOM_KEY_MAPPING: RegisterCustomKeyMapping;
1343 BEHAVIOR_ADD_CUSTOM_KEY_DESCRIPTION: RegisterCustomKeyDescription;
1344 BEHAVIOR_REMOVE_COMPONENT_CLASS: RemoveComponentClass;
1345 BEHAVIOR_REMOVE_COMPONENT_MSAA: RemoveMSAAClass;
1346 BEHAVIOR_PURGE_UNREGISTERED_KEY_MAPPINGS: PurgeKeyMappings;
1347 end;
1348 if modified and assigned(FMainForm) then
1349 begin
1350 FMainForm.ResetINITimer(KillINIFiles);
1351 FMainForm.ConfigReloadNeeded;
1352 end;
1353end;
1354
1355procedure TJAWSManager.ReloadConfiguration;
1356begin
1357 if not assigned(JAWSAPI) then
1358 JAWSAPI := CoJawsApi.Create;
1359 JAWSAPI.RunFunction('ReloadAllConfigs');
1360end;
1361
1362procedure TJAWSManager.SendComponentData(WindowHandle: HWND; DataStatus: LongInt; Caption, Value,
1363 Data, ControlType, State, Instructions, ItemInstructions: PChar);
1364
1365 procedure SendRequestResponse;
1366 begin
1367 FMainForm.WriteData(VA508_REG_COMPONENT_CAPTION, Caption);
1368 FMainForm.WriteData(VA508_REG_COMPONENT_VALUE, Value);
1369 FMainForm.WriteData(VA508_REG_COMPONENT_CONTROL_TYPE, ControlType);
1370 FMainForm.WriteData(VA508_REG_COMPONENT_STATE, State);
1371 FMainForm.WriteData(VA508_REG_COMPONENT_INSTRUCTIONS, Instructions);
1372 FMainForm.WriteData(VA508_REG_COMPONENT_ITEM_INSTRUCTIONS, ItemInstructions);
1373 FMainForm.WriteData(VA508_REG_COMPONENT_DATA_STATUS, IntToStr(DataStatus));
1374 FMainForm.PostData;
1375 end;
1376
1377 procedure SendChangeEvent;
1378 var
1379 Event: WideString;
1380 begin
1381 Event := 'VA508ChangeEvent(' + IntToStr(WindowHandle) + ',' +
1382 IntToStr(DataStatus) + ',"' +
1383 StrPas(Caption) + '","' +
1384 StrPas(Value) + '","' +
1385 StrPas(ControlType) + '","' +
1386 StrPas(State) + '","' +
1387 StrPas(Instructions) + '","' +
1388 StrPas(ItemInstructions) + '"';
1389 if not assigned(JAWSAPI) then
1390 JAWSAPI := CoJawsApi.Create;
1391 JAWSAPI.RunFunction(Event)
1392 end;
1393
1394begin
1395 if (Data <> nil) and (Length(Data) > 0) then
1396 begin
1397 Value := Data;
1398 DataStatus := DataStatus AND DATA_MASK_DATA;
1399 DataStatus := DataStatus OR DATA_VALUE;
1400 end;
1401 if (DataStatus and DATA_CHANGE_EVENT) <> 0 then
1402 begin
1403 DataStatus := DataStatus AND DATA_MASK_CHANGE_EVENT;
1404 SendChangeEvent;
1405 end
1406 else
1407 SendRequestResponse;
1408end;
1409
1410const
1411 MAX_REG_CHARS = 125; // When Jaws reads over 126 chars it returns a blank string
1412 MORE_STRINGS = '+';
1413 LAST_STRING = '-';
1414 MAX_COUNT_KEY = 'Max';
1415
1416class procedure TJAWSManager.ShowError(ErrorNumber: integer);
1417begin
1418 ShowError(ErrorNumber, []);
1419end;
1420
1421class procedure TJAWSManager.ShowError(ErrorNumber: integer; data: array of const);
1422var
1423 error: string;
1424
1425begin
1426 if not JAWSErrorsShown[ErrorNumber] then
1427 begin
1428 error := JAWSErrorMessage[ErrorNumber];
1429 if length(data) > 0 then
1430 error := Format(error, data);
1431 JAWSErrorsShown[ErrorNumber] := TRUE;
1432 MessageBox(0, PChar(error), 'JAWS Accessibility Component Error',
1433 MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_TOPMOST);
1434 end;
1435end;
1436
1437procedure TJAWSManager.ShutDown;
1438begin
1439 if FWasShutdown then exit;
1440 if assigned(JAWSAPI) then
1441 begin
1442 try
1443 JAWSAPI := nil; // causes access violation
1444 except
1445 end;
1446 end;
1447 KillINIFiles(nil);
1448 if assigned(FMainForm) then
1449 FreeAndNil(FMainForm);
1450 FWasShutdown := TRUE;
1451end;
1452
1453procedure TJAWSManager.SpeakText(Text: PChar);
1454begin
1455 if not assigned(JAWSAPI) then
1456 JAWSAPI := CoJawsApi.Create;
1457 JAWSAPI.SayString(Text, FALSE);
1458end;
1459
1460
1461initialization
1462 CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
1463
1464finalization
1465 ShutDown;
1466 CoUninitialize;
1467
1468end.
Note: See TracBrowser for help on using the repository browser.