aboutsummaryrefslogtreecommitdiffstats
path: root/src/translate/mcode/windows/windows_default_path.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/translate/mcode/windows/windows_default_path.adb')
-rw-r--r--src/translate/mcode/windows/windows_default_path.adb45
1 files changed, 45 insertions, 0 deletions
diff --git a/src/translate/mcode/windows/windows_default_path.adb b/src/translate/mcode/windows/windows_default_path.adb
new file mode 100644
index 000000000..23aa2f6e0
--- /dev/null
+++ b/src/translate/mcode/windows/windows_default_path.adb
@@ -0,0 +1,45 @@
+with Interfaces.C; use Interfaces.C;
+with System; use System;
+
+package body Windows_Default_Path is
+
+ subtype DWORD is Interfaces.C.Unsigned_Long;
+ subtype LPWSTR is String;
+ subtype HINSTANCE is Address;
+ function GetModuleFileName (Inst : HINSTANCE; Buf : Address; Size : DWORD)
+ return DWORD;
+ pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
+
+ function Get_Windows_Exec_Path return String
+ is
+ File : String (1 .. 256);
+ Size : DWORD;
+ P : Natural;
+ begin
+ -- Get exe file path.
+ Size := GetModuleFileName (Null_Address, File'Address, File'Length);
+ if Size = 0 or Size = File'Length then
+ return "{cannot find install path}\lib";
+ end if;
+
+ -- Remove Program file.
+ P := Natural (Size);
+ while P > 0 loop
+ exit when File (P) = '\';
+ exit when File (P) = ':' and P = 2;
+ P := P - 1;
+ end loop;
+ if File (P) = '\' and P > 1 then
+ -- Remove directory
+ P := P - 1;
+ while P > 0 loop
+ exit when File (P) = '\';
+ exit when File (P) = ':' and P = 2;
+ P := P - 1;
+ end loop;
+ end if;
+
+ return File (1 .. P);
+ end Get_Windows_Exec_Path;
+end Windows_Default_Path;
+