home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / acl-lib.zip / RunProgramUnit.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-06-25  |  5.7 KB  |  184 lines
  1. unit RunProgramUnit;
  2.  
  3. interface
  4.  
  5. Uses
  6.   Windows, ACLUtility;
  7.  
  8. // Runs a program in the given working directory.
  9. // If PrintOutput is set, StdOut (and StdErr) will be piped to
  10. // the PrintOutput method
  11.  
  12. // CheckTerminateCallback will be called regularly and if the
  13. // process should be terminated, it should return true
  14.  
  15. // Function returns true if the program was started OK.
  16. // ResultCode is set to 1 if the program did not start, otherwise
  17. // the exit code of the process
  18. Function RunProgram( ProgramName: string;
  19.                      Parameters: string;
  20.                      WorkingDir: string;
  21.                      Var ResultCode: DWORD;
  22.                      TerminateCheck: TTerminateCheck = nil;
  23.                      PrintOutput: TPrintOutput = nil
  24.                    ): boolean;
  25. implementation
  26.  
  27. Uses
  28.   SysUtils;
  29.  
  30. Function GetWindowsErrorString( ErrorCode: integer ): string;
  31. var
  32.   buffer: array[ 0..1000 ] of char;
  33. begin
  34.   if FormatMessage( FORMAT_MESSAGE_FROM_SYSTEM,
  35.                    nil, // no special message source
  36.                    ErrorCode,
  37.                    0, // use default language
  38.                    Buffer,
  39.                    Sizeof( Buffer ),
  40.                    nil ) > 0
  41.   then // no arguments
  42.     Result:= Buffer
  43.   else
  44.     Result:= '(Unknown error)';
  45.  
  46. end;
  47.  
  48. Function RunProgram( ProgramName: string;
  49.                      Parameters: string;
  50.                      WorkingDir: string;
  51.                      Var ResultCode: DWORD;
  52.                      TerminateCheck: TTerminateCheck;
  53.                      PrintOutput: TPrintOutput
  54.                    ): boolean;
  55. Const
  56.   PipeBufferSize = 10000;
  57.   PipeName = '\\.\pipe\myoutputpipe';
  58. Var
  59.   StartupInfo: TStartupInfo;
  60.   ProcessInfo: TProcessInformation;
  61.   rc: DWORD;
  62.   NameAndArgs: string;
  63.  
  64.   pipeServer: hFile;
  65.   buffer: array[ 0..PipeBufferSize ] of char;
  66.   bytesRead: DWORD;
  67.   SecAttrs: TSecurityAttributes;
  68.   pipeClient: hFile;
  69. Begin
  70.  
  71.   pipeServer:= 0;
  72.   pipeClient:= 0;
  73.   try
  74.     NameAndArgs:= ProgramName+' '+Parameters;
  75.  
  76.     // Initialize some variables to create a process
  77.     ZeroMemory( @StartupInfo, SizeOf( StartupInfo ) );
  78.  
  79.     StartupInfo.cb := SizeOf( StartupInfo );
  80.     StartupInfo.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  81.     StartupInfo.wShowWindow := SW_HIDE;
  82.  
  83.     if Assigned( PrintOutput ) then
  84.     begin
  85.       // Allow the started process to inherit our handles
  86.       FillChar( SecAttrs, SizeOf( SecAttrs ), #0);
  87.       SecAttrs.nLength              := SizeOf(SecAttrs);
  88.       SecAttrs.lpSecurityDescriptor := nil;
  89.       SecAttrs.bInheritHandle       := TRUE;
  90.  
  91.       // Create a pipe
  92.       pipeServer:= CreateNamedPipe( PipeName,
  93.                                     PIPE_ACCESS_DUPLEX,
  94.                                     PIPE_TYPE_BYTE or PIPE_NOWAIT,
  95.                                     PIPE_UNLIMITED_INSTANCES,
  96.                                     PipeBufferSize, //out buffer
  97.                                     PipeBufferSize, // in buffer
  98.                                     100, // default timeout (ms)
  99.                                     Addr( SecAttrs ) );
  100.  
  101.       // Get a handle to the other (client) end of the pipe
  102.       pipeClient:= CreateFile( PipeName,
  103.                                GENERIC_READ or GENERIC_WRITE,
  104.                                FILE_SHARE_READ or FILE_SHARE_WRITE,
  105.                                Addr( SecAttrs ),
  106.                                OPEN_EXISTING,
  107.                                FILE_ATTRIBUTE_NORMAL,
  108.                                0 );
  109.  
  110.       // setup the process to write into the other end
  111.       StartupInfo.hStdOutput:= pipeClient;
  112.       StartupInfo.hStdError:= pipeClient;
  113.     end;
  114.  
  115.     // Create the process
  116.     Result:= CreateProcess( Nil, // use next param for exe name
  117.                             PChar( NameAndArgs ), // command line
  118.                             Nil, // no security attributes
  119.                             Nil, // no thread security attributes
  120.                             True, // do inherit handles
  121.                             CREATE_NEW_PROCESS_GROUP, // so we can send
  122.                             // it Ctrl signals
  123.                             Nil, // no new environment
  124.                             PChar( WorkingDir ), // directory
  125.                             StartupInfo,
  126.                             ProcessInfo );
  127.     if not Result then
  128.     begin
  129.       PrintOutput( 'Could not run '+NameAndArgs );
  130.       PrintOutput( 'Windows error text: ' + GetWindowsErrorString( GetLastError ) );
  131.       ResultCode:= 1;
  132.       exit;
  133.     end;
  134.  
  135.     while true do
  136.     begin
  137.       if Assigned( TerminateCheck ) then
  138.         if TerminateCheck then
  139.         begin
  140.           GenerateConsoleCtrlEvent( CTRL_BREAK_EVENT, ProcessInfo.dwProcessID );
  141.           ResultCode:= 1;
  142.           exit;
  143.         end;
  144.  
  145.       // Wait 1 second to see if it finishes...
  146.       rc:= WaitForSingleObject( ProcessInfo.hProcess, 1000);
  147.  
  148.       if Assigned( PrintOutput ) then
  149.       begin
  150.         repeat
  151.           // Read the output from our end of the pipe
  152.           ReadFile( pipeServer,
  153.                     buffer,
  154.                     PipeBufferSize,
  155.                     bytesRead,
  156.                     nil );
  157.           buffer[ bytesRead ]:= #0; // null terminate
  158.           if bytesRead > 0 then
  159.             PrintOutput( buffer );
  160.  
  161.         until bytesRead=0;
  162.  
  163.       end;
  164.  
  165.       if rc<>WAIT_TIMEOUT then
  166.       begin
  167.         // finished
  168.         GetExitCodeProcess( ProcessInfo.hProcess,
  169.                             ResultCode );
  170.         // terminate loop
  171.         exit;
  172.       end;
  173.     end;
  174.   finally
  175.     if pipeClient<>0 then
  176.       CloseHandle( pipeClient );
  177.     if pipeServer<>0 then
  178.       CloseHandle( pipeServer );
  179.   end;
  180.  
  181. end;
  182.  
  183. end.
  184.