vss_24.0.0_b4d0be7c/source/os/implementation/vss-application-platform__windows.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
--
--  Copyright (C) 2022, AdaCore
--
--  SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
--

with Interfaces.C.Pointers;

with VSS.Implementation.Windows.Kernel32;
with VSS.Implementation.Windows.Shell32;
with VSS.Implementation.Windows.String_Utilities;

separate (VSS.Application)
package body Platform is

   type LPWSTR_Array is
     array (Natural range <>) of aliased VSS.Implementation.Windows.LPWSTR;

   package LPWSTR_Pointers is
     new Interfaces.C.Pointers
           (Natural, VSS.Implementation.Windows.LPWSTR, LPWSTR_Array, null);

   ----------------------
   -- Application_File --
   ----------------------

   function Application_File return VSS.Strings.Virtual_String is

      use type VSS.Implementation.Windows.DWORD;

      Size : VSS.Implementation.Windows.DWORD := 512;

   begin
      return Result : VSS.Strings.Virtual_String do
         loop
            declare
               Buffer :
                 Interfaces.C.char16_array (1 .. Interfaces.C.size_t (Size));
               Status : VSS.Implementation.Windows.DWORD;

            begin
               Status :=
                 VSS.Implementation.Windows.Kernel32.GetModuleFileName
                   (0, Buffer (Buffer'First)'Unchecked_Access, Size);

               if Status = 0 then
                  return;
               end if;

               if Status < Size
                 or else VSS.Implementation.Windows.Kernel32.GetLastError
                   /= VSS.Implementation.Windows.ERROR_INSUFFICIENT_BUFFER
               then
                  Result :=
                    VSS.Implementation.Windows.String_Utilities
                      .From_Native_String
                         (Buffer (Buffer'First)'Unchecked_Access);

                  return;
               end if;

               Size := Size * 2;
            end;
         end loop;
      end return;
   end Application_File;

   ---------------
   -- Arguments --
   ---------------

   function Arguments return VSS.String_Vectors.Virtual_String_Vector is
      Argc : Interfaces.C.int;
      Argv : constant VSS.Implementation.Windows.LPWSTR_Pointer :=
        VSS.Implementation.Windows.Shell32.CommandLineToArgv
          (VSS.Implementation.Windows.LPCWSTR
             (VSS.Implementation.Windows.Kernel32.GetCommandLine),
           Argc);
      Args : constant LPWSTR_Array :=
        LPWSTR_Pointers.Value
          (LPWSTR_Pointers.Pointer (Argv), Interfaces.C.ptrdiff_t (Argc));

   begin
      return Result : VSS.String_Vectors.Virtual_String_Vector do
         for J in 1 .. Args'Last loop
            Result.Append
              (VSS.Implementation.Windows.String_Utilities.From_Native_String
                 (Args (J)));
            null;
         end loop;

         VSS.Implementation.Windows.Kernel32.LocalFree (Argv);
      end return;
   end Arguments;

end Platform;