////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Routines to handle file associations.                                      //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20230822 - Modified for FPC (A.K.) from _task.                             //
////////////////////////////////////////////////////////////////////////////////

unit _crw_assoc; // File associations.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 5023 off : Unit "$1" not used in $2}
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 {$IFDEF WINDOWS} registry, jwawindows, comobj, variants, {$ENDIF}
 sysutils, classes, process, lcltype,
 _crw_alloc, _crw_environ, _crw_proc, _crw_str, _crw_fio, _crw_wmctrl;

{$IFDEF WINDOWS}
 //////////////////////////////////////////////////
 // Handle file associations
 //////////////////////////////////////////////////
function  GetSystemAssoc(const Ext:LongString):LongString;
function  GetSystemFType(const FType:LongString):LongString;
function  GetSystemAssocExe(const Ext:LongString):LongString;
function  GetSystemFTypeExe(const FType:LongString):LongString;
function  HasSystemAssocExe(const Ext:LongString):Boolean;
function  HasSystemFTypeExe(const FType:LongString):Boolean;

function GetExeByExtension(const Extension:LongString):LongString;

 ///////////////////////////////////////////////////////////////////////////////////
 // Get registered application path by application short exe name (like firefox.exe)
 // Read path from HKCU or HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths.
 // Run test: REG QUERY "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths"
 // See https://docs.microsoft.com/en-us/windows/win32/shell/app-registration
 ///////////////////////////////////////////////////////////////////////////////////
function GetRegAppPath(const app:LongString):LongString;

 ///////////////////////////////////////////////////////////////////////////////////
 // Get application path by short name (like firefox) or EXE name (like firefox.exe)
 // or full file name (like %windir%\notepad.exe) or file extension type association
 // (like .html) or file type identifier (like htmlfile); many specifications may be
 // user in list of arguments (args); also options supported: (-f,-e,-b,-r,-a,-t,-c)
 // to specify type of next argument; see GetAppPath.vbs utility to get more details
 ///////////////////////////////////////////////////////////////////////////////////
function GetAppPath(args:LongString; AllowRun:Boolean=false; AllowWait:Boolean=false;
                    pExitCode:PInteger=nil; StdOut:TEchoProcedure=nil; StdErr:TEchoProcedure=nil;
                    EnvPath:LongString=''; EnvPathExt:LongString=''):LongString;

 // See https://docs.microsoft.com/en-us/windows/win32/api/shlwapi/nf-shlwapi-assocquerystringa
 //////////////////////////////////////////////////////////////////////////////////////////////
function AssocQueryStringA(Flags: Integer; Str: Integer; pszAssoc, pszExtra, pszOut: PChar;
  var pcchOut: DWORD): HRESULT; stdcall; external 'shlwapi.dll' name 'AssocQueryStringA';
function AssocQueryStringW(Flags: Integer; Str: Integer; pszAssoc, pszExtra, pszOut: PWChar;
  var pcchOut: DWORD): HRESULT; stdcall; external 'shlwapi.dll' name 'AssocQueryStringA';

const
 ASSOCSTR_COMMAND                 = 1;
 ASSOCSTR_EXECUTABLE              = 2;
 ASSOCSTR_FRIENDLYDOCNAME         = 3;
 ASSOCSTR_FRIENDLYAPPNAME         = 4;
 ASSOCSTR_NOOPEN                  = 5;
 ASSOCSTR_SHELLNEWVALUE           = 6;
 ASSOCSTR_DDECOMMAND              = 7;
 ASSOCSTR_DDEIFEXEC               = 8;
 ASSOCSTR_DDEAPPLICATION          = 9;
 ASSOCSTR_DDETOPIC                = 10;
 ASSOCSTR_INFOTIP                 = 11;
 ASSOCSTR_QUICKTIP                = 12;
 ASSOCSTR_TILEINFO                = 13;
 ASSOCSTR_CONTENTTYPE             = 14;
 ASSOCSTR_DEFAULTICON             = 15;
 ASSOCSTR_SHELLEXTENSION          = 16;
 ASSOCSTR_DROPTARGET              = 17;
 ASSOCSTR_DELEGATEEXECUTE         = 18;
 ASSOCSTR_SUPPORTED_URI_PROTOCOLS = 19;
 ASSOCSTR_PROGID                  = 20;
 ASSOCSTR_APPID                   = 21;
 ASSOCSTR_APPPUBLISHER            = 22;
 ASSOCSTR_APPICONREFERENCE        = 23;
