unit VA508ScreenReaderDLLLinker;

interface

{ TODO -oJeremy Merrill -c508 :Add ability to handle multiple instances / multiple appliations to JAWS at the same time -
  will need to use Application.MainForm handle approach, probably need to use different
  registry keys with handle in registry key name.  JAWS has a GetAppMainWindow command
  to get the handle.  Will need a cleanup command in delphi to make sure we don't leave
  junk in the registry - probably search running apps, and if the main form's handle isn't in
  the registry, delete entries. }
uses
  Windows, SysUtils, Forms, Classes, VA508AccessibilityConst;

{$I 'VA508ScreenReaderDLLStandard.inc'}
// Returns true if a link to a screen reader was successful.  The first link that
// is established causes searching to stop.
// Searches for .SR files in this order:
// 1) Current machine's Program Files directory
// 2) \Program Files directory on drive where app resides,
// if it's different than the current machine's program files directory
// 3) The directory the application was run from.

Procedure FrameworkSpeakText(Text: string);
Procedure FrameworkStopSpeech;
procedure FrameworkComponentData(WindowHandle: HWND;
  Caption, Value, Data, ControlType, State, Instructions, ItemInstructions,
  Hint: string; AControlGroupName: string; DataStatus: LongInt = DATA_NONE);
procedure FrameworkRegisterBehavior(BehaviorType: integer;
  Before, After: string);
function FrameworkConfigPending(): Boolean;
function FrameworkDLLsExist: Boolean;
function FrameWorkStart: Boolean;
function FrameworkListViewSettings(Identifier: string): String;
function FrameworkReadToolTips: Boolean;
function FrameworkReadControlGroupName: Boolean;
function FrameworkVersionInfo: string;

type
  TVA508ManagerCallback = class
  private
    class var fOnDataRequest: TComponentDataRequestProc;
  public
    class property OnDataRequest: TComponentDataRequestProc read fOnDataRequest
      write fOnDataRequest;
  end;

implementation

uses VAUtils, system.inifiles, system.Win.Registry, system.Math;

const
  ScreenReaderFileExtension = '.SR3';
  ScreenReaderCommonFilesDir = 'VistA\Common Files\';
  ScreenReaderSearchSpec = '*' + ScreenReaderFileExtension;
{$WARNINGS OFF}   // Ignore platform specific code warning
  BadFile = faHidden or faSysFile or faDirectory or faSymLink;
{$WARNINGS ON}
  DllCallError =
    'The following error occured when trying to run %s from the Jaws framework. Error: %s';
  JAWS_SCRIPT_LIST = 'VA508ScriptList.INI';

