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

unit JAWSImplementation;

interface
{ DONE -oJeremy Merrill -c508 :
Add something that prevents overwriting of the script files if another
app is running that's using the JAWS DLL }
{ TODO -oJeremy Merrill -c508 : Add check in here to look at script version in JSS file }
{ DONE -oJeremy Merrill -c508 :
Replace registry communication with multiple windows - save strings in the window titles
Use EnumerateChildWindows jaws script function in place of the FindWindow function
that's being used right now.- EnumerateChildWindows with a window handle of 0
enumerates all windows on the desktop.  Will have to use the first part of the window
title as an ID, and the last part as the string values.  Will need to check for a maximum
string lenght, probably have to use multiple windows for long text.
Will also beed to have a global window shared by muiltiple instances of the JAWS.SR DLL. }
{ DONE -oJeremy Merrill -c508 :
Need to add version checking to TVA508AccessibilityManager component
and JAWS.DLL.  Warning needs to display just like JAWS.DLL and JAWS. }
uses SysUtils, Windows, Classes, Registry, StrUtils, Forms, Dialogs,
      ExtCtrls, VAUtils, DateUtils, PSApi, IniFiles, ActiveX,
      SHFolder, ShellAPI, VA508AccessibilityConst;

{$I 'VA508ScreenReaderDLLStandard.inc'}

{ DONE -oJeremy Merrill -c508 :Figure out why Delphi IDE is loading the DLL when JAWS is running  -
probably has something to do with the VA508 package being installed -
need to test for csDesigning some place that we're not testing for (maybe?)}

exports Initialize, ShutDown, RegisterCustomBehavior, ComponentData,
        SpeakText, IsRunning, ConfigChangePending;

implementation

uses fVA508HiddenJawsMainWindow, FSAPILib_TLB, ComObj;

const
//  JAWS_REQUIRED_VERSION     = '7.10.500'; in VA508AccessibilityConst unit
  JAWS_COM_OBJECT_VERSION = '8.0.2173';

        VA508_REG_PARAM_KEY = 'Software\Vista\508\JAWS';

  VA508_REG_COMPONENT_CAPTION = 'Caption';
  VA508_REG_COMPONENT_VALUE = 'Value';
  VA508_REG_COMPONENT_CONTROL_TYPE = 'ControlType';
  VA508_REG_COMPONENT_STATE = 'State';
  VA508_REG_COMPONENT_INSTRUCTIONS = 'Instructions';
  VA508_REG_COMPONENT_ITEM_INSTRUCTIONS = 'ItemInstructions';
  VA508_REG_COMPONENT_DATA_STATUS = 'DataStatus';

        VA508_ERRORS_SHOWN_STATE = 'ErrorsShown';

  RELOAD_CONFIG_SCRIPT = 'VA508Reload';

  SLASH = '\';
{ TODO -oJeremy Merrill -c508 :
Change APP_DATA so that "application data" isn't used - Windows Vista
doesn't use this value - get data from Windows API call }
  APP_DATA = SLASH + 'application data' + SLASH;
  JAWS_COMMON_SCRIPT_PATH_TEXT = '\freedom scientific\jaws\';
  JAWS_COMMON_SCRIPT_PATH_TEXT_LEN = length(JAWS_COMMON_SCRIPT_PATH_TEXT);

type
  TCompareType = (jcPrior, jcINI, jcLineItems, jcVersion, jcScriptMerge);

  TFileInfo = record
    AppFile: boolean;
    Ext: string;
    CompareType: TCompareType;
    Required: boolean;
    Compile: boolean;
  end;

const
  JAWS_SCRIPT_NAME = 'VA508JAWS';

  JAWS_SCRIPT_VERSION = 'VA508_Script_Version';
  CompiledScriptFileExtension = '.JSB';
  ScriptFileExtension = '.JSS';
  ScriptDocExtension = '.JSD';
  ConfigFileExtension = '.JCF';
  KeyMapExtension = '.JKM';
  DictionaryFileExtension = '.JDF';

  FileInfo: array[1..6] of TFileInfo = (
    (AppFile: FALSE; Ext: ScriptFileExtension;     CompareType: jcVersion;     Required: TRUE;  Compile: TRUE),
    (AppFile: FALSE; Ext: ScriptDocExtension;      CompareType: jcPrior;       Required: TRUE;  Compile: FALSE),
    (AppFile: TRUE;  Ext: ScriptFileExtension;     CompareType: jcScriptMerge; Required: TRUE;  Compile: TRUE),
    (AppFile: TRUE;  Ext: ConfigFileExtension;     CompareType: jcINI;         Required: TRUE;  Compile: FALSE),
    (AppFile: TRUE;  Ext: DictionaryFileExtension; CompareType: jcLineItems;   Required: FALSE; Compile: FALSE),
    (AppFile: TRUE;  Ext: KeyMapExtension;         CompareType: jcINI;         Required: FALSE; Compile: FALSE));

  JAWS_VERSION_ERROR = ERROR_INTRO + 
    'The Accessibility Framework can only communicate with JAWS ' + JAWS_REQUIRED_VERSION + CRLF +
    'or later versions.  Please update your version of JAWS to a minimum of' + CRLF +
    JAWS_REQUIRED_VERSION + ', or preferably the most recent release, to allow the Accessibility' + CRLF +
    'Framework to communicate with JAWS.  If you are getting this message' + CRLF +
    'and you already have a compatible version of JAWS, please contact your' + CRLF +
    'system administrator, and request that they run, with administrator rights,' + CRLF +
    'the JAWSUpdate application located in the \Program Files\VistA\' + CRLF +
    'Common Files directory. JAWSUpdate is not required for JAWS' + CRLF +
    'versions ' + JAWS_COM_OBJECT_VERSION + ' and above.' + CRLF;

  JAWS_FILE_ERROR = ERROR_INTRO +
    'The JAWS interface with the Accessibility Framework requires the ability' + CRLF +
    'to write files to the hard disk, but the following error is occurring trying to' + CRLF +
    'write to the disk:' + CRLF + '%s' + CRLF +
    'Please contact your system administrator in order to ensure that your ' + CRLF +
    'security privileges allow you to write files to the hard disk.' + CRLF +
    'If you are sure you have these privileges, your hard disk may be full.  Until' + CRLF +
    'this problem is resolved, the Accessibility Framework will not be able to' + CRLF +
    'communicate with JAWS.';

  JAWS_USER_MISSMATCH_ERROR = ERROR_INTRO +
    'An error has been detected in the state of JAWS that will not allow the' + CRLF +
    'Accessibility Framework to communicate with JAWS until JAWS is shut' + CRLF +
    'down and restarted.  Please restart JAWS at this time.';

  DLL_VERSION_ERROR = ERROR_INTRO +
    'The Accessibility Framework is at version %s, but the required JAWS' + CRLF +
    'support files are only at version %s.  The new support files should have' + CRLF +
    'been released with the latest version of the software you are currently' + CRLF +
    'running.  The Accessibility Framework will not be able to communicate' + CRLF +
    'with JAWS until these support files are installed.  Please contact your' + CRLF +
    'system administrator for assistance.';

  JAWS_ERROR_VERSION = 1;
  JAWS_ERROR_FILE_IO = 2;
  JAWS_ERROR_USER_PROBLEM = 3;
  DLL_ERROR_VERSION = 4;

  JAWS_ERROR_COUNT = 4;

  JAWS_RELOAD_DELAY = 500;

var
  JAWSErrorMessage: array[1..JAWS_ERROR_COUNT] of string = (JAWS_VERSION_ERROR, JAWS_FILE_ERROR,
         JAWS_USER_MISSMATCH_ERROR, DLL_VERSION_ERROR);
         
  JAWSErrorsShown: array[1..JAWS_ERROR_COUNT] of boolean  = (FALSE, FALSE, FALSE, FALSE);

type
  TJAWSSayString = function(StringToSpeak: PChar; Interrupt: BOOL): BOOL; stdcall;
  TJAWSRunScript = function(ScriptName: PChar): BOOL; stdcall;

  TStartupID = record
    Handle: HWND;
    InstanceID: Integer;
    MsgID: Integer;
  end;

  TJAWSManager = class
  strict private
    FRequiredFilesFound: boolean;
    FMainForm: TfrmVA508HiddenJawsMainWindow;
    FWasShutdown: boolean;
    FJAWSFileError: string;
    FDictionaryFileName: string;
    FConfigFile: string;
    FKeyMapFile: string;
    FMasterApp: string;
    FRootScriptFileName: string;
    FRootScriptAppFileName: string;
    FDefaultScriptDir: string;
    FUserStriptDir: string;
    FKeyMapINIFile: TINIFile;
    FKeyMapINIFileModified: boolean;
    FAssignedKeys: TStringList;
    FConfigINIFile: TINIFile;
    FConfigINIFileModified: boolean;
    FDictionaryFile: TStringList;
    FDictionaryFileModified: boolean;
    FCompiler: string;
    JAWSAPI: IJawsApi;
  private
    procedure ShutDown;
    procedure MakeFileWritable(FileName: string);
    procedure LaunchMasterApplication;
    procedure KillINIFiles(Sender: TObject);
    procedure ReloadConfiguration;
  public
    constructor Create;
    destructor Destroy; override;
    class procedure ShowError(ErrorNumber: integer); overload;
    class procedure ShowError(ErrorNumber: integer; data: array of const); overload;
    class function GetPathFromJAWS(PathID: integer; DoLowerCase: boolean = TRUE): string;
    class function GetJAWSWindow: HWnd;
    class function IsRunning(HighVersion, LowVersion: Word): BOOL;
    function Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL;
    procedure SendComponentData(WindowHandle: HWND; DataStatus: LongInt; Caption, Value, Data,
            ControlType, State, Instructions, ItemInstructions: PChar);
    procedure SpeakText(Text: PChar);
    procedure RegisterCustomBehavior(Before, After: string; Action: integer);
    class function JAWSVersionOK: boolean;
    class function JAWSTalking2CurrentUser: boolean;
    function FileErrorExists: boolean;
    property RequiredFilesFound: boolean read FRequiredFilesFound;
    property MainForm: TfrmVA508HiddenJawsMainWindow read FMainForm;
 end;

var
  JAWSManager: TJAWSManager = nil;
  DLLMessageID: UINT = 0;

procedure EnsureManager;
begin
  if not assigned(JAWSManager) then
    JAWSManager := TJAWSManager.Create;
end;

// Checks to see if the screen reader is currently running
function IsRunning(HighVersion, LowVersion: Word): BOOL; stdcall;
begin
  Result := TJAWSManager.IsRunning(HighVersion, LowVersion);
end;

// Executed after IsRunning returns TRUE, when the DLL is accepted as the screen reader of choice
function Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL; stdcall;
begin
  EnsureManager;
  Result := JAWSManager.Initialize(ComponentCallBackProc);
end;

// Executed when the DLL is unloaded or screen reader is no longer needed
procedure ShutDown; stdcall;
begin
  if assigned(JAWSManager) then
  begin
    JAWSManager.ShutDown;
    FreeAndNil(JAWSManager);
  end;
end;

function ConfigChangePending: boolean; stdcall;
begin
  Result := FALSE;
  if assigned(JAWSManager) and assigned(JAWSManager.MainForm) and
                              (JAWSManager.MainForm.ConfigChangePending) then
    Result := TRUE;
end;

// Returns Component Data as requested by the screen reader
procedure ComponentData(WindowHandle: HWND;
                                   DataStatus:   LongInt = DATA_NONE;
                                   Caption:      PChar = nil;
                                   Value:        PChar = nil;
                                   Data:         PChar = nil;
                                   ControlType:  PChar = nil;
                                   State:        PChar = nil;
                                   Instructions: PChar = nil;
                                   ItemInstructions: PChar = nil); stdcall;
begin
  EnsureManager;
  JAWSManager.SendComponentData(WindowHandle, DataStatus, Caption, Value, Data, ControlType, State,
                                Instructions, ItemInstructions);
end;

// Instructs the Screen Reader to say the specified text
procedure SpeakText(Text: PChar); stdcall;
begin
  EnsureManager;
  JAWSManager.SpeakText(Text);
end;

procedure RegisterCustomBehavior(BehaviorType: integer; Before, After: PChar);
begin
  EnsureManager;
  JAWSManager.RegisterCustomBehavior(Before, After, BehaviorType);
end;

{ TJAWSManager }

const
{$WARNINGS OFF} // Don't care about platform specific warning
  NON_WRITABLE_FILE_ATTRIB = faReadOnly or faHidden;
{$WARNINGS ON}
  WRITABLE_FILE_ATTRIB = faAnyFile and (not NON_WRITABLE_FILE_ATTRIB);

procedure TJAWSManager.MakeFileWritable(FileName: string);
var
  Attrib: integer;
begin
  {$WARNINGS OFF} // Don't care about platform specific warning
  Attrib := FileGetAttr(FileName);
  {$WARNINGS ON}
  if (Attrib and NON_WRITABLE_FILE_ATTRIB) <> 0 then
  begin
    Attrib := Attrib and WRITABLE_FILE_ATTRIB;
    {$WARNINGS OFF} // Don't care about platform specific warning
    if FileSetAttr(FileName, Attrib) <> 0 then
    {$WARNINGS ON}
      FJAWSFileError := 'Could not change read-only attribute of file "' + FileName + '"';
  end;
end;

var
  JAWSMsgID: UINT = 0;

const
  JAWS_MESSAGE_ID = 'JW_GET_FILE_PATH';
  // version is in directory after JAWS \Freedom Scientific\JAWS\*.*\...
  JAWS_PATH_ID_APPLICATION = 0;
  JAWS_PATH_ID_USER_SCRIPT_FILES = 1;
  JAWS_PATH_ID_JAWS_DEFAULT_SCRIPT_FILES = 2;
// 0 = C:\Program Files\Freedom Scientific\JAWS\8.0\jfw.INI
// 1 = D:\Documents and Settings\vhaislmerrij\Application Data\Freedom Scientific\JAWS\8.0\USER.INI
// 2 = D:\Documents and Settings\All Users\Application Data\Freedom Scientific\JAWS\8.0\Settings\enu\DEFAULT.SBL

class function TJAWSManager.GetPathFromJAWS(PathID: integer; DoLowerCase: boolean = TRUE): string;
var
  atm: ATOM;
  len: integer;
  path: string;
  JAWSWindow: HWnd;
begin
  JAWSWindow := GetJAWSWindow;
  if JAWSMsgID = 0 then
    JAWSMsgID := RegisterWindowMessage(JAWS_MESSAGE_ID);
  Result := '';
  atm := SendMessage(JAWSWindow, JAWSMsgID, PathID, 0);
  if atm <> 0 then
  begin
    SetLength(path, MAX_PATH * 2);
    len := GlobalGetAtomName(atm, PChar(path), MAX_PATH * 2);
    GlobalDeleteAtom(atm);
    if len > 0 then
    begin
      SetLength(path, len);
      Result := ExtractFilePath(path);
      if DoLowerCase then
        Result := LowerCase(Result); 
    end;
  end;
end;


constructor TJAWSManager.Create;
const
  COMPILER_FILENAME = 'scompile.exe';
  JAWS_APP_NAME = 'VA508APP';
  JAWSMasterApp = 'VA508JAWSDispatcher.exe';

  procedure FindCompiler;
  var
    compiler: string;

  begin
    compiler := GetPathFromJAWS(JAWS_PATH_ID_APPLICATION);
    compiler := AppendBackSlash(compiler) + COMPILER_FILENAME;
    if FileExists(compiler) then
      FCompiler := compiler;
  end;

  procedure FindJAWSRequiredFiles;
  var
    Path: string;
    i: integer;
    FileName: string;
    info: TFileInfo;

  begin
    SetLength(Path, MAX_PATH);
    SetLength(Path, GetModuleFileName(HInstance, PChar(Path), Length(Path)));
    Path := ExtractFilePath(Path);
    Path := AppendBackSlash(Path);
    // look for the script files in the same directory as this DLL
    FRootScriptFileName := Path + JAWS_SCRIPT_NAME;
    FRootScriptAppFileName := Path + JAWS_APP_NAME;
    FRequiredFilesFound := TRUE;
    for i := low(FileInfo) to high(FileInfo) do
    begin
      info := FileInfo[i];
      if info.Required then
      begin
        if info.AppFile then
          FileName := FRootScriptAppFileName + info.Ext
        else
          FileName := FRootScriptFileName + info.Ext;
        if not FileExists(FileName) then
        begin
          FRequiredFilesFound := FALSE;
          break;
        end;
      end;
    end;
    if FRequiredFilesFound then
    begin
      FMasterApp := Path + JAWSMasterApp;
      FRequiredFilesFound := FileExists(FMasterApp);
    end;
    if FRequiredFilesFound then
    begin
      FDefaultScriptDir := lowercase(GetPathFromJAWS(JAWS_PATH_ID_JAWS_DEFAULT_SCRIPT_FILES));
      FRequiredFilesFound := (pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FDefaultScriptDir) > 0);
    end;
    if FRequiredFilesFound then
    begin
      FUserStriptDir := lowercase(GetPathFromJAWS(JAWS_PATH_ID_USER_SCRIPT_FILES));
      FRequiredFilesFound := (pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FUserStriptDir) > 0);
    end;
  end;

begin
  FindCompiler;
  if FCompiler <> '' then
    FindJAWSRequiredFiles;
end;

destructor TJAWSManager.Destroy;
begin
  ShutDown;
  inherited;
end;

function TJAWSManager.FileErrorExists: boolean;
begin
  Result := (FJAWSFileError <> '');
end;


class function TJAWSManager.GetJAWSWindow: HWnd;
const
  VISIBLE_WINDOW_CLASS: PChar = 'JFWUI2';
  VISIBLE_WINDOW_TITLE: PChar = 'JAWS';
  VISIBLE_WINDOW_TITLE2: PChar = 'Remote JAWS';

begin
  Result := FindWindow(VISIBLE_WINDOW_CLASS, VISIBLE_WINDOW_TITLE);
  if Result = 0 then
    Result := FindWindow(VISIBLE_WINDOW_CLASS, VISIBLE_WINDOW_TITLE2);
end;

function TJAWSManager.Initialize(ComponentCallBackProc: TComponentDataRequestProc): BOOL;
var
  DestPath: string;
  ScriptFileChanges: boolean;
  LastFileUpdated: boolean;
  CompileCommands: TStringList;
  AppScriptNeedsFunction: boolean;
  AppNeedsUseLine: boolean;
  AppUseLine: string;
  AppStartFunctionLine: integer;

