Hello,

I am using Delphi XE.

I have a program that opens and uses OSK.exe. The program is 32 bit and 
the OS is 64 bit. Works great.

I am not trying to use the code in another program, copy and paste, and 
the second program and test program fail. 

The reported error is "Could not start On-Screen Keyboard".

Below is the source code. It really is not that much. Why it works for 
one program and not others is a mystery. I have tried using 
CreateProcess inplace of ShellExecute without joy.


Any ideas?

Thanks,

Mark


unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, 
Forms,Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ShowBtn: TButton;
    HideBtn: TButton;
    procedure ShowBtnClick(Sender: TObject);
    procedure HideBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI;

type
 TWow64DisableWow64FsRedirection = function (Var 
Wow64FsEnableRedirection: LongBool): LongBool; stdcall;
 TWow64EnableWow64FsRedirection = function (Wow64FsEnableRedirection: 
LongBool):LongBool; stdcall;
 TIsWow64Process = function (Handle:THandle; var IsWow64 : BOOL) : BOOL; 
stdcall;

var
 is64Bit:boolean;
 kernalHandle:THandle;

 Wow64DisableWow64FsRedirection:TWow64DisableWow64FsRedirection;
 Wow64EnableWow64FsRedirection:TWow64EnableWow64FsRedirection;
 IsWow64Process:TIsWow64Process;

function IS64:Boolean;
var
 xIS64:Bool;
begin
 if IsWow64Process(GetCurrentProcess, xIS64) then
  Result:=xIS64
 else
  Result:=false;
end;

procedure LaunchApplication(const appName:string; pStrings:array of 
string);
var
 i,start:integer;
 paramString:string;
 fName,lpOperation,params,defaultDir:array[0..511] of char;