type
  TVA508InitializeProc = function(CallBackProc: TComponentDataRequestProc)
    : BOOL; stdcall;
  TVA508InitializeExProc = function(ComponentCallBackProc
    : TComponentDataRequestProc; DoThread: BOOL; ShowSplash: BOOL;
    HostApplication: PChar): BOOL; stdcall;
  TVA508ShutDownProc = procedure; stdcall;
  TVA508RegisterCustomBehaviorProc = procedure(BehaviorType: integer;
    Before, After: PChar); stdcall;
  TVA508SpeakTextProc = procedure(Text: PChar); stdcall;
  TVA508StopSpeechProc = procedure; stdcall;
  TVA508IsRunningFunc = function(HighVersion, LowVersion: Word): BOOL; stdcall;
  TVA508CheckJawsFunc = function(): BOOL; stdcall;
  TVA508ToolTipsEnabledFunc = function(): BOOL; stdcall;
  TVA508IsControlGroupNameEnabledFunc = function(): BOOL; stdcall;
  TVA508ListViewSettingsProc = function(Identifier: PChar; Buffer: PChar;
    var BufferLen: Word): BOOL; stdcall;
  TVA508VersionInfoProc = function(Buffer: PChar;
    var BufferLen: Word): BOOL; stdcall;
  TVA508ConfigChangePending = function: Boolean; stdcall;
  TVA508ComponentDataProc = procedure(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;
  TVA508ComponentDataProcW = procedure(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;
    Hint: PChar = nil; AControlGroupName: PChar = nil); stdcall;

  TStringArray = array of string;

  TFrameworkCommunicator = class
  private
    fDllHandle: THandle;
    fDoInitialize: Boolean;
    fInitializeResult: Boolean;
    fUseNewComponentData: Boolean;
    fDLLFound: Boolean;
    fFileName: String;
    fSRCheckJaws: TVA508CheckJawsFunc;
    fSRIsRunning: TVA508IsRunningFunc;
    fSRInitialize: TVA508InitializeProc;
    fSRInitializeEx: TVA508InitializeExProc;
    fSRShutDown: TVA508ShutDownProc;
    fSRSpeakText: TVA508SpeakTextProc;
    fSRStopSpeech: TVA508StopSpeechProc;
    fSRComponentData: TVA508ComponentDataProc;
    fSRComponentDataW: TVA508ComponentDataProcW;
    fSRRegisterCustomBehavior: TVA508RegisterCustomBehaviorProc;
    fSRConfigChangePending: TVA508ConfigChangePending;
    fSRToolTipsEnabled: TVA508ToolTipsEnabledFunc;
    fSRIsControlGroupNameEnabled: TVA508IsControlGroupNameEnabledFunc;
    fSRListViewSettings: TVA508ListViewSettingsProc;
    fSRVersionInfo: TVA508VersionInfoProc;
    procedure LoadDLL(aFileName: String);
    procedure UnloadDLL;
    procedure ShutDown;
    procedure ClearProcPointers;
    procedure SetProcPointers();
    function ValidateRunning(): Boolean;
    function ValidateFrameworkSeesJaws(): Boolean;
    function DoesDLLMethodExist(MethodName: PAnsiChar): Boolean;
    function Validate508Procs(): Boolean;
    function Validate508DLL(FileName: string): Boolean;
    function ScanForFramework(SearchDirs: TStringArray): Boolean;
    function GetDLLExist: Boolean;
    Function ProcessInitialize: Boolean;
    function InitializeScreenReaderLink: Boolean;
    function SRCompnentDataAssigned: Boolean;
    function GetPendingConfigChange: Boolean;
    function GetListViewSettings(ListViewIdentifier: string): String;
    function GetVersionInfo: string;
    function GetToolTipsEnabled: Boolean;
    function StrToPChar(s: string): PChar;
    function GetIsControlGroupNameEnabled: Boolean;
  public
    constructor Create();
    destructor Destroy; override;
    function Load508Framework: Boolean;
    procedure SpeakCustomText(Text: String);
    procedure StopSpeech;
    procedure ComponentData(WindowHandle: HWND;
      Caption, Value, Data, ControlType, State, Instructions, ItemInstructions,
      Hint, AControlGroupName: string; DataStatus: LongInt = DATA_NONE);
    procedure RegisterCustomBehavior(BehaviorType: integer;
      Before, After: string);
    property DLLExist: Boolean read GetDLLExist;
    property PendingConfigChange: Boolean read GetPendingConfigChange;
    property ToolTipsEnabled: Boolean read GetToolTipsEnabled;
    property IsControlGroupNameEnabled: Boolean read GetIsControlGroupNameEnabled;
    property ListViewSetting[ListViewIdentifier: string]: String
      read GetListViewSettings;
    property VersionInfo: string read GetVersionInfo;
  end;

const
  TVA508InitializeProcName = 'Initialize';
  TVA508InitializeExProcName = 'InitializeEx';
  TVA508ShutDownProcName = 'ShutDown';
  TVA508ViewSettingsFuncName = 'ListViewSettings';
  TVA508VersionInfoFuncName = 'VersionInfo';
  TVA508RegisterCustomBehaviorProcName = 'RegisterCustomBehavior';
  TVA508SpeakTextProcName = 'SpeakText';
  TVA508StopSpeechtProcName = 'StopSpeech';
  TVA508ComponentDataProcName = 'ComponentData';
  TVA508ComponentDataProcNameW = 'ComponentDataW';
  TVA508IsRunningFuncName = 'IsRunning';
  TVA508CheckJawsFuncName = 'FindJaws';
  TVA508ConfigChangePendingName = 'ConfigChangePending';
  TVA508ToolTipsEnabledFuncName = 'ToolTipsEnabled';
  TVA508IsControlGroupNameEnabledFuncName = 'IsControlGroupNameEnabled';

{$REGION 'Initialize Proc Definition'}

function Initialize(ComponentCallBackProc: TComponentDataRequestProc)
  : BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508InitializeProc;
begin
  CompileVerification := Initialize;
  Result := FALSE;
end;

function InitializeEx(ComponentCallBackProc: TComponentDataRequestProc;
  DoThread: BOOL; ShowSplash: BOOL; HostApplication: PChar): BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508InitializeExProc;
begin
  CompileVerification := InitializeEx;
  Result := FALSE;
end;

{$HINTS ON}
{$ENDREGION}
{$REGION 'ShutDown Proc Definition'}

procedure ShutDown; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508ShutDownProc;
begin
  CompileVerification := ShutDown;
end;

{$HINTS ON}
{$ENDREGION}
{$REGION 'RegisterCustomBehavior Proc Definition'}

procedure RegisterCustomBehavior(BehaviorType: integer;
  Before, After: PChar); stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508RegisterCustomBehaviorProc;
begin
  CompileVerification := RegisterCustomBehavior;
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'ComponentData Proc Definition'}

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;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508ComponentDataProc;
begin
  CompileVerification := ComponentData;