  procedure EnsureWindow;
  begin
    if not assigned(FMainForm) then
      FMainForm := TfrmVA508HiddenJawsMainWindow.Create(nil);
    FMainForm.ComponentDataCallBackProc := ComponentCallBackProc;
    FMainForm.ConfigReloadProc := ReloadConfiguration;
    FMainForm.HandleNeeded;
    Application.ProcessMessages;
  end;

  
  function GetVersion(FileName: string): integer;
  var
    list: TStringList;

    p,i: integer;
    line: string;
    working: boolean;
  begin
    Result := 0;
    list := TStringList.Create;
    try
      list.LoadFromFile(FileName);
      i := 0;
      working := TRUE;
      while working and (i < list.Count) do
      begin
        line := list[i];
        p := pos('=', line);
        if p > 0 then
        begin
          if trim(copy(line,1,p-1)) = JAWS_SCRIPT_VERSION then
          begin
            line := trim(copy(line,p+1,MaxInt));
            if copy(line,length(line), 1) = ',' then
              delete(line,length(line),1);
            Result := StrToIntDef(line, 0);
            working := FALSE;
          end;
        end;
        inc(i);
      end;
    finally
      list.Free;
    end;
  end;

  function VersionDifferent(FromFile, ToFile: string): boolean;
  var
    FromVersion, ToVersion: integer;
  begin
    FromVersion := GetVersion(FromFile);
    ToVersion := GetVersion(ToFile);
    Result := (FromVersion > ToVersion);
  end;

