* Re: Spawning subprocesses with GNAT
1998-10-08 0:00 Spawning subprocesses with GNAT Condic, Marin D.
@ 1998-10-14 0:00 ` Jerry van Dijk
0 siblings, 0 replies; 2+ messages in thread
From: Jerry van Dijk @ 1998-10-14 0:00 UTC (permalink / raw)
Condic, Marin D. (condicma@PWFL.COM) wrote:
: O.K. So a little bit of toying around with GNAT (3.10p) on a PC has proven
: that it has a better (read "working") method of spawning a child process
: than the Win32ada interface seems to have. (The function CreateProcess is
: available, but no matter how I juggle around parameters, it seems to not
: want to work.)
Well, the following works for me:
----- server_03.adb ---------------------------------------------------
with Ada.Text_IO;
procedure Server_03 is
begin
Ada.Text_IO.Put_Line ("Server_03 says 'hello!'");
delay 3.0;
end Server_03;
----- client_03.adb ---------------------------------------------------
-- example of executing another console process asynchronously (Win32)
-- the program 'server_03.exe' must exist in the same directory
pragma C_Pass_By_Copy (128);
with System;
with Ada.Text_IO;
with Win32.Winnt;
with Win32.Winbase;
with Interfaces.C.Strings;
with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
procedure Client_03 is
use type Win32.BOOL;
use type Interfaces.C.Unsigned_Long;
-- convert a C chars_ptr into a Win32 LPCSTR
function TO_LPCSTR is new Ada.Unchecked_Conversion
(Interfaces.C.Strings.Chars_Ptr, Win32.LPCSTR);
-- convert a C chars_ptr into a Win32 LPSTR
function TO_LPSTR is new Ada.Unchecked_Conversion
(Interfaces.C.Strings.Chars_Ptr, Win32.LPSTR);
-- convert a Win32 LPSTR into a C chars_ptr
function TO_Chars_Ptr is new Ada.Unchecked_Conversion
(Win32.LPSTR, Interfaces.C.Strings.Chars_Ptr);
-- convert an Ada String into a Win32 LPCSTR
function To_LPCSTR (S : String) return Win32.LPCSTR is
begin
return TO_LPCSTR (Interfaces.C.Strings.New_String (S));
end To_LPCSTR;
-- convert an Ada String into a Win32 LPSTR
function To_LPSTR (S : String) return Win32.LPSTR is
begin
return To_LPSTR (Interfaces.C.Strings.New_String (S));
end To_LPSTR;
-- free a Win32 LPCSTR
procedure Free (S : in out Win32.LPCSTR) is
function To_Chars_Ptr is new Ada.Unchecked_Conversion
(Win32.LPCSTR, Interfaces.C.Strings.Chars_Ptr);
C_String : Interfaces.C.Strings.Chars_Ptr := To_Chars_Ptr (S);
begin
Interfaces.C.Strings.Free (C_String);
S := To_LPCSTR (C_String);
end Free;
-- free a Win32 LPSTR
procedure Free (S : in out Win32.LPSTR) is
function To_Chars_Ptr is new Ada.Unchecked_Conversion
(Win32.LPSTR, Interfaces.C.Strings.Chars_Ptr);
C_String : Interfaces.C.Strings.Chars_Ptr := To_Chars_Ptr (S);
begin
Interfaces.C.Strings.Free (C_String);
S := To_LPSTR (C_String);
end Free;
-- free a STARTUPINFOA record
procedure Free is new Ada.Unchecked_Deallocation
(Win32.Winbase.STARTUPINFOA, Win32.Winbase.LPSTARTUPINFOA);
-- free a process information record
procedure Free is new Ada.Unchecked_Deallocation
(Win32.Winbase.PROCESS_INFORMATION, Win32.Winbase.LPPROCESS_INFORMATION);
-- buffer string
Buffer_Size : constant := 128;
Buffer_String : constant String (1 .. Buffer_Size) := (others => ' ');
Buffer : Win32.LPSTR := To_LPSTR (Buffer_String);
-- new console startup parameters
Our_Startup : constant Win32.Winbase.STARTUPINFOA := (
Cb => Win32.Winbase.STARTUPINFOA'Size / 8,
LpReserved => null,
LpDesktop => null,
LpTitle => null,
DwX => 0,
DwY => 0,
DwXSize => 0,
DwYSize => 0,
DwXCountChars => 0,
DwYCountChars => 0,
DwFillAttribute => 0,
DwFlags => 0,
WShowWindow => 0,
CbReserved2 => 0,
LpReserved2 => null,
HStdInput => System.Null_Address,
HStdOutput => System.Null_Address,
HStdError => System.Null_Address);
-- variables used
Result : Win32.BOOL;
Server_Path : Win32.LPCSTR := To_LPCSTR ("server_03.exe");
Startup_Info : Win32.Winbase.LPSTARTUPINFOA :=
new Win32.Winbase.STARTUPINFOA'(Our_Startup);
Process_Information : Win32.Winbase.LPPROCESS_INFORMATION :=
new Win32.Winbase.PROCESS_INFORMATION;
-- print an error message
procedure Error_Message (S : String) is
Result : Win32.DWORD;
begin
Result := Win32.Winbase.FormatMessage (
DwFlags => Win32.Winbase.FORMAT_MESSAGE_FROM_SYSTEM,
LpSource => System.Null_Address,
DwMessageId => Win32.Winbase.GetLastError,
DwLanguageId => Interfaces.C.Unsigned_Long (Win32.Winnt.MAKELANGID
(Win32.Winnt.LANG_NEUTRAL, Win32.Winnt.SUBLANG_DEFAULT)),
LpBuffer => Buffer,
NSize => Buffer_Size);
Ada.Text_IO.Put (S & ": ");
Ada.Text_IO.Put (Interfaces.C.Strings.Value (To_Chars_Ptr (Buffer)));
end Error_Message;
begin
-- starting program
Ada.Text_IO.Put_Line ("Client_03 starting...");
-- starting the server
Ada.Text_IO.Put_Line ("Starting Server_03...");
Result := Win32.Winbase.CreateProcess (
lpApplicationName => Server_Path,
lpCommandline => null,
lpProcessAttributes => null,
lpThreadAttributes => null,
bInheritHandles => Win32.FALSE,
dwCreationFlags => Win32.Winbase.CREATE_NEW_CONSOLE,
lpEnvironment => System.Null_Address,
lpCurrentDirectory => null,
lpStartupInfo => Startup_Info,
lpProcessInformation => Process_Information);
-- check if the server started
if Result = Win32.FALSE then
-- Whoops, our process didn't start
Error_Message ("*** Server failed to start");
else
-- wait for server to finish
Ada.Text_IO.Put_Line ("Waiting for Server_03 to finish");
if Win32.Winbase.WaitForSingleObject (Process_Information.HProcess,
Win32.Winbase.INFINITE) = Win32.Winbase.WAIT_FAILED then
-- Oops, something went terribly wrong...
Error_Message ("*** Waiting for server failed");
else
-- Ok, close the process handle for good
Ada.Text_IO.Put_Line ("Server_03 finished properly");
if Win32.Winbase.CloseHandle (Process_Information.HProcess) =
Win32.False then
-- Couldn't close the process handle
Error_Message ("*** Failed to close the server process handle");
else
Ada.Text_IO.Put_Line ("Server_03 closed");
end if;
end if;
end if;
-- Done
Ada.Text_IO.Put_Line ("Client_03 ending");
Free (Buffer);
Free (Server_Path);
Free (Startup_Info);
Free (Process_Information);
end Client_03;
--
-- Jerry van Dijk | email: jdijk@acm.org
-- Leiden, Holland | member Team-Ada
-- Ada & Win32: http://stad.dsl.nl/~jvandyk
^ permalink raw reply [flat|nested] 2+ messages in thread