end;

procedure ComponentDataW(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; Hint: PChar = nil;
  AControlGroupName: PChar = nil); stdcall;
var
  CompileVerification: TVA508ComponentDataProcW;
begin
  CompileVerification := ComponentDataW;
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'SpeakText Proc Definition'}

procedure SpeakText(Text: PChar); stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508SpeakTextProc;
begin
  CompileVerification := SpeakText;
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'StopSpeech Proc Definition'}

procedure StopSpeech; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508StopSpeechProc;
begin
  CompileVerification := StopSpeech;
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'IsRunning Proc Definition'}

function IsRunning(HighVersion, LowVersion: Word): BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508IsRunningFunc;
begin
  CompileVerification := IsRunning;
  Result := FALSE; // avoid compiler warning...
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'CheckForJaws Proc Definition'}

function FindJaws(): BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508CheckJawsFunc;
begin
  CompileVerification := FindJaws;
  Result := FALSE; // avoid compiler warning...
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'ConfigChangePending Proc Definition'}

function ConfigChangePending: Boolean; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508ConfigChangePending;
begin
  CompileVerification := ConfigChangePending;
  Result := FALSE; // avoid compiler warning...
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'ToolTips Func Definition'}

function ToolTipsEnabled(): BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508ToolTipsEnabledFunc;
begin
  CompileVerification := ToolTipsEnabled;
  Result := FALSE; // avoid compiler warning...
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'IsControlGroupNameEnabled Func Definition'}

function IsControlGroupNameEnabled(): BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508IsControlGroupNameEnabledFunc;
begin
  CompileVerification := IsControlGroupNameEnabled;
  Result := FALSE; // avoid compiler warning...
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'ListView Settings Func Definition'}

function ListViewSettings(Identifier: PChar; Buffer: PChar; var BufferLen: Word)
  : BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508ListViewSettingsProc;
begin
  CompileVerification := ListViewSettings;
  Result := FALSE;
end;
{$HINTS ON}
{$ENDREGION}
{$REGION 'FrameWork Version info Func Definition'}

function VersionInfo(Buffer: PChar; var BufferLen: Word)
  : BOOL; stdcall;
{$HINTS OFF}   // Ignore unused variable hint
var
  CompileVerification: TVA508VersionInfoProc;
begin
  CompileVerification := VersionInfo;
  Result := FALSE;
end;
{$HINTS ON}
{$ENDREGION}

var
  FFrameworkCommunicator: TFrameworkCommunicator;

function FrameworkCommunicator: TFrameworkCommunicator;
begin
  If not assigned(FFrameworkCommunicator) then
    FFrameworkCommunicator := TFrameworkCommunicator.Create;
  Result := FFrameworkCommunicator;
end;

{$REGION 'Global Functions'}

Procedure FrameworkSpeakText(Text: string);
begin
  FrameworkCommunicator.SpeakCustomText(Text);
end;

Procedure FrameworkStopSpeech;
begin
  FrameworkCommunicator.StopSpeech;
end;