  function LineItemUpdateNeeded(FromFile, ToFile: string): boolean;
  var
    fromList, toList: TStringList;
    i, idx: integer;
    line: string;
  begin
    Result := FALSE;
    fromList := TStringList.Create;
    toList := TStringList.Create;
    try
      fromList.LoadFromFile(FromFile);
      toList.LoadFromFile(toFile);
      for i := 0 to fromList.Count - 1 do
      begin
        line := fromList[i];
        if trim(line) <> '' then
        begin
          idx := toList.IndexOf(line);
          if idx < 0 then
          begin
            Result := TRUE;
            break;
          end;
        end;
      end;
    finally
      toList.Free;
      fromList.Free;
    end;
  end;

  function INIUpdateNeeded(FromFile, ToFile: string): boolean;
  var
    FromINIFile, ToINIFile: TIniFile;
    Sections, Values: TStringList;
    i, j: integer;
    section, key, val1, val2: string;
  begin
    Result := FALSE;
    Sections := TStringList.Create;
    Values := TStringList.Create;
    try
      FromINIFile := TIniFile.Create(FromFile);
      try
        ToINIFile := TIniFile.Create(ToFile);
        try
          FromINIFile.ReadSections(Sections);
          for i := 0 to Sections.count-1 do
          begin
            section := Sections[i];
            FromINIFile.ReadSectionValues(section, Values);
            for j := 0 to Values.Count - 1 do
            begin
              key := Values.Names[j];
              val1 := Values.ValueFromIndex[j];
              val2 := ToINIFile.ReadString(Section, key, '');
              result := (val1 <> val2);
              if Result then
                break;
            end;
            if Result then
              break;
          end;
        finally
          ToINIFile.Free;
        end;
      finally
        FromINIFile.Free;
      end;
    finally
      Sections.Free;
      Values.Free;
    end;
  end;

