unit uOsStuff;

// this code is under the BAF fair use license (BFUL) - https://bafbal.de/index.php?title=Bful
// OS specific stuff

interface

uses SysUtils, Winapi.ShellAPI, Winapi.ActiveX, Winapi.ShlObj, FMX.Platform,
     System.Rtti, Winapi.Windows;

type
  TExecuteWaitEvent = procedure(const ProcessInfo: TProcessInformation;
      var ATerminate: Boolean) of object;

  TBafClipboard = class
  private
    FClip: IFMXClipboardService;
    FHasClip: boolean;
    function GetAsText: string;
    procedure SetAsText(const Value: string);


  public
    constructor Create;
    destructor Destroy; override;
    property AsText: string read GetAsText write SetAsText;

  end;

  procedure BafOpenFile(AFileName: string);
  procedure BafOpenFileParam(AFileName, AParam: string);
  function BafGetDir(AName: string): string;
  function BafGetSpecialFolder(aFolder: Integer): string;

  procedure ExecuteFile(const AFilename: string;
    AParameter, ACurrentDir: string; AWait: Boolean;
    AOnWaitProc: TExecuteWaitEvent = nil);

var
  Clipboard: TBafClipboard;




implementation

uses uBafTypes;

procedure BafOpenFileParam(AFileName, AParam: string);
begin
  ShellExecute(0, 'open', PWideChar(AFileName), PWideChar(AParam), '', SW_SHOW);
end;

procedure BafOpenFile(AFileName: string);
begin
  ShellExecute(0, 'open', PWideChar(AFileName), '', '', SW_SHOW);
end;

procedure ExecuteFile(const AFilename: string;
    AParameter, ACurrentDir: string; AWait: Boolean;
    AOnWaitProc: TExecuteWaitEvent = nil);
var
  si: TStartupInfo;
  pi: TProcessInformation;
  bTerminate: Boolean;
begin
  bTerminate := False;

  if Length(ACurrentDir) = 0 then
    ACurrentDir := ExtractFilePath(AFilename);

  if AnsiLastChar(ACurrentDir) = '' then
    Delete(ACurrentDir, Length(ACurrentDir), 1);

  FillChar(si, SizeOf(si), 0);
  with si do begin
    cb := SizeOf(si);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := SW_NORMAL;
  end;

  FillChar(pi, SizeOf(pi), 0);
  AParameter := Format('"%s" %s', [AFilename, TrimRight(AParameter)]);

  if CreateProcess(Nil, PChar(AParameter), Nil, Nil, False,
                   CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or
                   NORMAL_PRIORITY_CLASS, Nil, PChar(ACurrentDir), si, pi) then
  try
    if AWait then
      while WaitForSingleObject(pi.hProcess, 50) <> Wait_Object_0 do
      begin
        if Assigned(AOnWaitProc) then
        begin
          AOnWaitProc(pi, bTerminate);
          if bTerminate then
            TerminateProcess(pi.hProcess, Cardinal(-1));
        end;

//        Application.ProcessMessages;
      end;
  finally
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);
  end;
end; // procedure ExecuteFile

function BafGetDir(AName: string): string;
begin
  AName := AnsiLowerCase(AName);
  if (AName = 'doc') or (AName = 'docdir') then
    result := BafGetSpecialFolder(CSIDL_MYDOCUMENTS)
  else if (AName = 'desktop') then
    result := BafGetSpecialFolder(CSIDL_DESKTOP)
  else if (AName = 'fav') or (AName = 'favorites') then
    result := BafGetSpecialFolder(CSIDL_FAVORITES)
  else if (AName = 'music') then
    result := BafGetSpecialFolder(CSIDL_MYMUSIC)
  else if (AName = 'video') then
    result := BafGetSpecialFolder(CSIDL_MYVIDEO)
  else if (AName = 'fonts') then
    result := BafGetSpecialFolder(CSIDL_FONTS)
  else if (AName = 'appdata') then
    result := BafGetSpecialFolder(CSIDL_APPDATA)
  else if (AName = 'cfav') or (AName = 'cfavorites') then
    result := BafGetSpecialFolder(CSIDL_COMMON_FAVORITES)
  else if (AName = 'cappdata') then
    result := BafGetSpecialFolder(CSIDL_COMMON_APPDATA)
  else if (AName = 'prog') or (AName = 'program') then
    result := BafGetSpecialFolder(CSIDL_PROGRAM_FILES)
  else if (AName = 'pic') or (AName = 'pictures')  then
    result := BafGetSpecialFolder(CSIDL_MYPICTURES)
  else if (AName = 'prog86') or (AName = 'program86') then
    result := BafGetSpecialFolder(CSIDL_PROGRAM_FILESX86)
  else if (AName = 'cdoc') then
    result := BafGetSpecialFolder(CSIDL_COMMON_DOCUMENTS)
  else if (AName = 'cmusic') then
    result := BafGetSpecialFolder(CSIDL_COMMON_MUSIC)
  else if (AName = 'cpic') or (AName = 'cpictures')  then
    result := BafGetSpecialFolder(CSIDL_COMMON_PICTURES)
  else if (AName = 'cvideo') then
    result := BafGetSpecialFolder(CSIDL_COMMON_VIDEO)
  else if (AName = 'downloads') then
    result := GetEnvironmentVariable('USERPROFILE') + '\Downloads'
  else if (AName = 'root') then
    result :=gv_root
  else if (AName = 'userroot') or (AName = 'usrroot') then
    result := gv_userroot


  ;
  result := IncludeTrailingPathDelimiter(result);

end;

function BafGetSpecialFolder(aFolder: Integer): string;
var
  pIdL: PItemIDList;
  Path: array [0..1023] of Char;
  Allocator: IMalloc;
begin
  SHGetSpecialFolderLocation (0, aFolder, pIdL);
  SHGetPathFromIDList (pIDL, Path);
  if Succeeded (SHGetMalloc (Allocator)) then
    Allocator.Free (pIdL);
  result := Path;
end;

{ TBafClipboard }

constructor TBafClipboard.Create;
begin
  FHasClip := TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService);
  if FHasClip then
    FClip := IFMXClipboardService(TPlatformServices.Current.GetPlatformService(IFMXClipboardService));
end;

destructor TBafClipboard.Destroy;
begin
  FClip := nil;
  inherited;
end;

function TBafClipboard.GetAsText: string;
var
  Value: TValue;
begin
  if FHasClip then begin
    Value := FClip.GetClipboard;
    if not Value.TryAsType(result) then
      result := '';
  end;
end;

procedure TBafClipboard.SetAsText(const Value: string);
begin
  if FHasClip then
    FClip.SetClipboard(Value);
end;

initialization

  Clipboard := TBafClipboard.Create;

finalization

  FreeAndNil(Clipboard);

end.