procedure FrameworkComponentData(WindowHandle: HWND;
  Caption, Value, Data, ControlType, State, Instructions, ItemInstructions,
  Hint, AControlGroupName: string; DataStatus: LongInt = DATA_NONE);
begin
  FrameworkCommunicator.ComponentData(WindowHandle, Caption, Value, Data,
    ControlType, State, Instructions, ItemInstructions, Hint, AControlGroupName,
    DataStatus);
end;

procedure FrameworkRegisterBehavior(BehaviorType: integer;
  Before, After: string);
begin
  FrameworkCommunicator.RegisterCustomBehavior(BehaviorType, Before, After)
end;

function FrameworkDLLsExist: Boolean;
begin
  Result := FrameworkCommunicator.DLLExist;
end;

function FrameworkConfigPending(): Boolean;
begin
  Result := FrameworkCommunicator.PendingConfigChange;
end;

function FrameWorkStart: Boolean;
begin
  Result := FrameworkCommunicator.Load508Framework;
end;

function FrameworkListViewSettings(Identifier: string): String;
begin
  Result := FrameworkCommunicator.ListViewSetting[Identifier];
end;

function FrameworkReadToolTips: Boolean;
begin
  Result := FrameworkCommunicator.ToolTipsEnabled;
end;

function FrameworkReadControlGroupName: Boolean;
begin
  Result := FrameworkCommunicator.IsControlGroupNameEnabled;
end;

function FrameworkVersionInfo: string;
begin
  Result := FrameworkCommunicator.VersionInfo;
end;

{$ENDREGION}
{ TFrameworkCommunicator }

constructor TFrameworkCommunicator.Create;
begin
  inherited;
  fDllHandle := 0;
  ClearProcPointers;
  fDoInitialize := TRUE;
  fInitializeResult := FALSE;
end;

destructor TFrameworkCommunicator.Destroy;
begin
  UnloadDLL;
  inherited;
end;

Function TFrameworkCommunicator.ProcessInitialize: Boolean;

  function FindScriptFileLocation(aBasePath, aFileName: string): String;
  const
    Jaws_Script_Folder = 'Jaws Scripts';
  var
    ScriptDir: String;
  begin
    aBasePath := AppendBackSlash(aBasePath);
    ScriptDir := Jaws_Script_Folder;
    ScriptDir := AppendBackSlash(ScriptDir);
    if FileExists(aBasePath + ScriptDir + aFileName) then
      Result := aBasePath + ScriptDir
    else if FileExists(aBasePath + aFileName) then
      Result := aBasePath
    else
      Result := '';
  end;

  function GetInitExProperties(aSections: TStringArray; aScriptFileName: String;
    out aDoThread, aShowSplash: Boolean): Boolean;
  const
    subSection = 'SplashScreen';
    p = '|';
  var
    ScriptsFile: TINIFile;
    s, SectionValue: String;
  begin
    Result := FALSE;
    ScriptsFile := TINIFile.Create(aScriptFileName);
    try
      for s in aSections do
      begin
        if ScriptsFile.SectionExists(s) and ScriptsFile.ValueExists(s,
          subSection) then
        begin
          SectionValue := ScriptsFile.ReadString(s, subSection, '');
          if not(Trim(SectionValue) = '') then
          begin
            aDoThread := Uppercase(Piece(SectionValue, p, 1)) = 'TRUE';
            aShowSplash := Uppercase(Piece(SectionValue, p, 2)) = 'TRUE';
            exit(TRUE);
          end
        end;
      end;
    finally
      FreeAndNil(ScriptsFile);
    end;
  end;

var
  ScriptsFileName, SectionName, path: String;
  DoThread, ShowSplash: Boolean;
  IniLookupSections: TStringArray;