const
 ASSOCF_NONE                  = $00000000;
 ASSOCF_INIT_NOREMAPCLSID     = $00000001;
 ASSOCF_INIT_BYEXENAME        = $00000002;
 ASSOCF_OPEN_BYEXENAME        = $00000002;
 ASSOCF_INIT_DEFAULTTOSTAR    = $00000004;
 ASSOCF_INIT_DEFAULTTOFOLDER  = $00000008;
 ASSOCF_NOUSERSETTINGS        = $00000010;
 ASSOCF_NOTRUNCATE            = $00000020;
 ASSOCF_VERIFY                = $00000040;
 ASSOCF_REMAPRUNDLL           = $00000080;
 ASSOCF_NOFIXUPS              = $00000100;
 ASSOCF_IGNOREBASECLASS       = $00000200;
 ASSOCF_INIT_IGNOREUNKNOWN    = $00000400;
 ASSOCF_INIT_FIXED_PROGID     = $00000800;
 ASSOCF_IS_PROTOCOL           = $00001000;
 ASSOCF_INIT_FOR_FILE         = $00002000;

 /////////////////////////////////////////////////
 // Get executable file name by document file name
 /////////////////////////////////////////////////
function GetExeByFile(const FileName:LongString):LongString;

 ///////////////////////////////////////////
 // Execute file via ShellExecute('open',..)
 ///////////////////////////////////////////
function ShellExecuteOpen(const FileName:ShortString; const Cmd:ShortString=''):Boolean;

 ////////////////////////////////////////////////////
 //  Run application via WScript.Shell.Run COM object
 ////////////////////////////////////////////////////
function WScriptShellRun(const CmdLine:LongString; Show:Integer=SW_SHOWNORMAL; Wait:Boolean=false):Integer;
{$ENDIF ~WINDOWS}

implementation

{$IFDEF WINDOWS}
type EGetAppPathAbort = class(ESoftException);