  function IsUseLine(data: string): boolean;
  var
    p: integer;
  begin
    Result := (copy(data,1,4) = 'use ');
    if Result then
    begin
      Result := FALSE;
      p := pos('"', data);
      if p > 0 then
      begin
        p := posEX('"', data, p+1);
        if p = length(data) then
          Result := TRUE;
      end;
    end;
  end;

  function IsFunctionLine(data: string): boolean;
  var
    p1, p2: integer;
    line: string;
  begin
    Result := FALSE;
    line := data;
    p1 := pos(' ', line);
    if (p1 > 0) then
    begin
      if copy(line,1,p1-1) = 'script' then
        Result := true
      else
      begin
        p2 := posEx(' ', line, p1+1);
        if p2 > 0 then
        begin
          line := copy(line, p1+1, p2-p1-1);
          if (line = 'function') then
            Result := TRUE;
        end;
      end;
    end;
  end;

  function CheckForUseLineAndFunction(FromFile, ToFile: string): boolean;
  var
    FromData: TStringList;
    ToData: TStringList;
    UseLine: string;
    i: integer;
    line: string;

  begin
    Result := FALSE;
    FromData := TStringList.create;
    ToData := TStringList.create;
    try
      UseLine := '';
      AppUseLine := '';
      AppStartFunctionLine := -1;
      FromData.LoadFromFile(FromFile);
      for i := 0 to FromData.Count - 1 do
      begin
        line := lowerCase(trim(FromData[i]));
        if (UseLine = '') and IsUseLine(line) then
        begin
          UseLine := line;
          AppUseLine := FromData[i];
        end
        else
        if (AppStartFunctionLine < 0) and IsFunctionLine(line) then
          AppStartFunctionLine := i;
        if (UseLine <> '') and (AppStartFunctionLine >= 0) then break;
      end;
      if (UseLine = '') or (AppStartFunctionLine < 0) then exit;

      AppNeedsUseLine := TRUE;
      AppScriptNeedsFunction := TRUE;
      ToData.LoadFromFile(ToFile);
      for i := 0 to ToData.Count - 1 do
      begin
        line := lowerCase(trim(ToData[i]));
        if AppNeedsUseLine and IsUseLine(line) and (line = UseLine) then
          AppNeedsUseLine := FALSE
        else
        if AppScriptNeedsFunction and IsFunctionLine(line) then
            AppScriptNeedsFunction := FALSE;
        if (not AppNeedsUseLine) and (not AppScriptNeedsFunction) then break;
      end;
      if AppNeedsUseLine or AppScriptNeedsFunction then
        Result := TRUE;
    finally
      FromData.free;
      ToData.free;
    end;
  end;