begin
  Result := FALSE;
  ScriptsFileName := FindScriptFileLocation(ExtractFilePath(fFileName),
    JAWS_SCRIPT_LIST);
  if ScriptsFileName <> '' then
  begin
    ScriptsFileName := AppendBackSlash(ScriptsFileName) + JAWS_SCRIPT_LIST;
    if FileExists(ScriptsFileName) then
    begin
      // Get the full path
      SetLength(path, MAX_PATH);
      SetLength(path, GetModuleFileName(HInstance, PChar(path), Length(path)));

      // look for Product name
      SectionName := FileVersionValue(path, FILE_VER_PRODUCTNAME);
      SetLength(IniLookupSections, Length(IniLookupSections) + 1);
      IniLookupSections[high(IniLookupSections)] := SectionName;

      // look for Product name with version
      SectionName := SectionName + '|' + FileVersionValue(path,
        FILE_VER_FILEVERSION);
      SetLength(IniLookupSections, Length(IniLookupSections) + 1);
      IniLookupSections[high(IniLookupSections)] := SectionName;

      // look for executable name
      SectionName := Piece(ExtractFileName(path), '.', 1);
      SetLength(IniLookupSections, Length(IniLookupSections) + 1);
      IniLookupSections[high(IniLookupSections)] := SectionName;

      // look for executable name with version
      SectionName := SectionName + '|' + FileVersionValue(path,
        FILE_VER_FILEVERSION);
      SetLength(IniLookupSections, Length(IniLookupSections) + 1);
      IniLookupSections[high(IniLookupSections)] := SectionName;

      if GetInitExProperties(IniLookupSections, ScriptsFileName, DoThread,
        ShowSplash) then
      begin
        if Assigned(fSRInitializeEx) then
          Result := fSRInitializeEx(TVA508ManagerCallback.OnDataRequest, DoThread,
            ShowSplash, StrToPChar(path))
        else
          Result := FALSE;
      end
      else
      begin
        if Assigned(fSRInitialize) then
          Result := fSRInitialize(TVA508ManagerCallback.OnDataRequest)
        else
          Result := FALSE;
      end;
    end;
  end
  else
  begin
    if Assigned(fSRInitialize) then
      Result := fSRInitialize(TVA508ManagerCallback.OnDataRequest)
    else
      Result := FALSE;
  end;

end;

function TFrameworkCommunicator.InitializeScreenReaderLink: Boolean;
begin
  if fDoInitialize then
  begin
    try
      fInitializeResult := ProcessInitialize;
    Except
      On e: Exception do
        raise e.Create(Format(DllCallError, ['SRInitialize', e.Message]));
    End;
    fDoInitialize := FALSE;
  end;
  Result := fInitializeResult;
end;

function TFrameworkCommunicator.ValidateFrameworkSeesJaws(): Boolean;
begin
  Result := FALSE;
  Try
    if Assigned(fSRCheckJaws) then
      Result := fSRCheckJaws;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRCheckJaws', e.Message]));
  End;
end;

function TFrameworkCommunicator.ValidateRunning(): Boolean;
var
  HighVersion, LowVersion: integer;
begin
  // Calling IsRunning this way, instead of setting ok to it's result,
  // prevents ok from begin converted to a LongBool at compile time
  try
    VersionStringSplit(VA508AccessibilityManagerVersion, HighVersion,
      LowVersion);
    if Assigned(fSRIsRunning) and fSRIsRunning(HighVersion, LowVersion) then
      Result := TRUE
    else
      Result := FALSE;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRShutDown', e.Message]));
  End;
end;

function TFrameworkCommunicator.DoesDLLMethodExist
  (MethodName: PAnsiChar): Boolean;
begin
  Result := Assigned(GetProcAddress(fDllHandle, MethodName));
end;

function TFrameworkCommunicator.GetDLLExist: Boolean;
begin
  Result := fDLLFound;
end;

function TFrameworkCommunicator.GetVersionInfo: string;
var
  Buffer: TArray<Char>;
  BufferLen: Word;
begin
  Result := '';
  Try
    if Assigned(fSRVersionInfo) then
    begin
      BufferLen := MAX_PATH + 1;
      SetLength(Buffer, BufferLen);
      if not fSRVersionInfo(PChar(Buffer), BufferLen) then
      begin
        if GetLastError = ERROR_MORE_DATA then
        begin
          SetLength(Buffer, BufferLen);
          if not fSRVersionInfo(PChar(Buffer), BufferLen) then
            RaiseLastOSError;
        end;
      end;
      Result := PChar(Buffer);
    end;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['fSRVersionInfo', e.Message]));
  End;
end;

function TFrameworkCommunicator.GetPendingConfigChange: Boolean;
begin
  Result := FALSE;
  Try
    if Assigned(fSRConfigChangePending) then
      Result := fSRConfigChangePending;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRConfigChangePending',
        e.Message]));
  End;