begin
 if (appName = '') then
  Exit;

 start:=0;
 if (pStrings[0] = '') then
  start:=1;

 paramString:='';
 for i:= start to high(pStrings) do
  begin
   paramString:=paramString + pStrings[i];
   if (i <> high(pStrings)) then
    paramString:=paramString + ' ';
  end;

 ShellExecute(0,
              StrPCopy(lpOperation,pStrings[0]),
              StrPCopy(fName,appName),
              StrPCopy(params,paramString),
              StrPCopy(defaultDir,'C:\'),SW_SHOWNORMAL);
end;

procedure LaunchOSK;
var
 Wow64FsEnableRedirection:longBool;
begin
 try
  if is64Bit then
   Wow64DisableWow64FsRedirection(Wow64FsEnableRedirection);

  LaunchApplication('OSK.EXE',['']);
 finally
  if is64Bit then
   Wow64EnableWow64FsRedirection(Wow64FsEnableRedirection)
 end;
end;

procedure KillOSK;
var
 appHandle:THandle;
begin
 appHandle:=FindWindow(nil,PWideChar('On-Screen Keyboard'));
 if (appHandle <> 0) then
  PostMessage(appHandle,WM_QUIT,0,0);
end;

procedure TForm1.HideBtnClick(Sender: TObject);
begin
 KillOSK;
end;

procedure TForm1.ShowBtnClick(Sender: TObject);
begin
 LaunchOSK
end;

initialization
 kernalHandle:=LoadLibrary('kernel32.dll');
 if (kernalHandle <> 0) then
  begin
   @IsWow64Process:=GetProcAddress(kernalHandle, 'IsWow64Process');
   is64Bit:=IS64;
   if is64Bit then
    begin
     @Wow64DisableWow64FsRedirection:=GetProcAddress(kernalHandle, 
'Wow64EnableWow64FsRedirection');
     @Wow64EnableWow64FsRedirection:=GetProcAddress(kernalHandle, 
'Wow64EnableWow64FsRedirection');
    end;
  end;

end.


---------------------DFM------------------------

object Form1: TForm1
  Left = 308
  Top = 94
  Caption = 'Main'
  ClientHeight = 712
  ClientWidth = 764
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ShowBtn: TButton
    Left = 96
    Top = 80
    Width = 505
    Height = 113
    Caption = 'Show keyboard'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 0
    OnClick = ShowBtnClick
  end
  object HideBtn: TButton
    Left = 96
    Top = 199
    Width = 505
    Height = 113
    Caption = 'Hide keyboard'
    Font.Charset = DEFAULT_CHARSET
    Font.Color = clWindowText
    Font.Height = -21
    Font.Name = 'Tahoma'
    Font.Style = []
    ParentFont = False
    TabOrder = 1
    OnClick = HideBtnClick
  end
end

Mark wrote:

> When I tested on XP, orginally, it gave an error that kernel32.dll
> could not be loaded. Not sure what SP but, dynamically loading works.

EVERY process uses kernel32.dll.  It is loaded automatically as part of the 
startup logic for a new process.  That has always been true.  

--
Remy Lebeau (TeamB)

> All processes have kernel32.dll automatically loaded at startup, so 
> you do 

When I tested on XP, orginally, it gave an error that kernel32.dll could 
not be loaded. Not sure what SP but, dynamically loading works.

> As for IsWow64Process(), it exists in XP 

Same as above, I have customers running on some real old stuff. Plus XP 
embedded and I need to really defensive program.  

Thanks for the data on "delayed". 

Thanks for your help.

Mark wrote:

> I am targetting XP so I need to dynamiclly load the kernel32.dll.

All processes have kernel32.dll automatically loaded at startup, so you do 
not need to call LoadLibrary() on it.  If you need a handle to it, use GetModuleHandle('kernel32') 
instead.  As for IsWow64Process(), it exists in XP (SP2 or higher is needed). 
 XP 64bit was the first 64bit version of Windows, and is the one that introduced 
WOW64.

If you look more carefully at the code I gave you, it uses Delphi's delay-load 
feature (which was introduced in Delphi 2010) to dynamically load the function:

{code}
function IsWow64Process(Handle: THandle; var IsWow64 : BOOL) : BOOL; stdcall; 
external 'kernel32.dll' delayed;
{code}

You do not need to call GetProcAddress() manually, the RTL can do it for 
you.  Read the documentation for more info:

http://docwiki.embarcadero.com/RADStudio/2010/en/Libraries_and_Packages#Delayed_Loading
http://docwiki.embarcadero.com/CodeExamples/XE7/en/DelayedLoading_(Delphi)

Also, I see you removed the IFDEFs I had added.  If you ever decide to recompile 
your app for 64bit in the future, there is no need to call IsWow64Process() 
since it will always report False.  You only need to call IsWow64Process() 
in a 32bit process running on a 64bit OS.

--
Remy Lebeau (TeamB)

Remy, thank you very much. Your answer is excellent.

I am targetting XP so I need to dynamiclly load the kernel32.dll.

So below is the working/tested code in the proof program. If I have 
trouble in the real programs I will update the thread.

Again, Remy--Thank you.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, 
Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ShowBtn: TButton;
    HideBtn: TButton;
    procedure ShowBtnClick(Sender: TObject);
    procedure HideBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses ShellAPI;

type
 TIsWow64Process = function (Handle:THandle; var IsWow64 : BOOL) : BOOL; 
stdcall;

var
 is64Bit:boolean;
 kernalHandle:THandle;
 IsWow64Process:TIsWow64Process;

function IS64:Boolean;
var
 xIS64:Bool;
begin
 result:=false;
 if CheckWin32Version(5, 2) then
  begin
   if IsWow64Process(GetCurrentProcess, xIS64) then
    result:=xIS64;
  end;
end;

procedure LaunchApplication(const appName:string; pStrings:array of 
string);
var
 i,start:integer;
 paramString:string;
 fName,lpOperation,params,defaultDir:array[0..511] of char;
begin
 if (appName = '') then
  Exit;

 start:=0;
 if (pStrings[0] = '') then
  start:=1;

 paramString:='';
 for i:= start to high(pStrings) do
  begin
   paramString:=paramString + pStrings[i];
   if (i <> high(pStrings)) then
    paramString:=paramString + ' ';
  end;

 ShellExecute(0,
              StrPCopy(lpOperation,pStrings[0]),
              StrPCopy(fName,appName),
              StrPCopy(params,paramString),
              StrPCopy(defaultDir,'C:\'),SW_SHOWNORMAL);
end;


function GetWindowsDir: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
 if (GetWindowsDirectory(Path, MAX_PATH) = 0) then
  RaiseLastOSError;
 Result:=IncludeTrailingPathDelimiter(Path);
end;

function GetSystemDir: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
 if (GetSystemDirectory(Path, MAX_PATH) = 0) then
  RaiseLastOSError;
 Result:= IncludeTrailingPathDelimiter(Path);
end;

function GetNativeSystemDir: string;
begin
 if is64Bit then
  Result:=GetWindowsDir + 'sysnative' + PathDelim
 else
  Result:=GetSystemDir;
end;

procedure LaunchOSK;
begin
  LaunchApplication(GetNativeSystemDir + 'OSK.EXE', ['']);
end;

procedure KillOSK;
var
 appHandle:THandle;
begin
 appHandle:=FindWindow(nil,PWideChar('On-Screen Keyboard'));
 if (appHandle <> 0) then
  PostMessage(appHandle,WM_QUIT,0,0);
end;

procedure TForm1.HideBtnClick(Sender: TObject);
begin
 KillOSK;
end;

procedure TForm1.ShowBtnClick(Sender: TObject);
begin
 LaunchOSK;
end;

initialization
 kernalHandle:=LoadLibrary('kernel32.dll');
 if (kernalHandle <> 0) then
  begin
   @IsWow64Process:=GetProcAddress(kernalHandle, 'IsWow64Process');
   is64Bit:=IS64;
  end;

end.

Mark your:

> Below is the source code. It really is not that much. Why it works
> for one program and not others is a mystery. I have tried using
> CreateProcess inplace of ShellExecute without joy.

You are doing too much work, and dangerous work at that.  Disabling the FileSystem 
Redirector, even momentarily, has a global effect on the entire system, not 
just the calling process.  OSK.EXE resides in the System32 folder, so you 
can use WOW64's special "sysnative" alias to bypass the FileSystem Redirector 
and use the real System32 folder path.  I demonstrated this in the following 
StackOverflow answer:

http://stackoverflow.com/a/12852118/65863

If you want to run the 64bit OSK.EXE (why not let WOW64 run the 32bit version 
normaly?) then try something like this:

{code}
{$IFDEF WIN64}
function IsWow64: Boolean;
begin
  Result := False;
end;
{$ELSE}
function IsWow64Process(Handle: THandle; var IsWow64 : BOOL) : BOOL; stdcall; 
external 'kernel32.dll' delayed;
function IsWow64: Boolean;
var
  xIsWow64: BOOL;
begin
  Result := false;
  if CheckWin32Version(5, 2) then
  begin
    if IsWow64Process(GetCurrentProcess(), xIsWow64) then
      Result := xIsWow64;
  end;
end;
{$ENDIF}

procedure LaunchApplication(const appName: string; params: array of string 
= []; const operation: string = '', const workingDir: string = '');
var
  i: Integer;
  paramString: string;
begin
  if (appName = '') then
    Exit;
  paramString := '';
  for i := Low(params) to high(params) do
  begin
    paramString := paramString + params[i];
    if (i < High(pStrings)) then
      paramString := paramString + ' ';
  end;
  // the Pointer casts allow nil to be passed for empty strings...
  ShellExecute(0,
    PChar(Pointer(operation)), // nil = default operation
    PChar(appName),
    PChar(Pointer(paramString)), // nil = no params
    PChar(Pointer(workingDir)), // nil = use current working directory
    SW_SHOWNORMAL);
end;

function GetWindowsDir: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
  if GetWindowsDirectory(Path, MAX_PATH) = 0 then
    RaiseLastOSError;
  Result = IncludeTrailingPathDelimiter(Path);
end;

function GetSystemDir: string;
var
  Path: array[0..MAX_PATH] of Char;
begin
  if GetSystemDirectory(Path, MAX_PATH) = 0 then
    RaiseLastOSError;
  Result = IncludeTrailingPathDelimiter(Path);
end;

function GetNativeSystemDir: string;
begin
  if IsWow64 then
    Result := GetWindowsDir + 'sysnative' + PathDelim;
  else
    Result := GetSystemDir;
end;

procedure LaunchOSK;
begin
  LaunchApplication(GetNativeSystemDir + 'OSK.EXE');
end;

procedure KillOSK;
var
  appHandle: HWND;
begin
  appHandle := FindWindow(nil, 'On-Screen Keyboard');
  if (appHandle <> 0) then
    PostMessage(appHandle, WM_QUIT, 0, 0);
end;
{code}

--
Remy Lebeau (TeamB)