  function UpdateNeeded(FromFile, ToFile: string; CompareType: TCompareType): boolean;
  begin
    Result := TRUE;
    try
      case CompareType of
        jcScriptMerge: Result := CheckForUseLineAndFunction(FromFile, ToFile);
        jcPrior:       Result := LastFileUpdated;
        jcVersion:     Result := VersionDifferent(FromFile, ToFile);
        jcINI:         Result := INIUpdateNeeded(FromFile, ToFile);
        jcLineItems:   Result := LineItemUpdateNeeded(FromFile, ToFile);
      end;
    except
      on E: Exception do
        FJAWSFileError := E.Message;
    end;
  end;

  procedure INIFileUpdate(FromFile, ToFile: String);
  var
    FromINIFile, ToINIFile: TIniFile;
    Sections, Values: TStringList;
    i, j: integer;
    section, key, val1, val2: string;
    modified: boolean;
  begin
    modified := FALSE;
    Sections := TStringList.Create;
    Values := TStringList.Create;
    try
      FromINIFile := TIniFile.Create(FromFile);
      try
        ToINIFile := TIniFile.Create(ToFile);
        try
          FromINIFile.ReadSections(Sections);
          for i := 0 to Sections.count-1 do
          begin
            section := Sections[i];
            FromINIFile.ReadSectionValues(section, Values);
            for j := 0 to Values.Count - 1 do
            begin
              key := Values.Names[j];
              val1 := Values.ValueFromIndex[j];
              val2 := ToINIFile.ReadString(Section, key, '');
              if (val1 <> val2) then
              begin
                ToINIFile.WriteString(section, key, val1);
                modified := TRUE;
              end;
            end;
          end;
        finally
          if modified then
            ToINIFile.UpdateFile();
          ToINIFile.Free;
        end;
      finally
        FromINIFile.Free;
      end;
    finally
      Sections.Free;
      Values.Free;
    end;
  end;

  procedure LineItemFileUpdate(FromFile, ToFile: string);
  var
    fromList, toList: TStringList;
    i, idx: integer;
    line: string;
    modified: boolean;
  begin
    modified := FALSE;
    fromList := TStringList.Create;
    toList := TStringList.Create;
    try
      fromList.LoadFromFile(FromFile);
      toList.LoadFromFile(toFile);
      for i := 0 to fromList.Count - 1 do
      begin
        line := fromList[i];
        if trim(line) <> '' then
        begin
          idx := toList.IndexOf(line);
          if idx < 0 then
          begin
            toList.Add(line);
            modified := TRUE;
          end;
        end;
      end;
    finally
      if Modified then
        toList.SaveToFile(ToFile);
      toList.Free;
      fromList.Free;
    end;
  end;

  procedure DeleteCompiledFile(ToFile: string);
  var
    CompiledFile: string;
  begin
    CompiledFile := copy(ToFile, 1, length(ToFile) - length(ExtractFileExt(ToFile)));
    CompiledFile := CompiledFile + CompiledScriptFileExtension;
    if FileExists(CompiledFile) then
    begin
      MakeFileWritable(CompiledFile);
      DeleteFile(PChar(CompiledFile));
    end;
  end;

  function DoScriptMerge(FromFile, ToFile: string): boolean;
  var
    BackupFile: string;
    FromData: TStringList;
    ToData: TStringList;
    i, idx: integer;
    ExitCode: integer;
  begin
    Result := TRUE;
    BackupFile := ToFile + '.BACKUP';
    if FileExists(BackupFile) then
    begin
      MakeFileWritable(BackupFile);
      DeleteFile(PChar(BackupFile));
    end;
    DeleteCompiledFile(ToFile);
    CopyFile(PChar(ToFile), PChar(BackupFile), FALSE);
    MakeFileWritable(ToFile);
    FromData := TStringList.create;
    ToData := TStringList.create;
    try
      ToData.LoadFromFile(ToFile);
      if AppNeedsUseLine then
        ToData.Insert(0, AppUseLine);
      if AppScriptNeedsFunction then
      begin
        FromData.LoadFromFile(FromFile);
        ToData.Insert(1,'');
        idx := 2;
        for i := AppStartFunctionLine to FromData.Count - 1 do
        begin
          ToData.Insert(idx, FromData[i]);
          inc(idx);
        end;
        ToData.Insert(idx,'');
      end;
      if not assigned(JAWSAPI) then
        JAWSAPI := CoJawsApi.Create;
      ToData.SaveToFile(ToFile);
      ExitCode := ExecuteAndWait('"' + FCompiler + '"', '"' + ToFile + '"');
      JAWSAPI.StopSpeech;
      if ExitCode = 0 then // compile succeeded!
        ReloadConfiguration
      else
        Result := FALSE; // compile failed - just copy the new one
    finally
      FromData.free;
      ToData.free;
    end;
  end;
  
  procedure UpdateFile(FromFile, ToFile: string; info: TFileInfo);
  var
    DoCopy: boolean;
    error: boolean;
    CheckOverwrite: boolean;
  begin
    DoCopy := FALSE;
    if FileExists(ToFile) then
    begin
      MakeFileWritable(ToFile);
      CheckOverwrite := TRUE;
      try
        case info.CompareType of
          jcScriptMerge: if not DoScriptMerge(FromFile, ToFile) then DoCopy := TRUE;
          jcPrior, jcVersion: DoCopy := TRUE;
          jcINI: INIFileUpdate(FromFile, ToFile);
          jcLineItems: LineItemFileUpdate(FromFile, ToFile);
        end;
      except
        on E: Exception do
          FJAWSFileError := E.Message;
      end;
    end
    else
    begin
      CheckOverwrite := FALSE;
      DoCopy := TRUE;
    end;
    if DoCopy then
    begin
      error := FALSE;
      if not CopyFile(PChar(FromFile), PChar(Tofile), FALSE) then
        error := TRUE;
      if (not error) and (not FileExists(ToFile)) then
        error := TRUE;
      if (not error) and CheckOverwrite and (info.CompareType <> jcPrior) and
        UpdateNeeded(FromFile, ToFile, info.CompareType) then
        error := TRUE;
      if error and (not FileErrorExists) then
        FJAWSFileError := 'Error copying "' + FromFile + '" to' + CRLF + '"' + ToFile + '".';
      if (not error) and (info.Compile) then
      begin
        DeleteCompiledFile(ToFile);
        CompileCommands.Add('"' + ToFile + '"');
      end;     
    end;
  end;

  procedure EnsureJAWSScriptsAreUpToDate;
  var
    DestFile, FromFile, ToFile, AppName, ext: string;
    idx1, idx2, i: integer;
    DoUpdate: boolean;
    info: TFileInfo;

