Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

ShellExecAndWait and ExecAndWait functions with Office XP

395 views
Skip to first unread message

Stefan Cruysberghs

unread,
Nov 5, 2003, 3:56:54 AM11/5/03
to
I have been testing several ShellExecAndWait and ExecAndWait functions which
I have found on the internet. All functions do use WinAPI like
CreateProcess, WaitForSingleObject, GetExitCodeProcess, ShellExecuteEx, ...

All functions seems to work perfect with all kinds of EXE's, except the
Microsoft Office XP applications. These functions do start e.g. Word, but
they do not wait until Word is closed. Is there a solution for this problem
? How to check if it is Office XP ?

Thanks

Stefan


Stefan Cruysberghs

unread,
Nov 5, 2003, 11:03:19 AM11/5/03
to
It seems that I can not post an attachment. So here is the code of the
sample program.

{---------------------------------------------------------------------------
----
Test several ExecAndWait functions
They do not seem to work with MS Word XP
----------------------------------------------------------------------------
---}

unit Unit1;

interface

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

type
TForm1 = class(TForm)
adtBitBtn1: TadtBitBtn;
adtBitBtn2: TadtBitBtn;
adtBitBtn3: TadtBitBtn;
adtBitBtn4: TadtBitBtn;
adtBitBtn5: TadtBitBtn;
procedure adtBitBtn1Click(Sender: TObject);
procedure adtBitBtn2Click(Sender: TObject);
procedure adtBitBtn3Click(Sender: TObject);
procedure adtBitBtn4Click(Sender: TObject);
procedure adtBitBtn5Click(Sender: TObject);
private
public
end;

procedure ShellExecAndWait(dateiname: string; Parameter: string);
function ShellExecAndWait2(const FileName: string; const Parameters: string;
const Verb: string; CmdShow: Integer): Boolean;
function ExecAndWait(const Filename: string; WindowState: word =
SW_SHOWMAXIMIZED): boolean;
function ExecAndWait2(ExecFile:PChar; TimeOut:Word; AllowKill:Boolean;
Show:Boolean):Integer;
Function ExecAndWait3(sExe,sCommandLine:string): Boolean;


var
Form1: TForm1;

implementation

uses ShellAPI;

const
const_prg = 'C:\Program Files\Microsoft Office\Office10\Winword.exe';
//const_prg = 'calc.exe';
//const_prg = 'C:\Program Files\Microsoft Visual
Studio\VSS\Admin\SSEXP.EXE';


{$R *.dfm}