end;

function TFrameworkCommunicator.GetListViewSettings(ListViewIdentifier
  : string): String;
var
  Buffer: TArray<Char>;
  BufferLen: Word;
begin
  Result := '';
  Try
    if Assigned(fSRListViewSettings) then
    begin
      BufferLen := MAX_PATH + 1;
      SetLength(Buffer, BufferLen);
      if not fSRListViewSettings(StrToPChar(ListViewIdentifier), PChar(Buffer),
        BufferLen) then
      begin
        if GetLastError = ERROR_MORE_DATA then
        begin
          SetLength(Buffer, BufferLen);
          if not fSRListViewSettings(StrToPChar(ListViewIdentifier),
            PChar(Buffer), BufferLen) then
            RaiseLastOSError;
        end;
      end;
      Result := PChar(Buffer);
    end;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRListViewSettings', e.Message]));
  End;
end;

function TFrameworkCommunicator.GetToolTipsEnabled: Boolean;
begin
  Result := FALSE;
  Try
    if Assigned(fSRToolTipsEnabled) then
      Result := fSRToolTipsEnabled;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRToolTipsEnabled', e.Message]));
  End;
end;

function TFrameworkCommunicator.GetIsControlGroupNameEnabled: Boolean;
begin
  Result := FALSE;
  Try
    if Assigned(fSRIsControlGroupNameEnabled) then
      Result := fSRIsControlGroupNameEnabled;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRIsControlGroupNameEnabled', e.Message]));
  End;
end;

function TFrameworkCommunicator.Validate508Procs(): Boolean;
begin
  Result := DoesDLLMethodExist(TVA508InitializeProcName) or
    DoesDLLMethodExist(TVA508InitializeExProcName);
  if not Result then
    exit;

  Result := DoesDLLMethodExist(TVA508ShutDownProcName);
  if not Result then
    exit;

  Result := DoesDLLMethodExist(TVA508RegisterCustomBehaviorProcName);
  if not Result then
    exit;

  Result := DoesDLLMethodExist(TVA508SpeakTextProcName);
  if not Result then
    exit;

  Result := DoesDLLMethodExist(TVA508IsRunningFuncName);
  if not Result then
    exit;

  Result := DoesDLLMethodExist(TVA508ComponentDataProcNameW);
  if not Result then
  begin
    fUseNewComponentData := FALSE;
    Result := DoesDLLMethodExist(TVA508ComponentDataProcName);
    if not Result then
      exit;
  end
  else
    fUseNewComponentData := TRUE;

  Result := DoesDLLMethodExist(TVA508ConfigChangePendingName);
  if not Result then
    exit;

  If fUseNewComponentData then
  begin
    Result := DoesDLLMethodExist(TVA508ToolTipsEnabledFuncName);
    if not Result then
      exit;

    Result := DoesDLLMethodExist(TVA508ViewSettingsFuncName);
    if not Result then
      exit;

    Result := DoesDLLMethodExist(TVA508StopSpeechtProcName);
    if not Result then
      exit;
  end;

end;

function TFrameworkCommunicator.Validate508DLL(FileName: string): Boolean;
begin
  Result := FALSE;
  if FileExists(FileName) then
  begin
    // assume this is a valid 508 DLL
    LoadDLL(FileName);
    try
      if fDllHandle > HINSTANCE_ERROR then
      begin
        // Verify that we have the right methods
        if Validate508Procs then
        begin
          // load up methods
          SetProcPointers;

          // validate the DLL
          if ValidateRunning and ValidateFrameworkSeesJaws and InitializeScreenReaderLink
          then
            Result := TRUE
          else
            Result := FALSE;
        end
        else
          Result := TRUE;
      end
      else
        Result := TRUE;
    finally
      if not Result then
        UnloadDLL;
    end;
  end
end;

function TFrameworkCommunicator.ScanForFramework
  (SearchDirs: TStringArray): Boolean;
var
  SR: TSearchRec;
  Done: integer;
  s: string;
