unit ExecUtil;
{    Unit ExecUtil.Pas
     Copyright 1996 By Makoto Muramatsu
     Version 1.2

  Features
     function WinExecForMulti : Execute CommandLine on Multi Windows.
     function ShellExecuteForMulti : Execute Application by DataFile
                                                         on Multi Windows.
     function CheckModuleUsage: Checking Application Using or Not by Handle
     procedure WaitForAppl: Wait For finish of Application on Multi Window
     procedure Releasehandle: Release Process Handle for Win32.

  Syntax : Please read following.(Interface section)

  Description:
    These Functions can use Delphi 1.0 and Delphi 2.0 and use On Windows 3.1,
    on Windows 95 and Windows NT3.51.
    Application Execute and Wait for finish of the process.

  Example
    var
      handle : THandle;
    begin
      handle := ShellExecuteForMulti(
         Application.Handle,
         'open',
         'C:\ReadMe.TXT',
         '',
         'C:\',
         SW_SHOW );
  or
      handle := WinExecForMulti(
        'Notpad.exe',
        'C:\',
        SW_SHOW );
      WaitForAppl( handle );
      ReleaseHandle( handle );
      MessageDlg( 'FinishAppl',mtInformation,[mbOK],0);
    end;

  Error:
    If Delphi 1.0 and handle < 32 then Error. Please Read Help "WinExec".
    If Delphi 2.0 and handle = 0 then Error. Please GetLastError and read Help.
  
  Bug Report & Request to PXK04012@niftyserve.or.jp
  
  Logs: '96.5.21
        Fixed 
          WaitForAppl do not repaint the window up to finish,by Delphi 2.0.
          
        Version Up 1.0 -> 1.1
        
        '96.6.11
        Fixed CheckModuleUsage return Illegal value by Delphi 1.0(Check
         Win32 Application)
        
        Version up 1.1 -> 1.2
  Regard.
}

interface

uses
  {$IFDEF Win32}Windows
  {$ELSE} WinProcs, WinTypes{$ENDIF};

function CheckModuleUsage(
    const AHandle: THandle  {If Delphi 2.0 then ProcessHandle;
                           1.0 then InstanceHandle}
    ): Boolean;
    {AHandle is Using or Not. If Using then return True}

procedure ReleaseHandle(
  const AHandle: THandle
  );
  {Release Process Handle For Win32 }

function ShellExecuteForMulti(
  const AHWnd: HWND;        { handle to parent window}
  const AOperation : string;{pointer to string that specifies operation to perform}
  const AFile : string;     {pointer to filename string}
  const AParameter: string;
              {pointer to string that specifies executable-file parameters}
  const ADirectory: string; {pointer to string that specifies default directory}
  const AShowCmd : Integer  {whether file is shown when opened}
  ): THandle; {IF Delphi 2.0 then return processHandle, 1.0 then Instancehandle}

procedure WaitForAppl(
    const AHandle: THandle {If Delphi 2.0 then ProcessHandle;
                           1.0 then InstanceHandle}
     );
    {Wait for Finishing of the application associated by AHandle}

function WinExecForMulti(
    const ACmdLine : string;           { address of command line }
    const ADirectory: string;
          {pointer to string that specifies default directory}
    const ACmdShow : integer          {window style for new application}
    ) : THandle;
{If Delphi 2.0 then return Process Handle, 1.0 then return InstanceHandle
 If Delphi 1.0 then ignore ACurrentDirectory }

implementation

uses Forms, {$IFDEF Win32} Registry, {$ELSE} ToolHelp,{$ENDIF}
     ShellAPI, SysUtils;

const
  FileKey = '%1';
  EXEEXTENTION = '.EXE';
  COMEXTENTION = '.COM';
  PATHBUFFERSIZE = 257;

{$IFNDEF Win32}
function InstanceToTask( Inst: THandle ): THandle;
var
   TaskEntry : TTaskEntry;
   TaskHandle : THandle;
   NextExist : Boolean;
begin
    TaskEntry.dwSize := SizeOf(TaskEntry);
    TaskHandle := 0;
    if TaskFirst(@TaskEntry) then begin
        repeat
            if TaskEntry.hInst = Inst then begin
                TaskHandle := TaskEntry.hTask;
                break;
            end;
            NextExist := TaskNext(@TaskEntry);
        until Not NextExist;
    end;
    Result := TaskHandle;
end;
{$ENDIF}

function CheckModuleUsage;
var
{$IFDEF Win32}
  exitCode: DWord;
{$ELSE}
   Task : THandle;
   moduleEntry: TModuleEntry;
{$ENDIF}