  begin
    AppName := ExtractFileName(ParamStr(0));
    ext := ExtractFileExt(AppName);
    AppName := LeftStr(AppName, length(AppName) - Length(ext));
    DestPath := '';
    idx1 := pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FUserStriptDir);
    idx2 := pos(JAWS_COMMON_SCRIPT_PATH_TEXT, FDefaultScriptDir);
    if (idx1 > 0) and (idx2 > 0) then
    begin
      DestPath := copy(FUserStriptDir,1,idx1-1) + copy(FDefaultScriptDir, idx2, MaxInt);
      DestFile := DestPath + AppName;
      FDictionaryFileName := DestFile + DictionaryFileExtension;
      FConfigFile := DestFile + ConfigFileExtension;
      FKeyMapFile := DestFile + KeyMapExtension;
      LastFileUpdated := FALSE;
      for i := low(FileInfo) to high(FileInfo) do
      begin
        info := FileInfo[i];
        if info.AppFile then
        begin
          FromFile := FRootScriptAppFileName + info.Ext;
          ToFile := DestFile + info.Ext;
        end
        else
        begin
          FromFile := FRootScriptFileName + info.Ext;
          ToFile := DestPath + JAWS_SCRIPT_NAME + info.Ext;
        end;
        if not FileExists(FromFile) then continue;
        if FileExists(ToFile) then
        begin
          DoUpdate := UpdateNeeded(FromFile, ToFile, info.CompareType);
          if DoUpdate then
            MakeFileWritable(ToFile);
        end
        else
          DoUpdate := TRUE;
        LastFileUpdated := DoUpdate;
        if DoUpdate and (not FileErrorExists) then
        begin
          UpdateFile(FromFile, ToFile, info);
          ScriptFileChanges := TRUE;
        end;
        if FileErrorExists then
          break;
      end;
    end
    else
      FJAWSFileError := 'Unknown File Error'; // should never happen - condition checked previously
  end;

  procedure DoCompiles;
  var
    i: integer;
  begin
    if not assigned(JAWSAPI) then
      JAWSAPI := CoJawsApi.Create;
    for i := 0 to CompileCommands.Count - 1 do
    begin
      ExecuteAndWait('"' + FCompiler + '"', CompileCommands[i]);
      JAWSAPI.StopSpeech;
    end;
    ReloadConfiguration;
  end;

begin
  Result := FALSE;
  ScriptFileChanges := FALSE;
  if JAWSManager.RequiredFilesFound then
  begin
    FJAWSFileError := '';
    CompileCommands := TStringList.Create;
    try
      EnsureJAWSScriptsAreUpToDate;
      if CompileCommands.Count > 0 then
        DoCompiles;
    finally
      CompileCommands.Free;
    end;
    if FileErrorExists then
      ShowError(JAWS_ERROR_FILE_IO, [FJAWSFileError])
    else if JAWSTalking2CurrentUser then
    begin
      EnsureWindow;
      LaunchMasterApplication;
      if ScriptFileChanges then
      begin
        FMainForm.ConfigReloadNeeded;
      end;
      Result := TRUE;
    end;
  end;
end;

class function TJAWSManager.IsRunning(HighVersion, LowVersion: Word): BOOL;

  function ComponentVersionSupported: boolean;
  var
    SupportedHighVersion, SupportedLowVersion: integer;
    FileName, newVersion, convertedVersion, currentVersion: string;
    addr: pointer;

  begin
    addr := @TJAWSManager.IsRunning;
    FileName := GetDLLFileName(addr);
    currentVersion := FileVersionValue(FileName, FILE_VER_FILEVERSION);
    VersionStringSplit(currentVersion, SupportedHighVersion, SupportedLowVersion);
    Result := FALSE;
    if (HighVersion < SupportedHighVersion) then
      Result := TRUE
    else
    if (HighVersion = SupportedHighVersion) and
       (LowVersion <= SupportedLowVersion) then
      Result := TRUE;
    if not Result then
    begin
      newVersion := IntToStr(HighVersion) + '.' + IntToStr(LowVersion);
      convertedVersion := IntToStr(SupportedHighVersion) + '.' + IntToStr(SupportedLowVersion);
      ShowError(DLL_ERROR_VERSION, [newVersion, convertedVersion]);
    end;
  end;

begin
  Result := (GetJAWSWindow <> 0);
  if Result then
    Result := ComponentVersionSupported;
  if Result then
    Result := JAWSVersionOK;
  if Result then
  begin
    EnsureManager;
    with JAWSManager do
      Result := RequiredFilesFound;
  end;
end;

