unit uAppPath;

{
  see: [ap-list:0151]
  ( thank you, tk! :)
}

interface

function GetAppPath(prog: string): string;
procedure SetAppPath(prog, path: string);
procedure DelAppPath(prog: string);

implementation

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  Registry,
  SysUtils;

function GetRegValue(const Root: HKEY; const Key, ID: string): string;
begin
  Result := '';
  with TRegistry.Create do
  try
    RootKey := Root;
    if OpenKey(Key , false) then
    try
      Result := ReadString(ID);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

procedure SetRegValue(const Root: HKEY; const Key, ID, Value: string);
begin
  with TRegistry.Create do
  try
    RootKey := Root;
    if OpenKey(Key , true) then
    try
      WriteString(ID, Value);
    finally
      CloseKey;
    end;
  finally
    Free;
  end;
end;

procedure DelRegKey(const Root: HKEY; const Key: string);
begin
  with TRegistry.Create do
  try
    RootKey := Root;
    DeleteKey(Key);
  finally
    Free;
  end;
end;

const REG_APP_KEY : string =
  'Software\Microsoft\Windows\CurrentVersion\App Paths\';

procedure SetAppPath(prog, path: string);
var
  prog_path: string;
begin
  if path = '' then path := prog;
  if not DirectoryExists(path) then
    Exit;
    { ここで例外をあげると，Phi が落ちてしまう }
//  raise Exception.Create('SetAppPath: not exist ['+ path +']');

  prog := ExtractFileName(prog);
  if ExtractFileExt(prog) = '' then prog := prog + '.exe';
  prog_path := path +'\'+ prog;
  if not FileExists(prog_path) then
    Exit;
  SetRegValue(HKEY_LOCAL_MACHINE, REG_APP_KEY + prog, '',prog_path);
  SetRegValue(HKEY_LOCAL_MACHINE, REG_APP_KEY + prog, 'Path', path);
end;

function GetAppPath(prog: string): string;
begin
  prog := ExtractFileName(prog);
  if ExtractFileExt(prog) = '' then prog := prog + '.exe';
  result := GetRegValue( HKEY_LOCAL_MACHINE,
    REG_APP_KEY + prog, '' );
end;

procedure DelAppPath(prog: string);
begin
  DelRegKey(HKEY_LOCAL_MACHINE, REG_APP_KEY + prog);
end;

end.