begin
  Result := FALSE;

  for s in SearchDirs do
  begin
    if fDLLFound then
      break;
    if Trim(s) <> '' then
    begin
      Done := FindFirst(s + ScreenReaderSearchSpec, faAnyFile, SR);
      try
        while Done = 0 do
        begin
          if ((SR.Attr and BadFile) = 0) and
            (CompareText(ExtractFileExt(SR.Name), ScreenReaderFileExtension) = 0)
          then
          begin
            Result := Validate508DLL(s + SR.Name);
            fDLLFound := TRUE;
          end;
          Done := FindNext(SR);
        end;
      finally
        FindClose(SR);
      end;
    end;
  end;
end;

function TFrameworkCommunicator.Load508Framework: Boolean;
var
  SearchPaths: TStringArray;
  s: String;
begin
  if (fDllHandle = 0) then
  begin
    // setup search paths
    SetLength(SearchPaths, Length(SearchPaths) + 3);
    SearchPaths[0] := ExtractFilePath(Application.ExeName);
    s := GetAlternateProgramFilesPath;
    SearchPaths[1] := AppendBackSlash(s) + ScreenReaderCommonFilesDir;
    s := GetProgramFilesPath;
    SearchPaths[2] := AppendBackSlash(s) + ScreenReaderCommonFilesDir;

    // Try to load up the framework (if valid)
    ScanForFramework(SearchPaths);

  end;

  Result := fDllHandle <> 0;

end;

procedure TFrameworkCommunicator.ClearProcPointers;
begin
  fSRIsRunning := nil;
  fSRCheckJaws := nil;
  fSRInitialize := nil;
  fSRInitializeEx := nil;
  fSRShutDown := nil;
  fSRSpeakText := nil;
  fSRStopSpeech := nil;
  fSRComponentData := nil;
  fSRComponentDataW := nil;
  fSRRegisterCustomBehavior := nil;
  fSRConfigChangePending := nil;
  fSRToolTipsEnabled := nil;
  fSRIsControlGroupNameEnabled := nil;
  fSRListViewSettings := nil;
  fSRVersionInfo := nil;
  fDoInitialize := FALSE;
  fInitializeResult := FALSE;
end;

procedure TFrameworkCommunicator.SetProcPointers();
begin
  if not Assigned(fSRIsRunning) then
    fSRIsRunning := GetProcAddress(fDllHandle, TVA508IsRunningFuncName);
  if not Assigned(fSRCheckJaws) then
    fSRCheckJaws := GetProcAddress(fDllHandle, TVA508CheckJawsFuncName);
  if not Assigned(fSRInitialize) then
    fSRInitialize := GetProcAddress(fDllHandle, TVA508InitializeProcName);
  if not Assigned(fSRInitializeEx) then
    fSRInitializeEx := GetProcAddress(fDllHandle, TVA508InitializeExProcName);
  if not Assigned(fSRShutDown) then
    fSRShutDown := GetProcAddress(fDllHandle, TVA508ShutDownProcName);
  if not Assigned(fSRSpeakText) then
    fSRSpeakText := GetProcAddress(fDllHandle, TVA508SpeakTextProcName);
  if not Assigned(fSRStopSpeech) then
    fSRStopSpeech := GetProcAddress(fDllHandle, TVA508StopSpeechtProcName);
  if (not Assigned(fSRComponentData)) and (not Assigned(fSRComponentDataW)) then
  begin
    If fUseNewComponentData then
      fSRComponentDataW := GetProcAddress(fDllHandle,
        TVA508ComponentDataProcNameW)
    else
      fSRComponentData := GetProcAddress(fDllHandle,
        TVA508ComponentDataProcName);
  end;
  if not Assigned(fSRRegisterCustomBehavior) then
    fSRRegisterCustomBehavior := GetProcAddress(fDllHandle,
      TVA508RegisterCustomBehaviorProcName);
  if not Assigned(fSRConfigChangePending) then
    fSRConfigChangePending := GetProcAddress(fDllHandle,
      TVA508ConfigChangePendingName);
  if not Assigned(fSRToolTipsEnabled) then
    fSRToolTipsEnabled := GetProcAddress(fDllHandle,
      TVA508ToolTipsEnabledFuncName);
  if not Assigned(fSRIsControlGroupNameEnabled) then
    fSRIsControlGroupNameEnabled := GetProcAddress(fDllHandle,
      TVA508IsControlGroupNameEnabledFuncName);
  if not Assigned(fSRListViewSettings) then
    fSRListViewSettings := GetProcAddress(fDllHandle,
      TVA508ViewSettingsFuncName);
  if not Assigned(fSRVersionInfo) then
    fSRVersionInfo := GetProcAddress(fDllHandle,
      TVA508VersionInfoFuncName);
  fDoInitialize := TRUE;
