From 24eff67e6016050867644509684692a8ab68f3cf Mon Sep 17 00:00:00 2001
From: Alexander Iljin <ajsoft@yandex.ru>
Date: Sat, 12 Oct 2019 13:44:11 +0200
Subject: [PATCH] windows.version: new vocab

---
 extra/windows/version/authors.txt    |  1 +
 extra/windows/version/platforms.txt  |  1 +
 extra/windows/version/summary.txt    |  1 +
 extra/windows/version/version.factor | 79 ++++++++++++++++++++++++++++
 4 files changed, 82 insertions(+)
 create mode 100644 extra/windows/version/authors.txt
 create mode 100644 extra/windows/version/platforms.txt
 create mode 100644 extra/windows/version/summary.txt
 create mode 100644 extra/windows/version/version.factor

diff --git a/extra/windows/version/authors.txt b/extra/windows/version/authors.txt
new file mode 100644
index 0000000000..8e1955f8e1
--- /dev/null
+++ b/extra/windows/version/authors.txt
@@ -0,0 +1 @@
+Alexander Ilin
diff --git a/extra/windows/version/platforms.txt b/extra/windows/version/platforms.txt
new file mode 100644
index 0000000000..8e1a55995e
--- /dev/null
+++ b/extra/windows/version/platforms.txt
@@ -0,0 +1 @@
+windows
diff --git a/extra/windows/version/summary.txt b/extra/windows/version/summary.txt
new file mode 100644
index 0000000000..cb2f851695
--- /dev/null
+++ b/extra/windows/version/summary.txt
@@ -0,0 +1 @@
+Query file versions from their resources using the standard Version.dll
diff --git a/extra/windows/version/version.factor b/extra/windows/version/version.factor
new file mode 100644
index 0000000000..cda71866d5
--- /dev/null
+++ b/extra/windows/version/version.factor
@@ -0,0 +1,79 @@
+USING:
+    alien alien.data alien.libraries alien.syntax
+    destructors formatting io.binary kernel libc locals
+    math math.bitwise
+    sequences windows.types
+;
+
+IN: windows.version
+
+<< "version" "version.dll" stdcall add-library >>
+
+LIBRARY: version
+
+FUNCTION: DWORD GetFileVersionInfoSizeA (
+    LPCSTR  lptstrFilename,
+    LPDWORD lpdwHandle )
+FUNCTION: DWORD GetFileVersionInfoSizeW (
+    LPCWSTR lptstrFilename,
+    LPDWORD lpdwHandle )
+ALIAS: GetFileVersionInfoSize GetFileVersionInfoSizeW
+
+FUNCTION: BOOL GetFileVersionInfoA (
+    LPCSTR lptstrFilename,
+    DWORD  dwHandle,
+    DWORD  dwLen,
+    LPVOID lpData )
+FUNCTION: BOOL GetFileVersionInfoW (
+    LPCWSTR lptstrFilename,
+    DWORD  dwHandle,
+    DWORD  dwLen,
+    LPVOID lpData )
+ALIAS: GetFileVersionInfo GetFileVersionInfoW
+
+FUNCTION: BOOL VerQueryValueA (
+    LPCVOID pBlock,
+    LPCSTR  lpSubBlock,
+    LPVOID  *lplpBuffer,
+    PUINT   puLen )
+FUNCTION: BOOL VerQueryValueW (
+    LPCVOID pBlock,
+    LPCSTR  lpSubBlock,
+    LPVOID  *lplpBuffer,
+    PUINT   puLen )
+ALIAS: VerQueryValue VerQueryValueW
+
+: high-low ( integer -- high low )
+    [ -16 shift ] [ 16 bits ] [ compose ] keep bi ;
+
+: translation-prefix ( integer -- string )
+    high-low swap "\\StringFileInfo\\%04x%04x\\" sprintf ;
+
+: version-query ( integer -- string )
+    translation-prefix "FileVersion" append ;
+
+:: query-dword ( data query -- integer/f )
+    f LPDWORD <ref> :> result
+    data query result f VerQueryValue [
+        result LPDWORD deref 4 memory>byte-array le>
+    ] [ f ] if ;
+
+:: query-str ( data query -- string/f )
+    f LPCSTR <ref> :> result
+    data query result f VerQueryValue [ result LPCSTR deref ] [ f ] if ;
+
+: first-translation ( data -- integer/f )
+    "\\VarFileInfo\\Translation" query-dword ;
+
+:: (file-version) ( path data-size -- string/f )
+    f :> res! [
+        data-size malloc &free :> data
+        path 0 data-size data GetFileVersionInfo [
+            data first-translation [
+                data swap version-query query-str res!
+            ] when*
+        ] when
+    ] with-destructors res ;
+
+: file-version ( path -- string/f )
+    dup f GetFileVersionInfoSize dup 0 > [ (file-version) ] [ 2drop f ] if ;