begin
{$IFDEF Win32}
  exitCode := WaitForSingleObject( AHandle, 0 );
  if exitCode = WAIT_TIMEOUT then begin
    Result := TRUE;
  end
  else begin
    Result := False;
  end;
{$ELSE}
  Task := InstanceToTask( AHandle);
  if Task = 0 then begin
    moduleEntry.dwSize := sizeof( TModuleEntry );
    result := Not (ModuleFindHandle( @moduleEntry, AHandle ) = 0);
  end
  else begin
    Result := IsTask(Task) ;
  end;
{$ENDIF}
end;

procedure ReleaseHandle;
begin
{$IFDEF WIN32}
  CloseHandle( AHandle );
{$ENDIF}
end;

procedure WaitForAppl;
var
{$IFDEF Win32}
  exitCode: DWord;
{$ELSE}
  Task : THandle;
  moduleEntry: TModuleEntry;
{$ENDIF}
begin
{$IFDEF Win32}
  Repeat
    exitCode := WaitForSingleObject( AHandle, 0);
    Application.ProcessMessages;
  Until exitCode <> WAIT_TIMEOUT;
{$ELSE}
  Task := InstanceToTask( AHandle);
  if Task = 0 then begin
    moduleEntry.dwSize := sizeOf( TModuleEntry );
    while ModuleFindHandle( @moduleEntry, AHandle ) <> 0 do begin
      moduleEntry.dwSize := sizeOf( TModuleEntry );
      Application.ProcessMessages;
    end;
  end
  else begin
    while IsTask(Task) do begin
      Application.ProcessMessages;
    end;
  end;
{$ENDIF}
end;


Function WinExecForMulti;
var
  currentDir: string;
{$IFDEF WIN32}
  {processAttributes, ThreadAttributes: TSecurityAttributes;}
  startupInfo: TStartupInfo;
  processInfomation: TProcessInformation;
  currentDirBuff : PChar;
{$else}
  cmdLine: PChar;
{$Endif}
begin
  currentDir := ADirectory;
  if CompareText( currentDir, '' ) = 0 then begin
{$IFDEF Win32}
    currentDirBuff := StrAlloc( PATHBUFFERSIZE );
    try
      if GetCurrentDirectory( PATHBUFFERSIZE, currentDirBuff ) > 0 then begin
        currentDir := StrPas( currentDirBuff );
      end;
    finally
      StrDispose( currentDirBuff );
    end;
{$ELSE}
    System.GetDir( 0, currentDir );
{$ENDIF}
  end;
{$IFDEF WIN32}
  GetStartupInfo( startupInfo );
  startupInfo.wShowWindow := ACmdShow;
  if CreateProcess(
    NIL, {ApplicationName}
    PChar( ACmdLine ), { lpCommandLine }
    NIL,{lpProcessAttributes}
    NIL,{lpThreadAttribute}
    FALSE,{bInheritedHandles}
    NORMAL_PRIORITY_CLASS,{dwCreationFlags}
    NIL,{lpEnvironment}
    PChar( currentDir ),{lpCurrentDirectory}
    startupInfo,{lpStartupInfo}
    processInfomation{lpProcessInfomation}
    ) then begin
    {Success}
      Result := processInfomation.hProcess;
  end
  else begin
    {fail}
      Result := 0;
  end;
{$ELSE}
  cmdLine := StrAlloc( length( ACmdLine ) + 1 );
  try
    strPCopy( cmdLine, ACmdLine );
    Result := WinExec( cmdLine, ACmdShow );
  finally
    StrDispose( cmdLine );
  end;
{$ENDIF}
end;

function ShellExecuteForMulti;
var
  currentDir : string;
{$IFDEF WIN32}
  versionInfo: TOSVersionInfo;
  shellExecInfo: TShellExecuteInfo;
  currentDirBuff : PChar;
{$ENDIF}
  operation: PChar;
  filename : PChar;
  param : PChar;
  directory : PChar;