end;

procedure TFrameworkCommunicator.ShutDown;
begin
  try
    if Assigned(fSRShutDown) then
      fSRShutDown;
  Except
    On e: Exception do
      raise e.Create(Format(DllCallError, ['SRShutDown', e.Message]));
  End;
end;

procedure TFrameworkCommunicator.SpeakCustomText(Text: String);
begin
  if (not Assigned(fSRSpeakText)) or (Text = '') then
    exit;
  try
    fSRSpeakText(StrToPChar(Text));
  except
    On e: Exception do
    begin
      if not e.ClassNameIs(TVA508Exception.ClassName) then
        raise e.Create(Format(DllCallError, ['SRSpeakText', e.Message]));
    end;
  end;
end;

procedure TFrameworkCommunicator.StopSpeech;
begin
  if not Assigned(fSRStopSpeech) then
    exit;
  try
    fSRStopSpeech;
  except
    On e: Exception do
    begin
      if not e.ClassNameIs(TVA508Exception.ClassName) then
        raise e.Create(Format(DllCallError, ['fSRStopSpeech', e.Message]));
    end;
  end;
end;

procedure TFrameworkCommunicator.RegisterCustomBehavior(BehaviorType: integer;
  Before, After: string);
begin
  if (not Assigned(fSRRegisterCustomBehavior)) then
    exit;
  try
    fSRRegisterCustomBehavior(BehaviorType, StrToPChar(Before),
      StrToPChar(After));
  except
    On e: Exception do
    begin
      if not e.ClassNameIs(TVA508Exception.ClassName) then
        raise e.Create(Format(DllCallError, ['SRSpeakText', e.Message]));
    end;
  end;
end;

function TFrameworkCommunicator.SRCompnentDataAssigned: Boolean;
begin
  Result := (Assigned(fSRComponentData)) or (Assigned(fSRComponentDataW));
end;

function TFrameworkCommunicator.StrToPChar(s: string): PChar;
begin
  if s = '' then
    Result := nil
  else
    Result := PChar(s);
end;

procedure TFrameworkCommunicator.ComponentData(WindowHandle: HWND;
  Caption, Value, Data, ControlType, State, Instructions, ItemInstructions,
  Hint, AControlGroupName: string; DataStatus: LongInt = DATA_NONE);
begin
  If not SRCompnentDataAssigned then
    exit;

  if Assigned(fSRComponentDataW) then
    fSRComponentDataW(WindowHandle, DataStatus, StrToPChar(Caption),
      StrToPChar(Value), StrToPChar(Data), StrToPChar(ControlType),
      StrToPChar(State), StrToPChar(Instructions), StrToPChar(ItemInstructions),
      StrToPChar(Hint), StrToPChar(AControlGroupName))
  else if Assigned(fSRComponentData) then
    fSRComponentData(WindowHandle, DataStatus, StrToPChar(Caption),
      StrToPChar(Value), StrToPChar(Data), StrToPChar(ControlType),
      StrToPChar(State), StrToPChar(Instructions),
      StrToPChar(ItemInstructions));
end;

procedure TFrameworkCommunicator.LoadDLL(aFileName: String);
begin
  if fDllHandle = 0 then
  begin
    fFileName := aFileName;
    fDllHandle := LoadLibrary(PChar(fFileName));
  end;
end;

procedure TFrameworkCommunicator.UnloadDLL;
begin
  if fDllHandle <> 0 then
  begin
    ShutDown;
    fFileName := '';
    FreeLibrary(fDllHandle);
    fDllHandle := 0;
    ClearProcPointers;
  end;
end;

initialization

If not assigned(FFrameworkCommunicator) then
 fFrameworkCommunicator := TFrameworkCommunicator.Create;

finalization

FreeAndNil(fFrameworkCommunicator);

end.