class function TJAWSManager.JAWSTalking2CurrentUser: boolean;
var
  CurrentUserPath: string;
  WhatJAWSThinks: string;

  procedure Fix(var path: string);
  var
    idx: integer;
  begin
    idx := pos(APP_DATA, lowercase(path));
    if idx > 0 then
      path := LeftStr(path,idx-1);
    idx := length(path);
    while (idx > 0) and (path[idx] <> '\') do dec(idx);
    delete(path,1,idx);
  end;

  function UserProblemExists: boolean;
  begin
    CurrentUserPath := GetSpecialFolderPath(CSIDL_APPDATA);
    WhatJAWSThinks := GetPathFromJAWS(JAWS_PATH_ID_USER_SCRIPT_FILES, FALSE);
    fix(CurrentUserPath);
    fix(WhatJAWSThinks);
    Result := (lowercase(CurrentUserPath) <> lowercase(WhatJAWSThinks));
  end;

begin
  if UserProblemExists then
  begin
    ShowError(JAWS_ERROR_USER_PROBLEM);
    Result := FALSE;
  end
  else
    Result := TRUE;
end;

class function TJAWSManager.JAWSVersionOK: boolean;
var
  JFileVersion: string;
  JFile: string;

  function OlderVersionOKIfCOMObjectInstalled: boolean;
  var
    api: IJawsApi;
  begin
    Result := VersionOK(JAWS_REQUIRED_VERSION, JFileVersion);
    if Result then
    begin
      try
        try
          api := CoJawsApi.Create;
        except
          Result := FALSE;
        end;
      finally
        api := nil;
      end;
    end;
  end;

begin
  JFile := GetPathFromJAWS(JAWS_PATH_ID_APPLICATION);//JAWS_PATH_ID_USER_SCRIPT_FILES);
  JFile := AppendBackSlash(JFile) + JAWS_APPLICATION_FILENAME;
  if FileExists(JFile) then
  begin
    JFileVersion := FileVersionValue(JFile, FILE_VER_FILEVERSION);
    Result := VersionOK(JAWS_COM_OBJECT_VERSION, JFileVersion);
    if not Result then
      Result := OlderVersionOKIfCOMObjectInstalled;
  end
  else
  begin
// if file not found, then assume a future version where the exe was moved
// to a different location  
    Result := TRUE;
  end;
  if not Result then
    ShowError(JAWS_ERROR_VERSION);
end;

procedure TJAWSManager.KillINIFiles(Sender: TObject);
begin
  if assigned(FDictionaryFile) then
  begin
    if FDictionaryFileModified then
    begin
      MakeFileWritable(FDictionaryFileName);
      FDictionaryFile.SaveToFile(FDictionaryFileName);
    end;
    FreeAndNil(FDictionaryFile);
  end;

  if assigned(FConfigINIFile) then
  begin
    if FConfigINIFileModified then
    begin
      FConfigINIFile.UpdateFile;
    end;
    FreeAndNil(FConfigINIFile);
  end;

  if assigned(FKeyMapINIFile) then
  begin
    if FKeyMapINIFileModified then
    begin
      FKeyMapINIFile.UpdateFile;
    end;
    FreeAndNil(FKeyMapINIFile);
  end;

  if assigned(FAssignedKeys) then
    FreeAndNil(FAssignedKeys);
end;

procedure TJAWSManager.LaunchMasterApplication;
begin
  if FileExists(FMasterApp) then
    ShellExecute(0, PChar('open'), PChar(FMasterApp), nil,
                    PChar(ExtractFilePath(FMasterApp)), SW_SHOWNA);
end;


procedure TJAWSManager.RegisterCustomBehavior(Before, After: string;
  Action: integer);

const
  WindowClassesSection = 'WindowClasses';
  MSAAClassesSection = 'MSAAClasses';
  DICT_DELIM: char = Char($2E);
  CommonKeysSection = 'Common Keys';
  CustomCommandHelpSection = 'Custom Command Help';
  KeyCommand = 'VA508SendCustomCommand(';
  KeyCommandLen = length(KeyCommand);

var
  modified: boolean;

  procedure Add2INIFile(var INIFile: TINIFile; var FileModified: boolean;
                        FileName, SectionName, Data, Value: string);
  var
    oldValue: string;

  begin
    if not assigned(INIFile) then
    begin
      MakeFileWritable(FileName);
      INIFile := TINIFile.Create(FileName);
      FileModified := FALSE;
    end;
    OldValue := INIFile.ReadString(SectionName, Data, '');
    if OldValue <> Value then
    begin
      INIFile.WriteString(SectionName, Data, Value);
      modified := TRUE;
      FileModified := TRUE;
    end;
  end;

  procedure RemoveFromINIFile(var INIFile: TINIFile; var FileModified: boolean;
                                FileName, SectionName, Data: string);
  var
    oldValue: string;

  begin
    if not assigned(INIFile) then
    begin
      MakeFileWritable(FileName);
      INIFile := TINIFile.Create(FileName);
      FileModified := FALSE;
    end;
    OldValue := INIFile.ReadString(SectionName, Data, '');
    if OldValue <> '' then
    begin
      INIFile.DeleteKey(SectionName, Data);
      modified := TRUE;
      FileModified := TRUE;
    end;
  end;

  procedure RegisterCustomClassChange;
  begin
    Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
                  WindowClassesSection, Before, After);
  end;

  procedure RegisterMSAAClassChange;
  begin
    Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
                  MSAAClassesSection, Before, '1');
  end;

  procedure RegisterCustomKeyMapping;
  begin
    Add2INIFile(FKeyMapINIFile, FKeyMapINIFileModified, FKeyMapFile,
                  CommonKeysSection, Before, KeyCommand + after + ')');
    if not assigned(FAssignedKeys) then
      FAssignedKeys := TStringList.Create;
    FAssignedKeys.Add(Before);
  end;

  procedure RegisterCustomKeyDescription;
  begin
    Add2INIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
                  CustomCommandHelpSection, Before, After);
  end;

  procedure DecodeLine(line: string; var before1, after1: string);
  var
    i, j, len: integer;
  begin
    before1 := '';
    after1 := '';
    len := length(line);
    if (len < 2) or (line[1] <> DICT_DELIM) then exit;
    i := 2;
    while (i < len) and (line[i] <> DICT_DELIM) do inc(i);
    before1 := copy(line,2,i-2);
    j := i + 1;
    while (j <= len) and (line[j] <> DICT_DELIM) do inc(j);
    after1 := copy(line,i+1,j-i-1);
  end;

  procedure RegisterCustomDictionaryChange;
  var
    i, idx: integer;
    line, before1, after1: string;
    add: boolean;
  begin
    if not assigned(FDictionaryFile) then
    begin
      FDictionaryFile := TStringList.Create;
      FDictionaryFileModified := FALSE;
      if FileExists(FDictionaryFileName) then
        FDictionaryFile.LoadFromFile(FDictionaryFileName);
    end;

    add := TRUE;
    idx := -1;
    for I := 0 to FDictionaryFile.Count - 1 do
    begin
      line := FDictionaryFile[i];
      DecodeLine(line, before1, after1);
      if (before1 = Before) then
      begin
        idx := i;
        if after1 = after then
          add := false;
        break;
      end;
    end;
    if add then
    begin
      line := DICT_DELIM + Before + DICT_DELIM + after + DICT_DELIM;
      if idx < 0 then
        FDictionaryFile.Add(line)
      else
        FDictionaryFile[idx] := line;
      modified := TRUE;
      FDictionaryFileModified := TRUE;
    end;
  end;

  procedure RemoveComponentClass;
  begin
    RemoveFromINIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
                  WindowClassesSection, Before);
  end;

  procedure RemoveMSAAClass;
  begin
    RemoveFromINIFile(FConfigINIFile, FConfigINIFileModified, FConfigFile,
                  MSAAClassesSection, Before);
  end;

  procedure PurgeKeyMappings;
  var
    i: integer;
    name, value: string;
    keys: TStringList;
    delete: boolean;
  begin
    if not assigned(FKeyMapINIFile) then
    begin
      MakeFileWritable(FKeyMapFile);
      FKeyMapINIFile := TINIFile.Create(FKeyMapFile);
      FKeyMapINIFileModified := FALSE;
    end;
    keys := TStringList.Create;
    try
      FKeyMapINIFile.ReadSectionValues(CommonKeysSection, keys);
      for i := keys.Count - 1 downto 0 do
      begin
        value := copy(keys.ValueFromIndex[i],1,KeyCommandLen);
        if value = KeyCommand then
        begin
          name := keys.Names[i];
          delete := (not assigned(FAssignedKeys));
          if not delete then
            delete := (FAssignedKeys.IndexOf(name) < 0);
          if delete then
          begin
            FKeyMapINIFile.DeleteKey(CommonKeysSection, name);
            FKeyMapINIFileModified := TRUE;
            modified := TRUE;
          end;
        end;
      end;
    finally
      keys.Free;
    end;
  end;