function GetAppPath(args:LongString; AllowRun:Boolean=false; AllowWait:Boolean=false;
                    pExitCode:PInteger=nil; StdOut:TEchoProcedure=nil; StdErr:TEchoProcedure=nil;
                    EnvPath:LongString=''; EnvPathExt:LongString=''):LongString;
 const DefFilter='febrat'; MaxIters=100; NameOfProg='GetAppPath';
 var argnum,optShow,i,argc:Integer; optRun,optWait,optTest,isopt:Boolean;
 var optFilter,AppPath,Params,arg,opt,cmdline,argv:LongString;
 function Trim(const s:LongString):LongString;
 begin
  Result:=SysUtils.Trim(s);
 end;
 function TrimLeft(const s:LongString):LongString;
 begin
  Result:=SysUtils.TrimLeft(s);
 end;
 function IsEmptyStr(const s:LongString):Boolean;
 begin
  Result:=not(trim(s)<>'');
 end;
 function ShellRun(const cmdline:LongString; show:Integer; wait:Boolean):Integer;
 begin
  Result:=WScriptShellRun(cmdline,show,wait);
 end;
 procedure PrintLn(const msg:LongString);
 begin
  if Assigned(StdOut) then StdOut(msg+LineEnding);
 end;
 procedure ErrorLn(const msg:LongString);
 begin
  if Assigned(StdErr) then StdErr(msg+LineEnding);
 end;
 procedure SetExitCode(code:Integer);
 begin
  if (pExitCode<>nil) then pExitCode^:=code;
 end;
 procedure Abort(code:Integer; msg:LongString);
 begin
  ErrorLn(msg);
  SetExitCode(code);
  raise EGetAppPathAbort.Create(Msg);
 end;
 function ucase(const s:LongString):LongString;
 begin
  Result:=UpperCase(s);
 end;
 procedure PrintVersion(const name:LongString);
 begin
  if not Assigned(StdOut) then Exit;
  PrintLn(ucase(name)+' version 1.0');
 end;
 procedure PrintHelp(name:LongString);
 begin
  if not Assigned(StdOut) then Exit;
  PrintVersion(name);
  PrintLn('Find registered application, print path or run it.');
  PrintLn('Copyright (c) 2021 Alexey Kuryakin kouriakine@mail.ru');
  PrintLn('Under MIT License, see https://opensource.org/licenses/MIT');
  PrintLn('Help on '+ucase(name)+':');
  PrintLn(' =================> Syntax:');
  PrintLn('  '+ucase(name)+' [Options] [Arguments] [--run] [Options] [Params]');
  PrintLn(' =================> Options:');
  PrintLn('   --            => options ended, next is params');
  PrintLn('   --version     => print program version and exit');
  PrintLn('   -h,--help     => print this help screen and exit');
  PrintLn('   -f,--full     => next argument expect to be full path\name.ext');
  PrintLn('   -e,--exe      => next is short file name.exe to search in PATH');
  PrintLn('   -b,--base     => next is base name to search with PATH/PATHEXT');
  PrintLn('   -r,--reg      => next is name.exe to search registry App Paths');
  PrintLn('   -a,--assoc    => next argument expect to be association (.ext)');
  PrintLn('   -t,--ftype    => next argument expect to be filetype specifier');
  PrintLn('   -c,--cmd      => set --filter feb (full+exe+base) for commands');
  PrintLn('   --filter f    => set filter f (check types)  for next argument');
  PrintLn('   -        f    => by default f=febrat & filter reset to default');
  PrintLn('   -             => after following argument processed by filter.');
  PrintLn('   -             => for example --filter feb equals to -c option.');
  PrintLn('   --run,--start => run (start) application with following Params');
  PrintLn('   --wait        => with --run option wait application until ends');
  PrintLn('   --test        => with --run option don`t run but print cmdline');
  PrintLn('   --show n      => with --run option set application show mode n');
  PrintLn('          n = 0  => SW_HIDE to run application with hidden window');
  PrintLn('              1  => SW_SHOWNORMAL  to activate and display window');
  PrintLn('              2  => SW_SHOWMINIMIZED  activate and show minimized');
  PrintLn('              3  => SW_SHOWMAXIMIZED  activate and show maximized');
  PrintLn('              4  => SW_SHOWNOACTIVATE display it but not activate');
  PrintLn('              5  => SW_SHOW activate, display in current position');
  PrintLn('              6  => SW_MINIMIZE minimize, activate another window');
  PrintLn('              7  => SW_SHOWMINNOACTIVE run minimized, keeps focus');
  PrintLn('              8  => SW_SHOWNA show in normal pos, do not activate');
  PrintLn('              9  => SW_RESTORE activate and display normal window');
  PrintLn('              10 => SW_SHOWDEFAULT display it in default position');
  PrintLn(' =================> Arguments:');
  PrintLn('   file.exe      => find application by EXE file  like firefox.exe');
  PrintLn('   file          => find application by base name like firefox');
  PrintLn('   ftype         => find application by file type like htmlfile');
  PrintLn('   .ext          => find application by extension like .html');
  PrintLn('   Params        => parameters to pass for application on --run');
  PrintLn(' =================> Exit Code:');
  PrintLn('   0             => specified application found');
  PrintLn('   1             => specified application is not found ');
  PrintLn('   2             => some error found (bad arguments/options)');
  PrintLn('   else          => some error found (internal script error)');
  PrintLn('   with --run --wait options return application`s exit code.');
  PrintLn(' =================> Note:');
  PrintLn('   Search application full path\name.ext registered in system');
  PrintLn('   and specified by argument EXE file name (like firefox.exe)');
  PrintLn('   or file type (like htmlfile) or file extension (like .htm)');
  PrintLn('   The list of argument(s) can be passed to find application.');
  PrintLn('   If any specified applications found, return first of them.');
  PrintLn('   By default just print found applicaton full path\name.ext.');
  PrintLn('   Option --run or --start  will run application with Params.');
  PrintLn('   Option --show uses to specify application showwindow mode.');
  PrintLn('   Option --wait uses to run application and wait until ends.');
  PrintLn('   Option --test uses to print a cmd line to run application.');
  PrintLn('   By default try to detect argument by type (febrat), where:');
  PrintLn('   f = full path\name.ext (like c:\windows\system32\cmd.exe);');
  PrintLn('   e = exe  file name.ext to search with PATH (like cmd.exe);');
  PrintLn('   b = base file name to search with PATH/PATHEXT (like cmd);');
  PrintLn('   r = reg  name.ext in registry App Paths (like chrome.exe);');
  PrintLn('   a = assoc is file extension name association (like .html);');
  PrintLn('   t = ftype is registry file type specifier (like htmlfile);');
  PrintLn('   c = cmd is feb (full+exe+base) for command (like cmd.exe).');
  PrintLn('   By default all argument types checking but you can specify');
  PrintLn('   following argument type by options (-f,-e,-b,-r,-a,-t,-c).');
  PrintLn('   You can specify types by --filter option (default=febrat).');
  PrintLn(' =================> Examples:');
  PrintLn('  call '+name+' --help');
  PrintLn('  call '+name+' --version');
  PrintLn('  echo FIND APPLICATION AND PRINT HIS PATH:');
  PrintLn('  call '+name+' -e akelpad.exe -r notepad++.exe -t txtfile -a .txt');
  PrintLn('  call '+name+' firefox.exe chrome.exe opera.exe iexplore.exe .html');
  PrintLn('  call '+name+' -t htmlfile .html .htm -t shtmlfile .shtml -t urlfile .url');
  PrintLn('  echo FIND APPLICATION AND RUN (START) WITH PARAMETERS:');
  PrintLn('  call '+name+' .txt --run --test c:\Crw32exe\Crw32.ini');
  PrintLn('  call '+name+' -t textfile --run --test c:\Crw32exe\Crw32.ini');
  PrintLn('  call '+name+' -c %ComSpec% -c cmd -c cmd.exe --run /k echo Run CMD is OK');
  PrintLn('  call '+name+' notepad.exe .txt --run --wait --show 3 c:\Crw32exe\Crw32.ini');
  PrintLn('  call '+name+' firefox.exe .html --start c:\Crw32exe\Resource\Manual\crw-daq.htm');
  PrintLn('  call '+name+' SumatraPDF.exe -t SumatraPDF AcroRd32.exe Acrobat.exe -t acrobat .pdf --run');
 end;
 function BuildPath(const dir,name:LongString):LongString;
 begin
  Result:=IncludeTrailingBackslash(Trim(dir))+Trim(name);
 end;
 function GetAbsolutePathName(const path:LongString):LongString;
 begin
  Result:=Trim(ExpandFileName(path));
 end;
 function GetParentFolderName(const path:LongString):LongString;
 begin
  Result:=Trim(SysUtils.ExtractFilePath(path));
 end;
 function GetExtensionName(path:LongString):LongString;
 begin
  Result:=Trim(SysUtils.ExtractFileExt(path));
  if (StrFetch(Result,1)='.') then System.Delete(Result,1,1);
 end;
 function HasExtensionName(const path:LongString):Boolean;
 begin
  Result:=not IsEmptyStr(path) and not IsEmptyStr(GetExtensionName(path));
 end;
 function IsExtension(const path:LongString):Boolean; //*** is arg looks like extension i.e. ".html"?
 begin
  Result:=not IsEmptyStr(arg) and HasExtensionName(arg) and (SameText(arg,'.'+GetExtensionName(arg)));
 end;
 function HasParentFolderName(const path:LongString):Boolean;
 begin
  Result:=not IsEmptyStr(path) and not IsEmptyStr(GetParentFolderName(path));
 end;
 function SearchFile(name,dirlist,extlist:LongString; sep:Char):LongString;
 var idir,iext:Integer; dirs,exts:TStringList; dir,ext,fqn:LongString;
 begin
  Result:=''; dirs:=nil; exts:=nil;
  try
   name:=Trim(name);
   if (name<>'') and (sep<>#0) then begin
    dirs:=TStringList.Create; dirs.Text:=StringReplace(sep+dirlist,sep,LineEnding,[rfReplaceAll]);
    exts:=TStringList.Create; exts.Text:=StringReplace(sep+extlist,sep,LineEnding,[rfReplaceAll]);
    for iext:=0 to exts.Count-1 do begin
     ext:=Trim(exts[iext]); ext:=GetExtensionName(ext);
     for idir:=0 to dirs.Count-1 do begin
      dir:=Trim(dirs[idir]); dir:=GetAbsolutePathName(dir);
      fqn:=BuildPath(dir,name); if (ext<>'') then fqn:=fqn+'.'+ext;
      if (fqn<>'') and FileExists(fqn) then Result:=GetRealFilePathName(Trim(fqn));
      if (Result<>'') then break;
     end;
     if (Result<>'') then break;
    end;
   end;
  finally
   FreeAndNil(dirs);
   FreeAndNil(exts);
  end;
 end;
 function GetEnvPATH:LongString;
 const fallbackPATH='%SystemRoot%;%SystemRoot%\System32';
 begin
  if IsEmptyStr(EnvPath) then Result:=Trim(GetEnv('PATH')) else Result:=Trim(EnvPath);
  if IsEmptyStr(Result) then Result:=ExpEnv(fallbackPATH);
 end;
 function GetEnvPATHEXT:LongString;
 const fallbackPATHEXT='.COM;.EXE;.BAT;.CMD';
 begin
  if IsEmptyStr(EnvPathExt) then Result:=Trim(GetEnv('PATHEXT')) else Result:=Trim(EnvPathExt);
  if IsEmptyStr(Result) then Result:=fallbackPATHEXT;
 end;
 function IsTypeExe(const arg:LongString):Boolean; //*** is arg looks like executable? i.e. "name.exe" or "name.cmd", see PATHEXT
begin
  Result:=HasListedExtension(arg,GetEnvPATHEXT);
 end;
 function IsCmdName(const arg:LongString):Boolean;   //*** is arg looks like command (just a simple word) i.e. "name"?
 begin
  Result:=not IsEmptyStr(arg) and not HasParentFolderName(arg) and not HasExtensionName(arg);
 end;
 function IsFullExe(const arg:LongString):Boolean;   //*** is arg looks like full EXE name i.e. "path\name.exe"?
 begin
  Result:=not IsEmptyStr(arg) and HasParentFolderName(arg) and IsTypeExe(arg);
 end;
 function IsExeName(const arg:LongString):Boolean;   //*** is arg looks like short EXE name i.e. "name.exe"?
 begin
  Result:=not IsEmptyStr(arg) and not HasParentFolderName(arg) and IsTypeExe(arg);
 end;
 function IsItAssoc(const arg:LongString):Boolean;   //*** is arg looks like association by extension i.e. ".html"?
 begin
  Result:=not IsEmptyStr(arg) and not HasParentFolderName(arg) and IsExtension(arg);
 end;
 function IsItFType(const arg:LongString):Boolean;   //*** is arg looks like file type i.e. "htmlfile" or "TIFImage.Document"?
 begin
  Result:=not IsEmptyStr(arg) and not HasParentFolderName(arg) and not IsItAssoc(arg) and not IsExeName(arg);
 end;
 procedure SetOptRun(opt:Boolean);
 begin
  optRun:=opt;
  if optRun then begin
   optWait:=false;
   optTest:=false;
   optShow:=SW_SHOWNORMAL;
  end;
 end;
 procedure SetOptWait(opt:Boolean);
 begin
  if AllowWait then optWait:=opt;
 end;
 procedure SetOptTest(opt:Boolean);
 begin
  optTest:=opt;
 end;
 procedure SetOptShow(opt:Integer);
 begin
  if (opt in [SW_HIDE..SW_MAX]) then optShow:=opt else Abort(2,'Error: invalid option --show '+d2s(opt)+'. Valid option is --show n, where n=0..10.');
 end;
 procedure SetOptFilter(const opt:LongString);
 begin
  optFilter:=LowerCase(opt);
 end;
 procedure AddParams(const arg:LongString);
 begin
  if optRun and not IsEmptyStr(arg) then Params:=Params+' '+AnsiQuotedIfNeed(arg);
 end;
 procedure HandleArgs(arg:LongString);
 begin
  argnum:=argnum+1;
  arg:=Trim(ExpEnv(arg));
  if not optRun then begin
   if (arg<>'') then begin
    if IsEmptyStr(AppPath) and (Pos('f',optFilter)>0) and IsFullExe(arg) then begin
     AppPath:=Trim(arg);
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
    if IsEmptyStr(AppPath) and (Pos('e',optFilter)>0) and IsExeName(arg) then begin
     AppPath:=SearchFile(arg,GetEnvPATH,'',';');
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
    if IsEmptyStr(AppPath) and (Pos('b',optFilter)>0) and IsCmdName(arg) then begin
     AppPath:=SearchFile(arg,GetEnvPATH,GetEnvPATHEXT,';');
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
    if IsEmptyStr(AppPath) and (Pos('r',optFilter)>0) and IsExeName(arg) then begin
     AppPath:=ExpEnv(GetRegAppPath(arg));
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
    if IsEmptyStr(AppPath) and (Pos('a',optFilter)>0) and IsItAssoc(arg) then begin
     AppPath:=ExpEnv(GetSystemAssocExe(arg));
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
    if IsEmptyStr(AppPath) and (Pos('t',optFilter)>0) and IsItFType(arg) then begin
     AppPath:=ExpEnv(GetSystemFTypeExe(arg));
     if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
    end;
   end;
   optFilter:=DefFilter;
  end;
  if optRun and (arg<>'') then begin
   AddParams(arg);
  end;
 end;
begin
 Result:='';
 try
  SetExitCode(0); cmdline:=''; argc:=0; argv:=args;
  argnum:=0; AppPath:=''; Params:=''; SetOptFilter(DefFilter);
  optRun:=false; optWait:=false; optTest:=false; optShow:=SW_SHOWNORMAL;
  arg:=''; opt:=''; isopt:=true;
  for i:=0 to MaxIters-1 do begin
   arg:=ExtractFirstParam(argv); argv:=SkipFirstParam(argv);
   if (StrFetch(arg,1)='-') and isopt and (opt='') then begin
    if SameText(arg,'--')                               then begin isopt:=false;                     end else
    if SameText(arg,'--version')                        then begin PrintVersion(NameOfProg);   Exit; end else
    if SameText(arg,'-h') or SameText(arg,'--help')     then begin PrintHelp(NameOfProg);      Exit; end else
    if SameText(arg,'--run') or SameText(arg,'--start') then begin SetOptRun(true);                  end else
    if SameText(arg,'--wait')                           then begin SetOptWait(true);                 end else
    if SameText(arg,'--test')                           then begin SetOptTest(true);                 end else
    if SameText(arg,'-f') or SameText(arg,'--full')     then begin SetOptFilter('f');                end else
    if SameText(arg,'-e') or SameText(arg,'--exe')      then begin SetOptFilter('e');                end else
    if SameText(arg,'-b') or SameText(arg,'--base')     then begin SetOptFilter('b');                end else
    if SameText(arg,'-r') or SameText(arg,'--reg')      then begin SetOptFilter('r');                end else
    if SameText(arg,'-a') or SameText(arg,'--assoc')    then begin SetOptFilter('a');                end else
    if SameText(arg,'-t') or SameText(arg,'--ftype')    then begin SetOptFilter('t')                 end else
    if SameText(arg,'-c') or SameText(arg,'--cmd')      then begin SetOptFilter('feb');              end else
    if SameText(arg,'--filter')                         then begin opt:=arg;                         end else
    if SameText(arg,'--show')                           then begin opt:=arg;                         end else
    Abort(2,'Error: unknown option '+arg+'. See --help.');
   end else begin
    if SameText(opt,'')                                 then begin HandleArgs(arg);                  end else
    if SameText(opt,'--show')                           then begin SetOptShow(StrToIntDef(arg,-1));  end else
    if SameText(opt,'--filter')                         then begin SetOptFilter(arg);                end else
    Abort(2,'Error: unknown option '+opt+'. See --help.');
    opt:='';
   end;
   if (arg<>'') then inc(argc);
   if IsEmptyStr(argv) then break;
  end;
  if IsEmptyStr(args) or (argc=0) then begin
   PrintHelp(NameOfProg);
   Exit;
  end;
  if not IsEmptyStr(AppPath) and not FileExists(AppPath) then AppPath:='';
  if IsEmptyStr(AppPath) then Abort(1,'Error: specified application is not found.');
  if optRun then begin
   cmdline:=AnsiQuotedIfNeed(AppPath)+Params; PrintLn(cmdline); Result:=cmdline;
   if AllowRun and not optTest then begin
    SetExitCode(ShellRun(cmdline,optShow,optWait and AllowWait));
   end;
  end else begin
   PrintLn(AppPath); Result:=AppPath;
  end;
 except
  on E:EGetAppPathAbort do Exit;
  on E:Exception do BugReport(E,nil,NameOfProg);
 end;
end;

function GetRegAppPath(const app:LongString):LongString;
const keyAppPaths='SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\';
begin
 Result:='';
 if not IsEmptyStr(app) then begin
  if (Result='') then Result:=ReadRegistryString(HKEY_CURRENT_USER,keyAppPaths+app,'');
  if (Result='') then Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,keyAppPaths+app,'');
 end;