{$IFDEF Win32}
  function ShellExec95 :THandle;
  begin
     with ShellExecInfo do begin
       cbSize := sizeof( TShellExecuteInfo );
       fMask := SEE_MASK_NOCLOSEPROCESS;
       Wnd := AHWND;
       lpVerb := PChar(AOperation) ;
       lpFile := PChar( AFile );
       lpParameters := PChar( AParameter );
       lpDirectory := PChar( currentDir ) ;
       nShow := AShowCmd;
       hInstApp := Application.Handle;
 {      lpIDList;
       lpClass;
       hKeyClass;
       dwHotKey;
       hIcon;
       hProcess; }
     end;

     if ShellExecuteEx( @shellExecInfo ) then begin
       Result := shellExecInfo.hProcess;
     end
     else begin
       Result := 0;
     end;
  end;

  function ShellExecNT : THandle;
  var
    startupInfo: TStartupInfo;
    processInfomation: TProcessInformation;
    commandLine : string;
    ext : string;
    FilePosition: integer;
    registry: TRegistry;
  begin
    ext := ExtractFileExt(AFile);
    if (CompareText( ext, EXEEXTENTION ) = 0 ) or
       (CompareText( ext, COMEXTENTION ) = 0 ) then begin
       CommandLine := AFile + ' ' + AParameter;
    end
    else begin
      { Read command Line from Registry}
      registry := TRegistry.Create;
      try
        registry.RootKey := HKEY_LOCAL_MACHINE;
        if registry.OpenKey('SOFTWARE\CLASSES\'+ ext, false ) then begin
          if registry.GetDataType('') = rdString then begin
            if registry.OpenKey(
            '\SOFTWARE\CLASSES\'+ registry.ReadString('') + '\Shell\'+ AOperation,
             false ) then begin
              if registry.OpenKey('Command', false ) then begin
                commandLine := registry.ReadString('');
                filePosition := Pos(fileKey, commandLine);
                Delete( commandLine, filePosition, length(fileKey) );
                Insert( AFile, commandLine, FilePosition );
                commandLine := commandLine + ' ' + AParameter;
              end
              else begin
                {Not found Command}
              end;
            end
            else begin
              {Can not found Operation}
            end;
          end
          else begin
            {Illegal Type Value}
          end;
        end
        else begin
          {Key Not Found }
        end;
      finally
        registry.Free;
      end;
    end;
    {Create Process}
    GetStartupInfo( startupInfo );
    startupInfo.wShowWindow := AShowCmd;
    if CreateProcess(
      NIL, {ApplicationName}
      PChar( commandLine ), { lpCommandLine }
      NIL,{lpProcessAttributes}
      NIL,{lpThreadAttribute}
      FALSE,{bInheritedHandles}
      NORMAL_PRIORITY_CLASS,{dwCreationFlags}
      NIL,{lpEnvironment}
      PChar( currentDir ),{lpCurrentDirectory}
      startupInfo,{lpStartupInfo}
      processInfomation{lpProcessInfomation}
      ) then begin
     {Success}
       Result := processInfomation.hProcess;
    end
    else begin
      Result := 0;
    end;
  end;
{$ENDIF}

  function ShellExecWin : THandle;
  begin
     operation := StrAlloc( length( AOperation ) + 1 );
     StrPCopy( operation, AOperation );
     filename := StrAlloc( length( AFile ) + 1 );
     StrPCopy( filename, AFile );
     param := StrAlloc( length( AParameter ) + 1 );
     StrPCopy( param, AParameter );
     directory := StrAlloc( length( currentDir ) + 1 );
     StrPCopy( directory, currentDir );
     try
       Result := ShellExecute(
         AHWND,
         operation,
         filename,
         param,
         directory,
         AShowCmd );
     finally
       StrDispose( operation );
       StrDispose( filename );
       StrDispose( param );
       StrDispose( directory );
     end;
  end;

begin
  currentDir := ADirectory;
  if CompareText( currentDir, '' ) = 0 then begin
{$IFDEF Win32}
    currentDirBuff := StrAlloc( PATHBUFFERSIZE );
    try
      if GetCurrentDirectory( PATHBUFFERSIZE, currentDirBuff ) > 0 then begin
        currentDir := StrPas( currentDirBuff );
      end;
    finally
      StrDispose( currentDirBuff );
    end;
{$ELSE}
    System.GetDir( 0, currentDir );
{$ENDIF}
  end;
{$IFDEF WIN32}
  versionInfo.dwOSVersionInfoSize := sizeof( TOSVersionInfo );
  if GetVersionEx(
    versionInfo ) then begin
    if versionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then begin
      {Windows 95}
      Result := ShellExec95;
    end
    else if versionInfo.dwPlatformId = VER_PLATFORM_WIN32s then begin
      {Windows 3.1 with Win32s}
      Result := ShellExecWin;
    end
    else if versionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin
      {Windows NT}
      Result := ShellExecNT;
    end
    else begin
      {UnKnown}
      Result := 0;
    end;
  end
  else begin
    Result := 0;
  end;
{$ELSE}
  Result := ShellExecWIn;
{$ENDIF}
end;


end.