{---------------------------------------------------------------------------
--
ShellExecAndWait
* Description :
----------------------------------------------------------------------------
}
procedure ShellExecAndWait(dateiname: string; Parameter: string);
var
executeInfo: TShellExecuteInfo;
dw: DWORD;
begin
FillChar(executeInfo, SizeOf(executeInfo), 0);
with executeInfo do
begin
cbSize := SizeOf(executeInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
executeInfo.lpVerb := 'open';
executeInfo.lpParameters := PChar(Parameter);
lpFile := PChar(dateiname);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(@executeInfo) then
dw := executeInfo.HProcess
else
begin
{ ShowMessage('Fehler: ' + SysErrorMessage(GetLastError));
Exit;
}end;
while WaitForSingleObject(executeInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(dw);
end;

{---------------------------------------------------------------------------
--
ShellExecAndWait2
* Description :
----------------------------------------------------------------------------
}
function ShellExecAndWait2(const FileName: string; const Parameters: string;
const Verb: string; CmdShow: Integer): Boolean;
var
Sei: TShellExecuteInfo;
Res: LongBool;
Msg: tagMSG;

function PCharOrNil(const S: AnsiString): PAnsiChar;
begin
if Length(S) = 0 then
Result := nil
else
Result := PAnsiChar(S);
end;

begin
FillChar(Sei, SizeOf(Sei), #0);
Sei.cbSize := SizeOf(Sei);
Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or
SEE_MASK_NOCLOSEPROCESS or
SEE_MASK_FLAG_DDEWAIT;
Sei.lpFile := PChar(FileName);
Sei.lpParameters := PCharOrNil(Parameters);
Sei.lpVerb := PCharOrNil(Verb);
Sei.nShow := CmdShow;
Result := ShellExecuteEx(@Sei);
if Result then
begin
WaitForInputIdle(Sei.hProcess, INFINITE);
while (WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT) do
begin
repeat
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until (Res = False);
end;
CloseHandle(Sei.hProcess);
end;
end;

{---------------------------------------------------------------------------
--
ExecAndWait
* Description :
----------------------------------------------------------------------------
}
function ExecAndWait(const Filename: string; WindowState: word =
SW_SHOWMAXIMIZED): boolean;
var
SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine: string;
begin
//Dateinamen in Anführungszeichen wg. langer Dateinamen mit Blanks
CmdLine := '"' + Filename;

FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfo do
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := WindowState;
end;

Result := CreateProcess(nil, PChar(CmdLine), nil, nil, FALSE,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
PChar(ExtractFilePath(Filename)), SUInfo,
ProcInfo);

//Warten bis beendet
if Result then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;

{---------------------------------------------------------------------------
--
ExecAndWait2
* Description :
----------------------------------------------------------------------------
}
function ExecAndWait2(ExecFile:PChar; TimeOut:Word; AllowKill:Boolean;
Show:Boolean):Integer;
var
PROCESSINFO : TProcessInformation;
STARTUPINFO : TStartupInfo;
lpExitCode : Cardinal;
Msg : TMsg;
sTime : TDateTime;
hrs,mins,secs,msecs: Word;
begin
sTime:=SysUtils.Time;
Result := 0;
with STARTUPINFO do
begin
cb := SizeOf(STARTUPINFO);
lpReserved := nil;
lpDesktop := nil;
lpTitle := nil;
dwFlags := STARTF_USESHOWWINDOW;
lpReserved := nil;
cbReserved2 := 0;
lpReserved2 := nil;
If Show then
wShowWindow := SW_NORMAL
else
wShowWindow := SW_HIDE;
end;

if CreateProcess(nil,ExecFile,nil,nil,False,NORMAL_PRIORITY_CLASS,nil,nil,
STARTUPINFO,PROCESSINFO) then begin
repeat
while PeekMessage(Msg,0,0,0,PM_REMOVE) do
begin
if Msg.message = WM_QUIT then
Halt(Msg.wParam);
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
GetExitCodeProcess(PROCESSINFO.hProcess,lpExitCode);
decodetime (sysutils.time-stime,hrs,mins,secs,msecs);
hrs:=hrs*60+mins;
hrs:=hrs*60+secs;
if (TimeOut > 0) and (TimeOut < hrs) then
begin
Result := 1;
if AllowKill then
begin
if TerminateProcess(PROCESSINFO.hProcess,0) then
Result := 2
else
Result := 3;
end;
Break;
end;
until lpExitCode <> STILL_ACTIVE;
with PROCESSINFO do
begin
CloseHandle(hThread);
CloseHandle(hProcess);
end;
if Result = 0 then
Result := lpExitCode;
end
else
Result := GetLastError;
end;

{---------------------------------------------------------------------------
--
ExecAndWait3
* Description :
----------------------------------------------------------------------------
}
function ExecAndWait3(sExe,sCommandLine:string): Boolean;
var
tsi: TStartupInfo;
tpi: TProcessInformation;
dw: DWord;
begin
Result := False;

FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
if CreateProcess(
nil, { Pointer to Application }
PChar(sExe + ' ' + sCommandLine), { Pointer to Application mit
Parameter }
nil, { pointer to process security attributes }
nil, { pointer to thread security attributes }
False, { handle inheritance flag }
CREATE_NEW_CONSOLE, { creation flags }
nil, { pointer to new environment block }
nil, { pointer to current directory name }
tsi, { pointer to STARTUPINFO }
tpi) { pointer to PROCESS_INF } then
begin
if WAIT_OBJECT_0 = WaitForSingleObject(tpi.hProcess, INFINITE) then
begin
if GetExitCodeProcess(tpi.hProcess, dw) then
begin
if dw = 0 then
begin
Result := True;
end
else
begin
SetLastError(dw + $2000);
end;
end;
end;
dw := GetLastError;
CloseHandle(tpi.hProcess);
CloseHandle(tpi.hThread);
SetLastError(dw);
end;
end;

{---------------------------------------------------------------------------
--
TForm1.adtBitBtn1Click
* Description :
----------------------------------------------------------------------------
}
procedure TForm1.adtBitBtn1Click(Sender: TObject);
begin
ShellExecAndWait(const_prg,'');

ShowMessage('ok');
end;

{---------------------------------------------------------------------------
--
TForm1.adtBitBtn2Click
* Description :
----------------------------------------------------------------------------
}
procedure TForm1.adtBitBtn2Click(Sender: TObject);
begin
ShellExecAndWait2(const_prg,'','open',SW_SHOWMAXIMIZED);

ShowMessage('ok');
end;

{---------------------------------------------------------------------------
--
TForm1.adtBitBtn3Click
* Description :
----------------------------------------------------------------------------
}
procedure TForm1.adtBitBtn3Click(Sender: TObject);
begin
ExecAndWait(const_prg);

ShowMessage('ok');
end;

{---------------------------------------------------------------------------
--
TForm1.adtBitBtn4Click
* Description :
----------------------------------------------------------------------------
}
procedure TForm1.adtBitBtn4Click(Sender: TObject);
begin
ExecAndWait2(PChar(const_prg),0,False,True);

ShowMessage('ok');
end;

{---------------------------------------------------------------------------
--
TForm1.adtBitBtn5Click
* Description :
----------------------------------------------------------------------------
}
procedure TForm1.adtBitBtn5Click(Sender: TObject);
begin
ExecAndWait3(const_prg,'');

ShowMessage('ok');
end;

end.


"Stefan Cruysberghs" <s...@adtechno.be> wrote in message
news:3fa9...@newsgroups.borland.com...
> Attached you can find a demo program with 5 different ExecAndWait
functions
> which I have found on the internet. None of them seems to work with MS
Word
> XP.
>
> "Rob Kennedy" <.> wrote in message
news:3fa91bf9$1...@newsgroups.borland.com...

> > You're going to have to be more spcific about what causes the problem. I
> > just ran a test in which I used CreateProcess to start Word XP and
> > waited for it with WaitForSingleObject. My program was unresponsive
> > until I closed Word, just as I expected. It also worked properly when I
> > included a document on the command line.
> >
> > I also called ShellExecuteEx and waited successfully. If I omitted the
> > see_Mask_Flag_DDEWait flag, though, Word had trouble shutting down.
> >
> > --
> > Rob
> >
>
>
>
>


Stefan Cruysberghs

unread,
Nov 5, 2003, 11:02:05 AM11/5/03
to
Attached you can find a demo program with 5 different ExecAndWait functions

which I have found on the internet. None of them seems to work with MS Word
XP.

"Rob Kennedy" <.> wrote in message news:3fa91bf9$1...@newsgroups.borland.com...
> Stefan Cruysberghs wrote:

Rob Kennedy

unread,
Nov 5, 2003, 10:49:19 AM11/5/03
to

You're going to have to be more spcific about what causes the problem. I

Rob Kennedy

unread,
Nov 5, 2003, 1:03:55 PM11/5/03
to
Stefan Cruysberghs wrote:
> It seems that I can not post an attachment.

Attachements must go in the attachments newsgroup.

> So here is the code of the sample program.

Every one of the buttons works on my system. Looks like it's time for
you to start looking at the return values of the API functions being called.

--
Rob

Stefan Cruysberghs

unread,
Nov 12, 2003, 4:24:21 AM11/12/03
to
The WaitForSingleObject always returns 0.

I have tried the test application on 2 other PC's and there the same problem
occurs. All 5 ExecAndWait functions do work with normal EXE's, except
Winword XP. I also have used RealVNC to take remote control of my PC and
strange enough, in that case the test application does work.

"Rob Kennedy" <.> wrote in message news:3fa93b85$1...@newsgroups.borland.com...

0 new messages