feat(windows): 15896 sync upstream 146-0-7680-179

.github/FUNDING.yml

@@ -0,0 +1,4 @@
+github: salvadordf
+patreon: salvadordf
+liberapay: salvadordf
+custom: https://paypal.me/briskbard

.github/dependabot.yml

@@ -0,0 +1,7 @@
+---
+version: 2
+updates:
+  - package-ecosystem: "github-actions"
+    directory: "/"
+    schedule:
+      interval: "monthly"

.github/workflows/make.pas

@@ -0,0 +1,223 @@
+//castle-engine.io/modern_pascal
+
+program Make;
+{$mode objfpc}{$H+}
+
+uses
+  Classes,
+  SysUtils,
+  StrUtils,
+  FileUtil,
+  LazFileUtils,
+  Zipper,
+  fphttpclient,
+  RegExpr,
+  openssl,
+  LazUTF8,
+  opensslsockets,
+  eventlog,
+  Process;
+
+  function OutLog(const Knd: TEventType; const Msg: string): string;
+  begin
+    case Knd of
+      etError: Result := #27'[31m%s: %s'#27'[0m';
+      etInfo:  Result := #27'[32m%s: %s'#27'[0m';
+      etDebug: Result := #27'[33m%s: %s'#27'[0m';
+    end;
+    Writeln(stderr, UTF8ToConsole(Result.Format([FormatDateTime('hh:nn:ss', Time), Msg])));
+  end;
+
+  function AddPackage(const Path: string): string;
+  begin
+    with TRegExpr.Create do
+    begin
+      Expression :=
+        {$IFDEF MSWINDOWS}
+          '(cocoa|x11|_template)'
+        {$ELSE}
+          '(cocoa|gdi|_template)'
+        {$ENDIF}
+      ;
+      if not Exec(Path) then
+        if RunCommand('lazbuild', ['--add-package-link', Path], Result, [poStderrToOutPut]) then
+          OutLog(etDebug, 'Add package:'#9 + Path)
+        else
+        begin
+          ExitCode += 1;
+          OutLog(etError, Result);
+        end;
+      Free;
+    end;
+  end;
+
+  function SelectString(const Input, Reg: string): string;
+  var
+    Line: string;
+  begin
+    Result := EmptyStr;
+    with TRegExpr.Create do
+    begin
+      Expression := Reg;
+      for Line in Input.Split(LineEnding) do
+        if Exec(Line) then
+          Result += Line + LineEnding;
+      Free;
+    end;
+  end;
+
+  function RunTest(const Path: String): string;
+  begin
+    OutLog(etDebug, #9'run:'#9 + Path);
+    if RunCommand(Path, ['--all', '--format=plain'], Result, [poStderrToOutPut]) then
+      OutLog(etInfo, #9'success!')
+    else
+    begin
+      ExitCode += 1;
+      OutLog(etError, Result);
+    end;
+  end;
+
+  function AddDDL(const LibPath, Path: String): string;
+  begin
+    OutLog(etDebug, #9'add:'#9 + Path);
+    if not FileExists(LibPath + ExtractFileName(Path)) then
+      if RunCommand('sudo', ['bash', '-c', 'cp %s %s; ldconfig --verbose'.Format([Path, LibPath])], Result, [poStderrToOutPut]) then
+        OutLog(etInfo, #9'success!')
+      else
+      begin
+        ExitCode += 1;
+        OutLog(etError, Result);
+      end;
+  end;
+
+  function BuildProject(const Text, Path: string): string;
+  begin
+    OutLog(etDebug, 'Build from:'#9 + Path);
+    if RunCommand('lazbuild',
+      ['--build-all', '--recursive', '--no-write-project', Path], Result, [poStderrToOutPut]) then
+    begin
+      Result := SelectString(Result, 'Linking').Split(' ')[2].Replace(LineEnding, EmptyStr);
+      OutLog(etInfo, #9'to:'#9 + Result);
+      if Text.Contains('program') and Text.Contains('consoletestrunner') then
+        RunTest(Result)
+      else if Text.Contains('library') and Text.Contains('exports') then
+        AddDDL('/usr/lib/', Result)
+    end
+    else
+    begin
+      ExitCode += 1;
+      OutLog(etError, SelectString(Result, '(Fatal|Error):'));
+    end;
+  end;
+
+  function DownloadFile(const Uri: string): string;
+  var
+    OutFile: TStream;
+  begin
+    InitSSLInterface;
+    Result := GetTempFileName;
+    OutFile := TFileStream.Create(Result, fmCreate or fmOpenWrite);
+    with TFPHttpClient.Create(nil) do
+    begin
+      try
+        AddHeader('User-Agent', 'Mozilla/5.0 (compatible; fpweb)');
+        AllowRedirect := True;
+        Get(Uri, OutFile);
+        OutLog(etDebug, 'Download from %s to %s'.Format([Uri, Result]));
+      finally
+        Free;
+        OutFile.Free;
+      end;
+    end;
+  end;
+
+  procedure UnZip(const ZipFile, ZipPath: string);
+  begin
+    with TUnZipper.Create do
+    begin
+      try
+        FileName := ZipFile;
+        OutputPath := ZipPath;
+        Examine;
+        UnZipAllFiles;
+        OutLog(etDebug, 'Unzip from'#9 + ZipFile + #9'to'#9 + ZipPath);
+        DeleteFile(ZipFile);
+      finally
+        Free;
+      end;
+    end;
+  end;
+
+  function InstallOPM(const Path: string): string;
+  begin
+    Result :=
+      {$IFDEF MSWINDOWS}
+      GetEnvironmentVariable('APPDATA') + '\.lazarus\onlinepackagemanager\packages\'
+      {$ELSE}
+      GetEnvironmentVariable('HOME') + '/.lazarus/onlinepackagemanager/packages/'
+      {$ENDIF}
+      + Path;
+    if not DirectoryExists(Result) then
+    begin
+      if ForceDirectories(Result) then
+        UnZip(DownloadFile('https://packages.lazarus-ide.org/%s.zip'.Format([Path])), Result);
+    end;
+  end;
+
+  function BuildAll(const DT: TDateTime; const Dependencies: array of string): string;
+  var
+    List: TStringList;
+  begin
+    if FileExists('.gitmodules') then
+      if RunCommand('git', ['submodule', 'update', '--init', '--recursive',
+        '--force', '--remote'], Result, [poStderrToOutPut]) then
+        OutLog(etInfo, Result)
+      else
+      begin
+        ExitCode += 1;
+        OutLog(etError, Result);
+      end;
+    List := FindAllFiles(GetCurrentDir, '*.lpk');
+    try
+      for Result in Dependencies do
+        List.AddStrings(FindAllFiles(InstallOPM(Result), '*.lpk'));
+      for Result in List do
+        AddPackage(Result);
+      List := FindAllFiles(GetCurrentDir, '*.lpi');
+      List.Sort;
+      for Result in List do
+        if not Result.Contains(DirectorySeparator + 'use' + DirectorySeparator) then
+          BuildProject(ReadFileToString(Result.Replace('.lpi', '.lpr')), Result);
+    finally
+      List.Free;
+    end;
+{
+    if not RunCommand('delp', ['-r', GetCurrentDir], Result, [poStderrToOutPut]) then
+      OutLog(etError, Result);
+}
+    OutLog(etDebug, 'Duration:'#9 + FormatDateTime('hh:nn:ss', Time - DT));
+    case ExitCode of
+      0: OutLog(etInfo, 'Errors:'#9 + ExitCode.ToString);
+      else
+        OutLog(etError, 'Errors:'#9 + ExitCode.ToString);
+    end;
+  end;
+
+//==============================================================================
+// ENDPOINT
+//==============================================================================
+
+begin
+  try
+    if ParamCount > 0 then
+      case ParamStr(1) of
+        'build': BuildAll(Time, ['DCPcrypt']);
+        else
+          OutLog(etDebug, ParamStr(1));
+      end;
+  except
+    on E: Exception do
+      OutLog(etError, E.ClassName + #9 + E.Message);
+  end;
+end.

.github/workflows/make.yml

@@ -0,0 +1,64 @@
+---
+name: Make
+
+on:
+  schedule:
+    - cron:  '0 0 1 * *'
+  push:
+    branches:
+      - "**"
+  pull_request:
+    branches:
+      - master
+      - main
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
+jobs:
+  build:
+    runs-on: ${{ matrix.os }}
+    timeout-minutes: 120
+    strategy:
+      matrix:
+        os:
+          - ubuntu-latest
+          # - windows-latest
+
+    steps:
+    - name: Checkout
+      uses: actions/checkout@v6
+      with:
+        submodules: true
+
+    - name: Build on Linux
+      if: runner.os == 'Linux'
+      shell: bash
+      run: |
+        set -xeuo pipefail
+        sudo bash -c '
+          apt-get update; apt-get -y install lazarus
+        ' >/dev/null
+        declare -rx INSTANTFPCOPTIONS=-Fu/usr/lib/lazarus/*/components/lazutils
+        instantfpc '.github/workflows/make.pas' build
+
+    - name: Build on Windows
+      if: runner.os == 'Windows'
+      shell: powershell
+      run: |
+        $ErrorActionPreference = 'stop'
+        Set-PSDebug -Strict
+        New-Variable -Option Constant -Name VAR -Value @{
+          Uri = 'https://is.gd/Yuk8a1'
+          OutFile = (New-TemporaryFile).FullName + '.exe'
+        }
+        Invoke-WebRequest @VAR
+        & $VAR.OutFile.Replace('Temp', 'Temp\.') /SP- /VERYSILENT /NORESTART `
+          /SUPPRESSMSGBOXES | Out-Null
+        $Env:PATH+=';C:\Lazarus'
+        (Get-Command 'lazbuild').Source | Out-Host
+        $Env:PATH+=';C:\Lazarus\fpc\3.2.2\bin\x86_64-win64'
+        (Get-Command 'instantfpc').Source | Out-Host
+        $Env:INSTANTFPCOPTIONS='-FuC:\Lazarus\components\lazutils'
+        instantfpc '.github\workflows\make.pas' build

.gitignore

@@ -0,0 +1,82 @@
+# Uncomment these types if you want even more clean repository. But be careful.
+# It can make harm to an existing project source. Read explanations below.
+#
+# Resource files are binaries containing manifest, project icon and version info.
+# They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
+#*.res
+#
+# Type library file (binary). In old Delphi versions it should be stored.
+# Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
+#*.tlb
+#
+# Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
+# Uncomment this if you are not using diagrams or use newer Delphi version.
+#*.ddp
+#
+# Visual LiveBindings file. Added in Delphi XE2.
+# Uncomment this if you are not using LiveBindings Designer.
+#*.vlb
+#
+# Deployment Manager configuration file for your project. Added in Delphi XE2.
+# Uncomment this if it is not mobile development and you do not use remote debug feature.
+#*.deployproj
+# 
+# C++ object files produced when C/C++ Output file generation is configured.
+# Uncomment this if you are not using external objects (zlib library for example).
+#*.obj
+#
+
+# Delphi compiler-generated binaries (safe to delete)
+*.exe
+*.dll
+*.bpl
+*.bpi
+*.dcp
+*.so
+*.apk
+*.drc
+*.map
+*.dres
+*.rsm
+*.tds
+*.dcu
+*.lib
+*.a
+*.o
+*.ocx
+
+# Delphi autogenerated files (duplicated info)
+*.cfg
+*.hpp
+*Resource.rc
+
+# Delphi local files (user-specific info)
+*.local
+*.identcache
+*.projdata
+*.tvsconfig
+*.dsk
+*.dsv
+
+# Delphi history and backups
+__history/
+__recovery/
+*.~*
+
+# FPC / Lazarus
+*.lps
+**/backup
+**/lib/i386-win32
+**/lib/x86_64-win64
+
+# Castalia statistics file (since XE7 Castalia is distributed with Delphi)
+*.stat
+
+# Project specific
+bin/*.log
+bin/*.pak
+bin/locales
+bin/*.bin
+bin/*.dat
+demos/FMXExternalPumpBrowser/FMXExternalPumpBrowser.res
+