& pourquoi j’n’écrirais pas ça ?

/// <summary>
///   Unit with cross-platforms methods
/// </summary>
/// <remarks>
///   Currently works on Microsoft and Posix (OSX).
/// </remarks>
unit uWxPlatform;

interface

uses
{$IFDEF MSWINDOWS}
  Winapi.ShellAPI, Winapi.Windows, ShlObj,
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
  Posix.Stdlib,
{$ENDIF POSIX}
{$IFDEF MACOS}
  System.RegularExpressions, MacApi.AppKit, MacApi.Foundation, Macapi.CocoaTypes,
{$ENDIF MACOS}
  System.SysUtils;

{$IFDEF MACOS}
procedure NSBeep; cdecl;  external '/System/Library/Frameworks/AppKit.framework/AppKit' name '_NSBeep';
{$ENDIF MACOS}

type
  TFileVersionInfo = record
    fCompanyName,
    fFileDescription,
    fFileVersion,
    fInternalName,
    fLegalCopyRight,
    fLegalTradeMark,
    fOriginalFileName,
    fProductName,
    fProductVersion,
    fComments         : string;
    fMajor,
    fMinor,
    fRelease,
    fBuild            : Word;
  end;
  /// <summary>
  ///   The class which contains cross-platforms methods.
  /// </summary>
  /// <remarks>
  ///   Procedures and functions are class methods when possible.
  /// </remarks>
  TMisc = class

    /// <summary>
    ///   To open the command.
    /// </summary>
    /// <param name="sCommand">
    ///   Command which is opened in the shell/DOS.
    /// </param>
    /// <remarks>
    ///   <para>
    ///     Example :
    ///   </para>
    ///   <para>
    ///     TMisc.Open('https://www.whiler.com/');<br />It loads the URL in the default browser.
    ///   </para>
    ///   <para>
    ///     TMisc.Open('filename.txt');<br />It opens the file <i>filename.txt</i> with the default text reader.
    ///   </para>
    /// </remarks>
    class procedure Open(sCommand: string);
    class procedure Beep;
    class function  BrowseForFolder(const ATitle: string; var ADir: string): Boolean;
    class procedure GetAppVersionInfo(sAppNamePath: string; var aFileVersionInfo: TFileVersionInfo); static;
    class function  IsCtrlDown: Boolean;
    class function  IsShiftDown: Boolean;
  private
  end;

implementation

var
  lg_StartFolder: String;



{$IFDEF MSWINDOWS}
function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
begin
  if (uMsg = BFFM_INITIALIZED) then
  begin
    SendMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
    Sleep(500);
    PostMessage(Wnd, BFFM_SETSELECTION, 1, Integer(@lg_StartFolder[1]));
  end;
  Result := 0;
end;
{$ENDIF MSWINDOWS}

class procedure TMisc.Open(sCommand: string);
begin
{$IFDEF MSWINDOWS}
  ShellExecute(0, 'OPEN', PChar(sCommand), '', '', SW_SHOWNORMAL);
{$ENDIF MSWINDOWS}
{$IFDEF POSIX}
  _system(PAnsiChar('open ' + AnsiString(sCommand)));
{$ENDIF POSIX}
end;

class procedure TMisc.Beep;
begin
{$IFDEF MSWINDOWS}
  Beep;
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
  NSBeep;
{$ENDIF MACOS}
end;

class function TMisc.BrowseForFolder(const ATitle: string; var ADir: string): Boolean;
{$IFDEF MACOS}
var
  LOpenDir: NSOpenPanel;
  LInitialDir: NSURL;
  LDlgResult: NSInteger;