end;

function GetSystemAssoc(const Ext:LongString):LongString;
begin
 Result:='';
 if (Length(Ext)>1) and (Pos('.',Ext)=1) then begin
  if (Result='') then Result:=ReadRegistryString(HKEY_CLASSES_ROOT,Ext,'');
  if (Result='') then Result:=ReadRegistryString(HKEY_CURRENT_USER,'SOFTWARE\Classes\'+Ext,'');
  if (Result='') then Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,'SOFTWARE\Classes\'+Ext,'');
 end;
 Result:=SysUtils.Trim(Result);
end;

function GetSystemFType(const FType:LongString):LongString;
begin
 Result:='';
 if (Length(FType)>0) then begin
  if (Result='') then Result:=ReadRegistryString(HKEY_CLASSES_ROOT,AddBackSlash(FType)+'Shell\Open\Command','');
  if (Result='') then Result:=ReadRegistryString(HKEY_CURRENT_USER,'SOFTWARE\Classes\'+AddBackSlash(FType)+'Shell\Open\Command','');
  if (Result='') then Result:=ReadRegistryString(HKEY_LOCAL_MACHINE,'SOFTWARE\Classes\'+AddBackSlash(FType)+'Shell\Open\Command','');
 end;
 Result:=SysUtils.Trim(Result);
end;

function GetSystemFTypeExe(const FType:LongString):LongString;
begin
 Result:=SysUtils.Trim(GetSystemFType(FType)); if (Result='') then Exit;
 Result:=ExtractFirstParam(Result);
 Result:=SysUtils.Trim(Result);
end;

function GetSystemAssocExe(const Ext:LongString):LongString;
begin
 Result:=GetSystemFTypeExe(GetSystemAssoc(Ext));
end;

function HasSystemAssocExe(const Ext:LongString):Boolean;
var S:LongString;
begin
 Result:=false;
 S:=GetSystemAssocExe(Ext);
 if (S<>'') and FileExists(S) then Result:=true;
end;

function HasSystemFTypeExe(const FType:LongString):Boolean;
var S:LongString;
begin
 Result:=false;
 S:=GetSystemFTypeExe(FType);
 if (S<>'') and FileExists(S) then Result:=true;
end;

function GetExeByExtension(const Extension:LongString):LongString;
var BufSize:DWORD;
begin
 Result:=''; if (Extension='') then Exit;
 BufSize:=MAX_PATH; SetLength(Result,BufSize);
 if AssocQueryStringA(ASSOCF_OPEN_BYEXENAME,ASSOCSTR_EXECUTABLE,PChar(Extension),nil,PChar(Result),BufSize)=S_OK
 then SetLength(Result,BufSize-1) else Result := '';
 if (Result='') then Result:=GetSystemAssocExe(Extension);
end;

function GetExeByFile(const FileName:LongString):LongString;
var
 lpFile      : packed array[0..MAX_PATH] of Char;
 lpDirectory : packed array[0..MAX_PATH] of Char;
 lpResult    : packed array[0..MAX_PATH] of Char;
begin
 Result:='';
 try
  StrPCopy(lpFile,SysUtils.Trim(FileName));
  StrPCopy(lpDirectory,ExtractFilePath(SysUtils.Trim(FileName)));
  StrPCopy(lpResult,'');
  if FindExecutable(lpFile,lpDirectory,lpResult)>32 then Result:=StrPas(lpResult);
  if (Result='') and HasExtension(FileName) then Result:=GetSystemAssocExe(ExtractFileExt(FileName));
 except
  on E:Exception do BugReport(E,nil,'GetExeByFile');
 end;
end;

function ShellExecuteOpen(const FileName:ShortString; const Cmd:ShortString=''):Boolean;
var
 lpExe : packed array[0..MAX_PATH] of Char;
 lpCmd : packed array[0..MAX_PATH] of Char;
 lpDir : packed array[0..MAX_PATH] of Char;
begin
 Result:=false;
 try
  StrPCopy(lpExe,GetExeByFile(FileName));
  if IsEmptyStr(Cmd)
  then StrPCopy(lpCmd,SysUtils.Trim(FileName))
  else StrPCopy(lpCmd,SysUtils.Trim(Cmd));
  StrPCopy(lpDir,AddBackSlash(ExtractFilePath(FileName)));
  Result:=ShellExecute(0,'open',lpExe,lpCmd,lpDir,SW_SHOWNORMAL)>32;
 except
  on E:Exception do BugReport(E,nil,'ShellExecuteOpen');
 end;
end;

function WScriptShellRun(const CmdLine:LongString; Show:Integer=SW_SHOWNORMAL; Wait:Boolean=false):Integer;
var Shell:Variant;
begin
 Result:=-1;
 if not IsEmptyStr(CmdLine) then
 try
  Shell:=Unassigned;
  try
   Shell:=CreateOleObject('WScript.Shell');
   if VarIsNull(Shell) or VarIsEmpty(Shell) then Exit;
   Result:=Shell.Run(CmdLine,Show,Wait);
  finally
   Shell:=Unassigned;
  end;
 except
  on E:EOleException do begin BugReport(E,nil,FormatHarmlessBug(EEchoException,'WScriptShellRun')); Exit; end;
  on E:Exception do BugReport(E,nil,'ShellRun');
 end;
end;
{$ENDIF ~WINDOWS}

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_assoc;
begin
end;

procedure Free_crw_assoc;
begin
end;

initialization

 Init_crw_assoc;

finalization

 Free_crw_assoc;

end.

//////////////
// END OF FILE
//////////////