begin
{ TODO : check file io errors when updating config files }
  modified := FALSE;
  case Action of
    BEHAVIOR_ADD_DICTIONARY_CHANGE:           RegisterCustomDictionaryChange;
    BEHAVIOR_ADD_COMPONENT_CLASS:             RegisterCustomClassChange;
    BEHAVIOR_ADD_COMPONENT_MSAA:              RegisterMSAAClassChange;
    BEHAVIOR_ADD_CUSTOM_KEY_MAPPING:          RegisterCustomKeyMapping;
    BEHAVIOR_ADD_CUSTOM_KEY_DESCRIPTION:      RegisterCustomKeyDescription;
    BEHAVIOR_REMOVE_COMPONENT_CLASS:          RemoveComponentClass;
    BEHAVIOR_REMOVE_COMPONENT_MSAA:           RemoveMSAAClass;
    BEHAVIOR_PURGE_UNREGISTERED_KEY_MAPPINGS: PurgeKeyMappings;
  end;
  if modified and assigned(FMainForm) then
  begin
    FMainForm.ResetINITimer(KillINIFiles);
    FMainForm.ConfigReloadNeeded;
  end;
end;

procedure TJAWSManager.ReloadConfiguration;
begin
  if not assigned(JAWSAPI) then
    JAWSAPI := CoJawsApi.Create;
  JAWSAPI.RunFunction('ReloadAllConfigs');
end;

procedure TJAWSManager.SendComponentData(WindowHandle: HWND; DataStatus: LongInt; Caption, Value,
            Data, ControlType, State, Instructions, ItemInstructions: PChar);

  procedure SendRequestResponse;
  begin
    FMainForm.WriteData(VA508_REG_COMPONENT_CAPTION, Caption);
    FMainForm.WriteData(VA508_REG_COMPONENT_VALUE, Value);
    FMainForm.WriteData(VA508_REG_COMPONENT_CONTROL_TYPE, ControlType);
    FMainForm.WriteData(VA508_REG_COMPONENT_STATE, State);
    FMainForm.WriteData(VA508_REG_COMPONENT_INSTRUCTIONS, Instructions);
    FMainForm.WriteData(VA508_REG_COMPONENT_ITEM_INSTRUCTIONS, ItemInstructions);
    FMainForm.WriteData(VA508_REG_COMPONENT_DATA_STATUS, IntToStr(DataStatus));
    FMainForm.PostData;
  end;

  procedure SendChangeEvent;
  var
    Event: WideString;
  begin
    Event := 'VA508ChangeEvent(' + IntToStr(WindowHandle)   +  ',' +
                                   IntToStr(DataStatus)     +  ',"' +
                                   StrPas(Caption)          + '","' +
                                   StrPas(Value)            + '","' +
                                   StrPas(ControlType)      + '","' +
                                   StrPas(State)            + '","' +
                                   StrPas(Instructions)     + '","' +
                                   StrPas(ItemInstructions) + '"';
    if not assigned(JAWSAPI) then
      JAWSAPI := CoJawsApi.Create;
    JAWSAPI.RunFunction(Event)
  end;

begin
  if (Data <> nil) and (Length(Data) > 0) then
  begin
    Value := Data;
    DataStatus := DataStatus AND DATA_MASK_DATA;
    DataStatus := DataStatus OR DATA_VALUE;
  end;
  if (DataStatus and DATA_CHANGE_EVENT) <> 0 then
  begin
    DataStatus := DataStatus AND DATA_MASK_CHANGE_EVENT;
    SendChangeEvent;
  end
  else
    SendRequestResponse;
end;

const
  MAX_REG_CHARS = 125; // When Jaws reads over 126 chars it returns a blank string
  MORE_STRINGS = '+';
  LAST_STRING = '-';
  MAX_COUNT_KEY = 'Max';

class procedure TJAWSManager.ShowError(ErrorNumber: integer);
begin
  ShowError(ErrorNumber, []);
end;

class procedure TJAWSManager.ShowError(ErrorNumber: integer; data: array of const);
var
  error: string;

begin
  if not JAWSErrorsShown[ErrorNumber] then
  begin
    error := JAWSErrorMessage[ErrorNumber];
    if length(data) > 0 then
      error := Format(error, data);
    JAWSErrorsShown[ErrorNumber] := TRUE;
    MessageBox(0, PChar(error), 'JAWS Accessibility Component Error',
          MB_OK or MB_ICONERROR or MB_TASKMODAL or MB_TOPMOST);
  end;
end;

procedure TJAWSManager.ShutDown;
begin
  if FWasShutdown then exit;
  if assigned(JAWSAPI) then
  begin
    try
      JAWSAPI := nil; // causes access violation
    except
    end;
  end;
  KillINIFiles(nil);
  if assigned(FMainForm) then
    FreeAndNil(FMainForm);
  FWasShutdown := TRUE;
end;

procedure TJAWSManager.SpeakText(Text: PChar);
begin
  if not assigned(JAWSAPI) then
    JAWSAPI := CoJawsApi.Create;
  JAWSAPI.SayString(Text, FALSE);
end;


initialization
  CoInitializeEx(nil, COINIT_APARTMENTTHREADED);

finalization
  ShutDown;
  CoUninitialize;

end.