begin
  Result   := False;
  LOpenDir := TNSOpenPanel.Wrap(TNSOpenPanel.OCClass.openPanel);
  LOpenDir.setAllowsMultipleSelection(False);
  LOpenDir.setCanChooseFiles(False);
  LOpenDir.setCanChooseDirectories(True);
  if (ADir <> '') then
  begin
    LInitialDir := TNSURL.Create;
    LInitialDir.initFileURLWithPath(NSSTR(ADir));
    LOpenDir.setDirectoryURL(LInitialDir);
  end;
  if (ATitle <> '') then
  begin
    LOpenDir.setTitle(NSSTR(ATitle));
  end;
  LOpenDir.retain;
  try
    LDlgResult := LOpenDir.runModal;
    if (LDlgResult = NSOKButton) then
    begin
      ADir   := string(TNSUrl.Wrap(LOpenDir.URLs.objectAtIndex(0)).relativePath.UTF8String);
      Result := True;
    end;
  finally
    LOpenDir.release;
  end;
{$ENDIF MACOS}
{$IFDEF MSWINDOWS}
var
  browse_info : TBrowseInfo;
  folder      : array[0..MAX_PATH] of char;
  find_context: PItemIDList;
begin
  Result := False;
  //--------------------------
  // Initialise the structure.
  //--------------------------
  FillChar(browse_info,SizeOf(browse_info),#0);
  lg_StartFolder             := ADir;
  browse_info.pszDisplayName := @folder[0];
  browse_info.lpszTitle      := PChar(ATitle);
  browse_info.ulFlags        := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
//  browse_info.hwndOwner := appHWND;
  if (ADir <> '') then
  begin
    browse_info.lpfn := BrowseForFolderCallBack;
  end;
  find_context := SHBrowseForFolder(browse_info);
  if Assigned(find_context) then
  begin
    if SHGetPathFromIDList(find_context,folder) then
    begin
      ADir   := folder;
      Result := True;
    end
    else
      ADir := '';
    GlobalFreePtr(find_context);
  end
  else
    ADir := '';
{$ENDIF MSWINDOWS}
end;

class procedure TMisc.GetAppVersionInfo(sAppNamePath: string; var aFileVersionInfo: TFileVersionInfo);
var
{$IFDEF MSWINDOWS}
  iVerSize     : Integer;
  pcVerBuf     : PChar;
  pVerBufValue : Pointer;
  iVerHandle   : Cardinal;
  iVerBufLen   : Cardinal;
  sVerKey      : string;

  function GetInfo(ThisKey: string): string;
  begin
    Result  := '';
    sVerKey := '\StringFileInfo\' + IntToHex(loword(integer(pVerBufValue^)), 4) +
                  IntToHex(hiword(integer(pVerBufValue^)), 4) + '\' + ThisKey;

    if VerQueryValue(pcVerBuf, PChar(sVerKey), pVerBufValue, iVerBufLen) then
      Result := StrPas(PChar(pVerBufValue));

  end;

  function QueryValue(ThisValue: string): string;
  begin
    Result := '';

    if GetFileVersionInfo(PChar(sAppNamePath), iVerHandle, iVerSize, pcVerBuf) and
        VerQueryValue(pcVerBuf, '\VarFileInfo\Translation', pVerBufValue, iVerBufLen) then
      Result := GetInfo(ThisValue);

  end;

  function GetFileVersion(const FileName: string): boolean;
  // Returns True on success and False on failure.
  var
    lwSize, lwLen : LongWord;
    hFile         : Cardinal;
    pcBuffer      : PChar;
    pInfo         : ^VS_FIXEDFILEINFO;
  begin
    Result := False;
    lwSize := GetFileVersionInfoSize(PWideChar(FileName), hFile);
    if lwSize > 0 then
    begin
      GetMem(pcBuffer, lwSize);
      if GetFileVersionInfo(Pointer(FileName), 0, lwSize, pcBuffer) then
        if VerQueryValue(pcBuffer, '\', pointer(pInfo), lwLen) then
        begin
          aFileVersionInfo.fMajor   := HiWord(pInfo.dwFileVersionMS);
          aFileVersionInfo.fMinor   := LoWord(pInfo.dwFileVersionMS);
          aFileVersionInfo.fRelease := HiWord(pInfo.dwFileVersionLS);
          aFileVersionInfo.fBuild   := LoWord(pInfo.dwFileVersionLS);
          Result  := True;
        end;
      FreeMem(pcBuffer);
    end;
  end;
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
  sPlist  : string;
  sContent: string;
  sLine   : string;
  tf      : TextFile;

  function QueryValue(ThisValue: string): string;
  var
    reSearch: TRegEx;
    mFound  : TMatch;
  begin
    Result   := '';
    reSearch := TRegEx.Create('<key>' + ThisValue + '</key>\s*<string>([^<]*)</string>');
    mFound   := reSearch.Match(sContent);
    if mFound.Success then
    begin
      Result := mFound.Groups[1].Value;
    end;
  end;

{$ENDIF MACOS}
begin
  if sAppNamePath = '' then
    sAppNamePath := ParamStr(0);

{$IFDEF MSWINDOWS}
  GetFileVersion(sAppNamePath);
  iVerSize := GetFileVersionInfoSize(PChar(sAppNamePath), iVerHandle);
  pcVerBuf := AllocMem(iVerSize);
  try
    with aFileVersionInfo do
    begin
      fCompanyName      := QueryValue('CompanyName');
      fFileDescription  := QueryValue('FileDescription');
      fFileVersion      := QueryValue('FileVersion');
      fInternalName     := QueryValue('InternalName');
      fLegalCopyRight   := QueryValue('LegalCopyRight');
      fLegalTradeMark   := QueryValue('LegalTradeMark');
      fOriginalFileName := QueryValue('OriginalFileName');
      fProductName      := QueryValue('ProductName');
      fProductVersion   := QueryValue('ProductVersion');
      fComments         := QueryValue('Comments');
    end;
  finally
    FreeMem(pcVerBuf, iVerSize);
  end;
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
  sContent := '';
  sPlist   := ExpandFileName(ExtractFilePath(sAppNamePath) + '/../Info.plist');
  if FileExists(sPlist) then
  begin
    AssignFile(tf, sPlist);
    Reset(tf);
    while not Eof(tf) do
    begin
      ReadLn(tf, sLine);
      sContent := sContent + sLine;
    end;
    CloseFile(tf);
  end;
  with aFileVersionInfo do
  begin
    fCompanyName      := 'Whiler.com ©';
    fFileDescription  := '';
    fFileVersion      := QueryValue('CFBundleVersion');
    fInternalName     := QueryValue('CFBundleExecutable');
    fLegalCopyRight   := 'Whiler.com ©';
    fLegalTradeMark   := 'Whiler.com ©';
    fOriginalFileName := QueryValue('CFBundleDisplayName');
    fProductName      := QueryValue('CFBundleName');
    fProductVersion   := QueryValue('CFBundleVersion');
    fComments         := '';
  end;
{$ENDIF MACOS}
end;

class function TMisc.IsCtrlDown: Boolean;
{$IFDEF MSWINDOWS}
var
  ksCurrent : TKeyboardState;
begin
  GetKeyboardState(ksCurrent);
  Result := ((ksCurrent[VK_CONTROL] and 128) <> 0);
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
begin
  Result := NSControlKeyMask and TNSEvent.OCClass.modifierFlags = NSControlKeyMask;
{$ENDIF MACOS}
end;

class function TMisc.IsShiftDown: Boolean;
{$IFDEF MSWINDOWS}
var
  ksCurrent : TKeyboardState;
begin
  GetKeyboardState(ksCurrent);
  Result := ((ksCurrent[VK_SHIFT] and 128) <> 0);
{$ENDIF MSWINDOWS}
{$IFDEF MACOS}
begin
  Result := NSShiftKeyMask and TNSEvent.OCClass.modifierFlags = NSShiftKeyMask;
{$ENDIF MACOS}
end;

end.